Tutorials and Guide to Samples (v11)

Visual Basic (Btrieve API 用の言語インターフェイス)

ここでは、以下の項目について説明します。

プログラムの例

以下のプログラムの例では、Btrieve の一般的な操作の実行方法をいくつか説明します。これらの操作は、MicroKernel との依存関係で要求される順番(ファイルを開いてから I/O を実行するなど)で行われます。この Pervasive PSQL アプリケーションのサンプルを実行するには、以下のファイルが必要になります。

BTR32VBFieldMap.bas

********************************************************************** 
'** 
'**  Copyright 2003 Pervasive Software Inc. All Rights Reserved 
'** 
'********************************************************************* 
'********************************************************************* 
'** 
'**  BTR32VBFieldMap.bas 
'** 
'**  このソフトウェアは、Pervasive ソフトウェア開発キット(SDK) の一部です。 
'** 
'**  このソース コードは、単なる Pervasive PSQL マニュアルの補足的なものです。 
'**  Pervasive PSQL の使用に関する詳細については、 
'**  Pervasive PSQL の該当するマニュアルを参照してください。 
'** 
'********************************************************************* 
Option Explicit 
Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (hpvDest As 
Any, hpvSource As Any, ByVal cbCopy As Long) 
'********************************************************************* 
'32 ビット アプリケーションのコンパイルの際、Visual Basic により、ユーザー 
'定義型(UDT)は、メンバーのサイズによって 8 ビット、16 ビット、32 ビットの 
'バウンダリにアラインされます。構造体とは異なり、データベースの列はパックされて 
'おり、フィールド間の未使用スペースがありません。このアライン機能をオフにする 
'ことはできないため、Visual Basic アプリケーションがデータベースにアクセスする 
'ための構造体をパック/アンパックする手段が必要になります。 
'Pervasive Btrieve Alignment DLL または PALN32.DLL は、このアライメント 
'問題を解決するためのものです。 
'********************************************************************* 
'********************************************************************* 
'Pervasive Btrieve Alignment ライブラリ (PAln32.DLL) は、Pervasive  
'ソフトウェア開発キットに用意されています。このライブラリは、アライメント調整 
'された構造体のパックや、データベースの行のアンパックに使用されます。 
'********************************************************************* 
'まず、データベースにアクセスする前に、データを処理するためのデータ構造体が 
'必要になります。ここでは、データをホールドするための構造体を作成します。 
'********************************************************************* 
'Person ポジション ブロック 
'********************************************************************* 
Public Type PosBlock 
  buf(0 To 127) As Byte 
End Type 
'********************************************************************* 
' バージョン処理用のレコードの型定義 
'********************************************************************* 
Public Type Version_BaseStruct 
    version    As Integer 
    revision   As Integer 
    MKDEId     As String * 1 
End Type 
Public Type Version_Struct 
    ver(0 To 2) As Version_BaseStruct 
End Type 
Public Type Client_ID 
    networkandnode(0 To 11) As Byte 
    applicationID(0 To 2)   As Byte 
    threadID                As Integer 
End Type 
'********************************************************************* 
'  Stat および Create 処理用のレコードの種類の定義 
'********************************************************************* 
Public Type BtrFileSpec 
    length     As Integer 
    PageSize   As Integer 
    NumIndexes As Integer 
    Reserved   As Long 
    FileFlags  As Integer 
    NumDupPtr  As Byte 
    NotUsed    As Byte 
    Allocation As Integer 
End Type 
'********************************************************************* 
'  sample.btr からのレコードの定義 
'********************************************************************* 
Public Type PersonRecType 
    ID          As Long 
    FirstName   As String * 16 
    LastName    As String * 26 
    Street      As String * 31 
    City        As String * 31 
    State       As String * 3 
    Zip         As String * 11 
    Country     As String * 21 
    Phone       As String * 14 
 End Type 
  
'********************************************************************* 
'  Get Next Extended 処理用のレコードの型定義 
'********************************************************************* 
Public Type GNE_HEADER 
    descriptionLen  As Integer 
    currencyConst   As String * 2 
    rejectCount     As Integer 
    numberTerms     As Integer 
End Type 
Public Type TERM_HEADER 
    fieldType       As Byte 
    fieldLen        As Integer 
    fieldOffset     As Integer 
    comparisonCode  As Byte 
    connector       As Byte 
    value           As String * 3 
End Type 
   
Public Type RETRIEVAL_HEADER 
    maxRecsToRetrieve   As Integer 
    noFieldsToRetrieve  As Integer 
End Type 
Public Type FIELD_RETRIEVAL_HEADER 
    fieldLen        As Integer 
    fieldOffset     As Integer 
End Type 
   
Public Type PRE_GNE_BUFFER 
    gneHeader As GNE_HEADER 
    term1     As TERM_HEADER 
    term2     As TERM_HEADER 
    retrieval As RETRIEVAL_HEADER 
    recordRet As FIELD_RETRIEVAL_HEADER 
End Type 
Public Type RETURNED_REC 
    recLen        As Integer 
    recPos        As Long 
    personRecord  As PersonRecType 
End Type 
Public Type POST_GNE_BUFFER 
    numReturned    As Integer 
    recs(0 To 19)  As RETURNED_REC 
End Type 
   
'********************************************************************* 
' FieldMap の定義。保持しているファイル構造の構造体を作成します。 
'********************************************************************* 
Global Version_StructMap(0 To 8) As FieldMap 
Const Versionsize = 15 
Global ClientIDFldMap(0 To 16) As FieldMap 
Const ClientIDsize = 17 
Global PersonFldMap(0 To 8) As FieldMap 
Const PersonRowSize = 157 
Global gneheaderMap(0 To 3) As FieldMap 
Const gneheadersize = 8 
Global termheaderMap(0 To 5) As FieldMap 
Const termheadersize = 10 
Global retrievalheaderMap(0 To 1) As FieldMap 
Const retrievalheadersize = 4 
Global fieldretrievalMap(0 To 1) As FieldMap 
Const fieldretrievalsize = 4 
Global pregnebufferMap(0 To 23) As FieldMap 
Const pregnebuffersize = 36 
Global returnrecMap(0 To 12) As FieldMap 
Const returnrecsize = 163 
Global Post_GNE_BUFFERFieldMap(0 To 281) As FieldMap 
Const postgnebuffersize = 3262 
'********************************************************************* 
'  FldMapType の定義。パックされたデータベースの行を保存するために必要な 
'  構造体を作成します。 
'********************************************************************* 
Public Type PersonRowType 
    buf(1 To PersonRowSize) As Byte 
End Type 
Public Type VersionType 
  buf(1 To Versionsize) As Byte 
End Type 
Public Type ClientIDType 
  buf(1 To ClientIDsize) As Byte 
End Type 
Public Type gneheaderType 
  buf(1 To gneheadersize) As Byte 
End Type 
Public Type termheaderType 
   buf(1 To termheadersize) As Byte 
End Type 
Public Type retrievalheadertype 
  buf(1 To retrievalheadersize) As Byte 
End Type 
Public Type fieldretrievaltype 
  buf(1 To fieldretrievalsize) As Byte 
End Type 
Public Type pregnebuffertype 
  buf(1 To pregnebuffersize) As Byte 
End Type 
Public Type returnrectype 
  buf(1 To returnrecsize) As Byte 
End Type 
Public Type postgnebuffertype 
  buf(1 To postgnebuffersize) As Byte 
End Type 
Public Const FLD_PAD32 = 42 
'********************************************************************* 
' FieldMap のビルド。ファイル構造をメモリに読み込みます。 
'********************************************************************* 
Sub AddField(map() As FieldMap, ByRef ctr As Integer, dataType As Long,_ 
            length As Long) 
   
  SetField map(ctr), dataType, length 
  ctr = ctr + 1 
   
End Sub 
Sub AddgneHeaderFldMap(map() As FieldMap, ByRef ctr As Integer) 
   
  AddField map, ctr, FLD_INTEGER, 2 ' descriptionLen 
  AddField map, ctr, FLD_STRING, 2  ' currencyConst 
  AddField map, ctr, FLD_INTEGER, 2 ' rejectCount 
  AddField map, ctr, FLD_INTEGER, 2 ' numberTerms 
End Sub 
Sub AddTERM_HEADERFldMap(map() As FieldMap, ByRef ctr As Integer) 
   
  AddField map, ctr, FLD_BYTE, 1    ' fieldType 
  AddField map, ctr, FLD_INTEGER, 2 ' fieldLen 
  AddField map, ctr, FLD_INTEGER, 2 ' fieldOffset 
  AddField map, ctr, FLD_BYTE, 1    ' comparisonCode 
  AddField map, ctr, FLD_BYTE, 1    ' connector 
  AddField map, ctr, FLD_STRING, 3  ' value 
End Sub 
Sub AddPersonFieldMap(map() As FieldMap, ByRef ctr As Integer) 
   
  AddField map, ctr, FLD_INTEGER, 4 ' ID 
  AddField map, ctr, FLD_STRING, 16 ' FirstName 
  AddField map, ctr, FLD_STRING, 26 ' LastName 
  AddField map, ctr, FLD_STRING, 31 ' Street 
  AddField map, ctr, FLD_STRING, 31 ' City 
  AddField map, ctr, FLD_STRING, 3  ' State 
  AddField map, ctr, FLD_STRING, 11 ' Zip 
  AddField map, ctr, FLD_STRING, 21 ' Country 
  AddField map, ctr, FLD_STRING, 14 ' Phone 
  
End Sub 
Sub AddFieldMap(out() As FieldMap, ByRef ctr As Integer, nin() As 
FieldMap) 
' fieldmap をほかに追加 
Dim fld As Integer 
   
  For fld = LBound(nin) To UBound(nin) 
    out(ctr) = nin(fld) 
    ctr = ctr + 1 
  Next fld 
   
End Sub 
Sub AddRETRIEVAL_HEADER(map() As FieldMap, ByRef ctr As Integer) 
   
  AddField map, ctr, FLD_INTEGER, 2 ' maxRecsToRetrieve 
  AddField map, ctr, FLD_INTEGER, 2 ' noFieldsToRetrieve 
   
End Sub 
Sub AddFIELD_RETRIEVAL_HEADER(map() As FieldMap, ByRef ctr As Integer) 
   
  AddField map, ctr, FLD_INTEGER, 2 ' fieldLen 
  AddField map, ctr, FLD_INTEGER, 2 ' fieldOffset 
   
End Sub 
Sub AddPreGNEBufferFldMap(map() As FieldMap, ByRef ctr As Integer) 
   
  AddgneHeaderFldMap map, ctr         ' gneHeader 
  AddTERM_HEADERFldMap map, ctr       ' term1 
  AddTERM_HEADERFldMap map, ctr       ' term2 
  AddRETRIEVAL_HEADER map, ctr        ' retrieval 
  AddFIELD_RETRIEVAL_HEADER map, ctr  ' recordRet 
   
End Sub 
Sub AddRETURNED_RECFldMap(map() As FieldMap, ByRef ctr As Integer) 
  AddField map, ctr, FLD_INTEGER, 2  ' recLen 
  AddField map, ctr, FLD_INTEGER, 4  ' recPos 
  AddFieldMap map, ctr, PersonFldMap ' personRecord 
   
End Sub 
Sub AddPostGNEBufferFldMap(map() As FieldMap, ByRef ctr As Integer) 
Dim fld As Integer 
    
  AddField map, ctr, FLD_INTEGER, 2   ' numReturned 
   
  For fld = 0 To 19 
    AddField map, ctr, FLD_PAD32, 0 
    AddRETURNED_RECFldMap map, ctr    ' recs 
  Next fld 
   
End Sub 
Sub AddVersionBufferFldMap(map() As FieldMap, ByRef ctr As Integer) 
Dim fld As Integer 
  For fld = 0 To 2 
    AddField map, ctr, FLD_INTEGER, 2 ' version 
    AddField map, ctr, FLD_INTEGER, 2 ' revision 
    AddField map, ctr, FLD_STRING, 1  ' MKDEId 
  Next fld 
End Sub 
  
Sub AddClientIDBufferFldMap(map() As FieldMap, ByRef ctr As Integer) 
Dim fld As Integer 
  For fld = 0 To 11 
     AddField map, ctr, FLD_BYTE, 1 ' networkandnode 
  Next fld 
   
  For fld = 0 To 2 
    AddField map, ctr, FLD_BYTE, 1  ' applicationID 
  Next fld 
   
  AddField map, ctr, FLD_INTEGER, 2 ' threadID 
   
End Sub 
    
  
Sub InitFieldMaps() 
' FieldMaps の初期化 
  AddPersonFieldMap PersonFldMap, 0 
  AddgneHeaderFldMap gneheaderMap, 0 
  AddTERM_HEADERFldMap termheaderMap, 0 
  AddFIELD_RETRIEVAL_HEADER fieldretrievalMap, 0 
  AddRETRIEVAL_HEADER retrievalheaderMap, 0 
  AddRETURNED_RECFldMap returnrecMap, 0 
  AddPreGNEBufferFldMap pregnebufferMap, 0 
  AddPostGNEBufferFldMap Post_GNE_BUFFERFieldMap, 0 
  AddVersionBufferFldMap Version_StructMap, 0 
  AddClientIDBufferFldMap ClientIDFldMap, 0 
   
End Sub 
BTR32VB.bas 
'{******************************************************************* 
'** 
'**  Copyright 2003 Pervasive Software Inc. All Rights Reserved 
'** 
'********************************************************************} 
'{******************************************************************* 
'** 
'**  BTR32VB.bas 
'** 
'**  このソフトウェアは、Pervasive ソフトウェア開発キット(SDK) の一部です。 
'** 
'**  このソース コードは、単なる Pervasive PSQL マニュアルの補足的なものです。 
'**  Pervasive PSQL の使用に関する詳細については、 
'**  Pervasive PSQL の該当するマニュアルを参照してください。 
'** 
'********************************************************************} 
' ******************************************************************* 
'                      データ型 
' 
********************************************************************* 
Option Explicit 
DefInt A-Z 
Global Const BOPEN = 0 
Global Const BCLOSE = 1 
Global Const BINSERT = 2 
Global Const BUPDATE = 3 
Global Const BDELETE = 4 
Global Const BGETEQUAL = 5 
Global Const BGETNEXT = 6 
Global Const BGETPREVIOUS = 7 
Global Const BGETGREATEROREQUAL = 9 
Global Const BGETFIRST = 12 
Global Const BGETLAST = 13 
Global Const BCREATE = 14 
Global Const BSTAT = 15 
Global Const BBEGINTRANS = 19 
Global Const BTRANSSEND = 20 
Global Const BABORTTRANS = 21 
Global Const BGETPOSITION = 22 
Global Const BGETRECORD = 23 
Global Const BSTOP = 25 
Global Const BVERSION = 26 
Global Const BRESET = 28 
Global Const BGETNEXTEXTENDED = 36 
Global Const BGETKEY = 50 
Global Const KEY_BUF_LEN = 255 
Rem  キー フラグ 
Global Const DUP = 1 
Global Const MODIFIABLE = 2 
Global Const BIN = 4 
Global Const NUL = 8 
Global Const SEGMENT = 16 
Global Const SEQ = 32 
Global Const DEC = 64 
Global Const SUP = 128 
Rem  キー タイプ 
Global Const EXTTYPE = 256 
Global Const MANUAL = 512 
Global Const BSTRING = 0 
Global Const BINTEGER = 1 
Global Const BFLOAT = 2 
Global Const BDATE = 3 
Global Const BTIME = 4 
Global Const BDECIMAL = 5 
Global Const BNUMERIC = 8 
Global Const BZSTRING = 11 
Global Const BAUTOINC = 15 
Global Const B_NO_ERROR = 0 
Global Const B_END_OF_FILE = 9 
Global Const VAR_RECS = &H1 
Global Const BLANK_TRUNC = &H2 
Global Const PRE_ALLOC = &H4 
Global Const DATA_COMP = &H8 
Global Const KEY_ONLY = &H10 
Global Const BALANCED_KEYS = &H20 
Global Const FREE_10 = &H40 
Global Const FREE_20 = &H80 
Global Const FREE_30 = &HC0 
Global Const DUP_PTRS = &H100 
Global Const INCLUDE_SYSTEM_DATA = &H200 
Global Const NO_INCLUDE_SYSTEM_DATA = &H1200 
Global Const SPECIFY_KEY_NUMS = &H400 
Global Const VATS_SUPPORT = &H800 
Global Const FLD_STRING = 0 
Global Const FLD_INTEGER = 1 
Global Const FLD_IEEE = 2 
Global Const FLD_DATE = 3 
Global Const FLD_TIME = 4 
Global Const FLD_MONEY = 6 
Global Const FLD_LOGICAL = 7 
Global Const FLD_BYTE = 19 
Global Const FLD_UNICODE = 20 
Declare Function BTRCALL Lib "w3btrv7.dll" (ByVal OP, Pb As Any, Db As 
Any, DL As Long, ByRef Kb As Any, ByVal Kl, ByVal Kn) As Integer 
Declare Function BTRCALLID Lib "w3btrv7.dll" (ByVal OP, Pb As Any, Db 
As Any, DL As Long, Kb As Any, ByVal Kl, ByVal Kn, ID As Any) As Integer 
                 
Sub SetField(ByRef fld As FieldMap, dataType As Long, Size As Long) 
    fld.dataType = dataType 
    fld.Size = Size 
End Sub 
btrv32vb.frm 
'{******************************************************************* 
'** 
'**  Copyright 2003 Pervasive Software Inc. All Rights Reserved 
'** 
'********************************************************************} 
'{******************************************************************* 
'** 
'** 
'**  btrv32vb.frm 
'** 
'**  このソフトウェアは、Pervasive ソフトウェア開発キット(SDK) の一部です。 
'** 
'**  このソース コードは、単なる Pervasive PSQL マニュアルの補足的なものです。 
'**  Pervasive PSQL の使用に関する詳細については、 
'**  Pervasive PSQL の該当するマニュアルを参照してください。 
'** 
'********************************************************************} 
Option Explicit 
Dim sPersonPosBlk As PosBlock     'Person ポジション ブロック 
Dim sPersonPosBlk2 As PosBlock    'Person ポジション ブロック 
Dim nPersonKeyNum As Integer      'Person インデックス番号 
Dim nKeyBufLen As Integer         'キー バッファー長 
Dim nKeyBufLen2 As Integer        'キー バッファー長 
Dim sKeyBuffer As String          'Person テーブルのキー バッファー 
Dim sKeyBuffer2 As String         'Person テーブルのキー バッファー 
Dim NewFileSpec As BtrFileSpec    'ファイルの STAT 取得に使用 
Dim PersonRow As PersonRowType    'BTR32VBFieldMap.bas で作成される種類 
Private Sub cmdExit_Click() 
  Unload Me 
End Sub 
'******************************************************************** 
'   サンプルのメイン プロシージャ 
'******************************************************************** 
Private Sub cmdRunTest_Click() 
Dim lPersonID As Long 
Dim recordaddress As Long 
Dim prebuffer As PRE_GNE_BUFFER 
Dim prebufftype As pregnebuffertype 
Dim postbuffer As POST_GNE_BUFFER 
Dim postbufftype As postgnebuffertype 
Dim msg As String 
Dim DataLen As Integer 
Dim nStatus As Integer 
Dim versionBuffer As VersionType 
Dim versionstruct As Version_Struct 
Dim i As Integer 
Dim FileOpen As Boolean 
Dim File2Open As Boolean 
Dim personRecord As PersonRecType 
Dim personRec As PersonRowType 
Dim client As Client_ID 
Dim clientrow As ClientIDType 
Dim s As String 
Dim s2 As String 
Dim PosBlockSize As Integer 
  PosBlockSize = 128 
   
  sKeyBuffer = Space$(KEY_BUF_LEN) 
  sKeyBuffer2 = Space$(KEY_BUF_LEN) 
  nKeyBufLen = KEY_BUF_LEN 
  nKeyBufLen2 = KEY_BUF_LEN 
   
  s = String(PosBlockSize, 0) 
  s2 = String(PosBlockSize, 0) 
  CopyMemory sPersonPosBlk, s, PosBlockSize 
  CopyMemory sPersonPosBlk2, s2, PosBlockSize 
   
  'ユーザー定義パスを読み込む 
  sKeyBuffer = Trim(txtInput.Text) 
  sKeyBuffer2 = Trim(txtOutput.Text) 
   
  nPersonKeyNum = 0 
     
  'Version Btrieve 呼び出し 
   
  For i = 0 To 11 
    client.networkandnode(i) = CByte(0) 
  Next i 
   
  client.applicationID(0) = Asc("M") 
  client.applicationID(1) = Asc("T") 
  client.applicationID(2) = CByte(0)   ' "AA" 以上を設定 
  client.threadID = 50 
   
  '構造体をパックされた列に変換 
  StructToRow clientrow.buf, ClientIDFldMap, client, LenB(client) 
   
  nStatus = BTRCALLID(BVERSION, _ 
                     0, _ 
                     versionBuffer, _ 
                     LenB(versionBuffer), _ 
                     sKeyBuffer, _ 
                     nKeyBufLen, _ 
                     0, _ 
                     client) 
                  
                       
  If nStatus = B_NO_ERROR Then 
   
    'パックされた列を構造体に変換 
    RowToStruct versionBuffer.buf, Version_StructMap, versionstruct, _ 
                LenB(versionstruct) 
                 
    For i = 0 To 2 
      If (versionstruct.ver(i).version > 0) Then 
        msg = "Btrieve Versions returned are: " & _ 
               versionstruct.ver(i).version & "." & _ 
               versionstruct.ver(i).revision & _ 
               " " & versionstruct.ver(i).MKDEId 
        PrintLB (msg) 
      End If 
    Next i 
     
  Else 
    msg = "Btrieve B_VERSION status = " & nStatus 
    PrintLB (msg) 
  End If 
   
  If nStatus = B_NO_ERROR Then 
   
    ' Person テーブルを開く(sample.btr) 
   nStatus = BTRCALL(BOPEN, _ 
                       sPersonPosBlk, _ 
                      PersonRow, _ 
                      LenB(PersonRow), _ 
                      ByVal sKeyBuffer, _ 
                      nKeyBufLen, _ 
                      nPersonKeyNum) 
                       
    msg = "Btrieve B_OPEN status = " & nStatus 
    PrintLB (msg) 
    If nStatus = B_NO_ERROR Then 
      FileOpen = True 
    End If 
  End If 
   
  If nStatus = B_NO_ERROR Then 
   
    'GetEqual Btrieve 呼び出し 
    lPersonID = 263512477 'この社会保障番号のレコードを検索 
    nStatus = BTRCALL(BGETEQUAL, _ 
                      sPersonPosBlk, _ 
                      PersonRow, _ 
                      LenB(PersonRow), _ 
                      lPersonID, _ 
                      LenB(lPersonID), _ 
                      nPersonKeyNum) 
                       
    msg = "Btrieve B_GETEQUAL status = " & nStatus 
    PrintLB (msg) 
    If nStatus = B_NO_ERROR Then 
     
      '選択したレコードの出力 
       
      PrintData PersonRow.buf 
       
    End If 
  End If 
   
  'ファイルのステータスを取得 
  nStatus = BTRCALL(BSTAT, _ 
                    sPersonPosBlk, _ 
                    NewFileSpec, _ 
                    100, _ 
                    ByVal sKeyBuffer, _ 
                    nKeyBufLen, _ 
                    -1) 
                       
  msg = "Btrieve B_STAT status = " & nStatus 
  PrintLB (msg) 
     
  If nStatus = B_NO_ERROR Then 
   
    'sample2.bt を作成して開く 
    nStatus = BTRCALL(BCREATE, _ 
                      0, _ 
                      NewFileSpec, _ 
                      100, _ 
                      ByVal sKeyBuffer2, _ 
                      nKeyBufLen2, _ 
                      0) 
                       
    msg = "Btrieve B_CREATE status = " & nStatus 
    PrintLB (msg) 
  End If 
  If nStatus = B_NO_ERROR Then 
    nPersonKeyNum = 0 
    nStatus = BTRCALL(BOPEN, _ 
                      sPersonPosBlk2, _ 
                      PersonRow, _ 
                      LenB(PersonRow), _ 
                      ByVal sKeyBuffer2, _ 
                      nKeyBufLen2, _ 
                      nPersonKeyNum) 
                       
    '元のファイルからデータを抽出し、新しいファイルへ挿入 
    If nStatus = B_NO_ERROR Then 
      File2Open = True 
    End If 
  End If 
   
  If nStatus = B_NO_ERROR Then 
   
    ' getFirst を実行してカレンシーを確立 
    nPersonKeyNum = 2 'STATE-CITY index 
    nStatus = BTRCALL(BGETFIRST, _ 
                      sPersonPosBlk, _ 
                      PersonRow, _ 
                      LenB(PersonRow), _ 
                      ByVal sKeyBuffer, _ 
                      nKeyBufLen, _ 
                      nPersonKeyNum) 
                       
    msg = "Btrieve B_GETFIRST status = " & nStatus 
    PrintLB (msg) 
  End If 
   
  prebuffer.gneHeader.currencyConst = "UC" 
  While nStatus = B_NO_ERROR 
     
    prebuffer.gneHeader.rejectCount = 0 
    prebuffer.gneHeader.numberTerms = 2 
     
    '最初の条件を代入 
    prebuffer.term1.fieldType = 11 
    prebuffer.term1.fieldLen = 3 
    prebuffer.term1.fieldOffset = 108 
    prebuffer.term1.comparisonCode = 1 
    prebuffer.term1.connector = 2 
    prebuffer.term1.value = "TX" & Chr(0) 
     
    '2 つ目の条件を代入 
    prebuffer.term2.fieldType = 11 
    prebuffer.term2.fieldLen = 3 
    prebuffer.term2.fieldOffset = 108 
    prebuffer.term2.comparisonCode = 1 
    prebuffer.term2.connector = 0 
    prebuffer.term2.value = "CA" & Chr(0) 
     
    'プロジェクション ヘッダーを設定してレコード全体を読み込む 
    prebuffer.retrieval.maxRecsToRetrieve = 20 
    prebuffer.retrieval.noFieldsToRetrieve = 1 
    
    prebuffer.recordRet.fieldLen = 157 
    prebuffer.recordRet.fieldOffset = 0 
    
    prebuffer.gneHeader.descriptionLen = Len(prebuffer) 
     
    '定義済みの列から、パックされた配列をプリバッファーに作成 
    StructToRow prebufftype.buf, pregnebufferMap, prebuffer, 
LenB(prebuffer) 
     
    '定義済みの列から、パックされた配列をポストバッファーに作成 
    StructToRow postbufftype.buf, Post_GNE_BUFFERFieldMap, postbuffer, _ 
                LenB(postbuffer) 
     
    'プリバッファーをポストバッファー領域にコピー 
    CopyMemory postbufftype, prebufftype, LenB(prebufftype) 
     
    'GetNextExtended Btrieve 呼び出し 
    nStatus = BTRCALL(BGETNEXTEXTENDED, _ 
                      sPersonPosBlk, _ 
                      postbufftype, _ 
                      LenB(postbufftype), _ 
                      ByVal sKeyBuffer, _ 
                      nKeyBufLen, _ 
                      nPersonKeyNum) 
                       
    msg = "Btrieve B_GETNEXTEXTENDED status = " & nStatus 
    PrintLB (msg) 
     
    'Get Next Extended は、ファイルの終わりまで到達してもレコードを 
    '返すことがあります 
    If ((nStatus = B_NO_ERROR) Or (nStatus = B_END_OF_FILE)) Then 
     
      InsertNewData postbufftype.buf 
       
    End If 
     
    prebuffer.gneHeader.currencyConst = "EG" 
     
  Wend 
   
  nPersonKeyNum = 0 
  msg = " " 
  PrintLB (msg$) 
  If FileOpen = True Then 
   
    '開いているファイルを閉じる 
    nStatus = BTRCALL(BCLOSE, _ 
                      sPersonPosBlk, _ 
                      0, 0, 0, 0, 0) 
                       
    msg = "Btrieve B_CLOSE (sample.btr) status = " & nStatus 
    PrintLB (msg) 
  End If 
   
  If File2Open = True Then 
    nStatus = BTRCALL(BCLOSE, _ 
                      sPersonPosBlk2, _ 
                      0, 0, 0, 0, 0) 
                       
    msg = "Btrieve B_CLOSE (sample2.btr) status = " & nStatus 
    PrintLB (msg) 
  End If 
   
  'リソースの解放 
  nStatus = BTRCALL(BRESET, _ 
                    "", _ 
                    0, _ 
                    0, _ 
                    CLng(0), _ 
                    0, _ 
                    0) 
                     
  msg = "Btrieve B_RESET status = " & nStatus 
  PrintLB (msg) 
   
End Sub 
Private Sub Form_Load() 
  InitFieldMaps 
  txtInput.Text = "<path>¥samples¥sample.btr" 
  txtOutput.Text = "<path>¥samples¥sample2.btr" 
   
End Sub 
'******************************************************************** 
'  ListBox に書き込むためのヘルパー関数 
'******************************************************************** 
Sub PrintLB(Item As String) 
  frmBtrv32.lstBtrv.AddItem Item 
End Sub 
'******************************************************************** 
'  このサブルーチンでは、最初のファイルからのデータを次のファイルに挿入します。 
'******************************************************************** 
Private Sub InsertNewData(row() As Byte) 
Dim rec As POST_GNE_BUFFER 
Dim msg As String 
Dim i As Integer 
Dim personRecord As PersonRecType 
Dim personRec As PersonRowType 
Dim DataLen As Integer 
Dim nStatus As Integer ' 
   
  'パックされた列を構造体に変換 
  RowToStruct row, Post_GNE_BUFFERFieldMap, rec, LenB(rec) 
  msg = "GetNextExtended returned " & rec.numReturned & " record(s)." 
  PrintLB (msg) 
   
  For i = 0 To rec.numReturned - 1 
    personRecord = rec.recs(i).personRecord 
    StructToRow personRec.buf, PersonFldMap, personRecord, 
LenB(personRecord) 
    nStatus = BTRCALL(BINSERT, _ 
                      sPersonPosBlk2, _ 
                      personRec, _ 
                      LenB(personRec), _ 
                      ByVal sKeyBuffer2, _ 
                      nKeyBufLen2, _ 
                      -1) 'カレンシー変更なし 
   
    If (nStatus <> B_NO_ERROR) Then 
      msg = "Btrieve B_INSERT status = " & nStatus 
      PrintLB (msg) 
    End If 
  Next i 
   
  msg = "Inserted " & rec.numReturned & _ 
        " records in new file, status = " & nStatus 
  PrintLB (msg) 
  
End Sub 
'******************************************************************** 
'  このサブルーチンでは、選択したレコードのデータを出力します。 
'******************************************************************** 
Private Sub PrintData(row() As Byte) 
Dim rec As PersonRecType 
Dim msg As String 
   
  'パックされた列を構造体に変換 
  RowToStruct row, PersonFldMap, rec, LenB(rec) 
  msg = " " 
  PrintLB (msg$) 
  msg = "Selected fields from the retrieved record are: " 
  PrintLB (msg) 
  msg = "ID =         " & Chr$(9) & rec.ID 
  PrintLB (msg) 
  msg = "First Name = " & Chr$(9) & rec.FirstName 
  PrintLB (msg) 
  msg = "Last Name =  " & Chr$(9) & rec.LastName 
  PrintLB (msg) 
  msg = "Address =    " & Chr$(9) & rec.Street 
  PrintLB (msg) 
  msg = "City =       " & Chr$(9) & rec.City 
  PrintLB (msg) 
  msg = "State =      " & Chr$(9) & rec.State 
  PrintLB (msg) 
  msg = "Country =    " & Chr$(9) & rec.Country 
  PrintLB (msg) 
  msg = "Zip =        " & Chr$(9) & rec.Zip 
  PrintLB (msg) 
  msg = "Phone =      " & Chr$(9) & rec.Phone 
  PrintLB (msg) 
  msg = " " 
  PrintLB (msg$) 
   
End Sub 

サンプル プログラムのコンパイル、リンク、実行

Visual Basic では、32 ビット サンプル プログラムのコンパイル、リンク、実行を、以下の方法で行います。

  1. Visual Basic プログラミング環境では、[ファイル]メニューの[プロジェクトを開く]を選択します。
  2. Btr3VbSample.vbp プロジェクト ファイルを開きます。
  3. 入出力テキスト ボックスを編集し、使用する sample.btr および sample2.btr のフルパスを指定します。
  4. ツール バーの[開始]ボタンをクリックします。
    サンプル プログラムがコンパイルおよびリンクされ、[Btrieve Visual Basic Sample]ウィンドウが作成されます。
  5. [Btrieve Visual Basic Sample]ウィンドウの[Run Test]ボタンをクリックします。
    サンプル プログラムが実行されます。

Pascal (Btrieve API 用の言語インターフェイス)