PreviousTutorials and Guide to Samples (9.1 revision 1) Next

Visual Basic

Show this topic in Library frames

This section discusses the following topics:

Program Example

The following example program shows how to perform several of the more common Btrieve operations, and it performs those operations in the order required by the MicroKernel's dependencies (for example, you must open a file before performing I/O to it). The files you will need to run this Pervasive.SQL sample application include the following:

Example 7-6 BTR32VBFieldMap.bas
********************************************************************* 
'** 
'**  Copyright 2003 Pervasive Software Inc. All Rights Reserved 
'** 
'********************************************************************* 
'********************************************************************* 
'** 
'**  BTR32VBFieldMap.bas 
'** 
'**  This software is part of the Pervasive Software Developer Kit. 
'** 
'**  This source code is only intended as a supplement to the 
'**  Pervasive.SQL documentation; see that documentation for detailed 
'**  information regarding the use of Pervasive.SQL. 
'** 
'********************************************************************* 
Option Explicit 
Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (hpvDest As 
Any, hpvSource As Any, ByVal cbCopy As Long) 
'********************************************************************* 
'When compiling a 32-bit application, Visual Basic aligns members of a 
'user-defined data type (UDT) on 8-, 16-, or 32-bit boundaries,depending 
'on the size of that particular member. Unlike structures, database rows 
'are packed, meaning there's no unused space betw fields. Because there 
'is no way to turn alignment off, there must be some method to pack and 
'unpack structures so that Visual Basic applications can access a  
'database. 
'The Pervasive Btrieve Alignment DLL, or PALN32.DLL, is designed to 
'handle this structure alignment issue. 
'********************************************************************* 
'******************************************************************** 
'The Pervasive Btrieve Alignment library (PAln32.DLL) is provided in the 
'Pervasive Software Developer's Kit. This library is used for packing 
'aligned structures and unpacking database rows. 
'********************************************************************* 
'First, before the database can be accessed, there first must exist the 
'required data structures needed to manipulate the data. 
'Here we create structures to hold the data. 
'******************************************************************* 
'Person Position Block 
'****************************************************************** 
Public Type PosBlock 
  buf(0 To 127) As Byte 
End Type 
'******************************************************************* 
' Record type definitions for Version operation 
'******************************************************************** 
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 
'********************************************************************* 
'  Record type definitions for Stat and Create operations 
'******************************************************************** 
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 
'********************************************************************* 
'  Definition of record from '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 
  
'******************************************************************* 
'  Record type definitions for Get Next Extended operation 
'********************************************************************* 
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 
   
'*************************************************************** 
' Define FieldMaps.  Create structure for holding file structure. 
'*************************************************************** 
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 
'************************************************************** 
'  Define FldMapTypes.  Create structures needed to store a packed 
'  database row. 
'************************************************************** 
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 
'******************************************************************* 
'Build FieldMaps.  Load the file structure into memory. 
'******************************************************************* 
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) 
' Append a fieldmap to another 
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() 
'Initialize 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 
'** 
'**  This software is part of the Pervasive Software Developer Kit. 
'** 
'**  This source code is only intended as a supplement to the 
'**  Pervasive.SQL documentation; see that documentation for detailed 
'**  information regarding the use of Pervasive.SQL. 
'** 
'******************************************************************} 
' ****************************************************************** 
'                      Data Types 
' 
********************************************************************* 
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  Key Flags 
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  Key Types 
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 
'** 
'**  This software is part of the Pervasive Software Developer Kit. 
'** 
'**  This source code is only intended as a supplement to the 
'**  Pervasive.SQL documentation; see that documentation for detailed 
'**  information regarding the use of Pervasive.SQL. 
'** 
'*******************************************************************} 
Option Explicit 
Dim sPersonPosBlk As PosBlock     'Person position block 
Dim sPersonPosBlk2 As PosBlock    'Person position block 
Dim nPersonKeyNum As Integer      'Person index number 
Dim nKeyBufLen As Integer         'Key Buffer Length 
Dim nKeyBufLen2 As Integer        'Key Buffer Length 
Dim sKeyBuffer As String          'Key Buffer for the Person table 
Dim sKeyBuffer2 As String         'Key Buffer for the Person table 
Dim NewFileSpec As BtrFileSpec    'Used for getting STAT on the file 
Dim PersonRow As PersonRowType    'Types created in BTR32VBFieldMap.bas 
Private Sub cmdExit_Click() 
  Unload Me 
End Sub 
'******************************************************************* 
'   This is the 'main' procedure of the sample 
'******************************************************************** 
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 
   
  'Read the users destination paths 
  sKeyBuffer = Trim(txtInput.Text) 
  sKeyBuffer2 = Trim(txtOutput.Text) 
   
  nPersonKeyNum = 0 
     
  'Version Btrieve Call 
   
  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)   ' must be greater than "AA" 
  client.threadID = 50 
   
  'Convert structure to a packed row. 
  StructToRow clientrow.buf, ClientIDFldMap, client, LenB(client) 
   
  nStatus = BTRCALLID(BVERSION, _ 
                     0, _ 
                     versionBuffer, _ 
                     LenB(versionBuffer), _ 
                     sKeyBuffer, _ 
                     nKeyBufLen, _ 
                     0, _ 
                     client) 
                  
                       
  If nStatus = B_NO_ERROR Then 
   
    'Convert the packed row to a structure 
    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 
   
    ' Open Person table. (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 Call 
    lPersonID = 263512477 'find a person with this SSN 
    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 
     
      'Print out the Selected Record 
       
      PrintData PersonRow.buf 
       
    End If 
  End If 
   
  'Get stats on the file. 
  nStatus = BTRCALL(BSTAT, _ 
                    sPersonPosBlk, _ 
                    NewFileSpec, _ 
                    100, _ 
                    ByVal sKeyBuffer, _ 
                    nKeyBufLen, _ 
                    -1) 
                       
  msg = "Btrieve B_STAT status = " & nStatus 
  PrintLB (msg) 
     
  If nStatus = B_NO_ERROR Then 
   
    'create and open sample2.btr 
    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) 
                       
    'now extract data from the original file, insert into new one 
    If nStatus = B_NO_ERROR Then 
      File2Open = True 
    End If 
  End If 
   
  If nStatus = B_NO_ERROR Then 
   
    ' getFirst to establish currency 
    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 
     
    'fill in the first condition 
    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) 
     
    'fill in the second condition 
    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) 
     
    'fill in the projection header to retrieve whole record 
    prebuffer.retrieval.maxRecsToRetrieve = 20 
    prebuffer.retrieval.noFieldsToRetrieve = 1 
    
    prebuffer.recordRet.fieldLen = 157 
    prebuffer.recordRet.fieldOffset = 0 
    
    prebuffer.gneHeader.descriptionLen = Len(prebuffer) 
     
    'Make a packed array from the defined rows in the prebuffer. 
    StructToRow prebufftype.buf, pregnebufferMap, prebuffer, 
LenB(prebuffer) 
     
    'Make a packed array from the defined rows in the postbuffer. 
    StructToRow postbufftype.buf, Post_GNE_BUFFERFieldMap, postbuffer, _ 
                LenB(postbuffer) 
     
    'copy prebuffer to postbuffer area 
    CopyMemory postbufftype, prebufftype, LenB(prebufftype) 
     
    'GetNextExtended Btrieve Call 
    nStatus = BTRCALL(BGETNEXTEXTENDED, _ 
                      sPersonPosBlk, _ 
                      postbufftype, _ 
                      LenB(postbufftype), _ 
                      ByVal sKeyBuffer, _ 
                      nKeyBufLen, _ 
                      nPersonKeyNum) 
                       
    msg = "Btrieve B_GETNEXTEXTENDED status = " & nStatus 
    PrintLB (msg) 
     
    'Get Next Extended can reach end of file and still return some records 
    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 
   
    'close open files 
    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 
   
  'FREE RESOURCES 
  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 = "d:\pvsw\samples\sample.btr" 
  txtOutput.Text = "d:\pvsw\samples\sample2.btr" 
   
End Sub 
'******************************************************************** 
'   A helper procedure to write to the ListBox 
'******************************************************************** 
Sub PrintLB(Item As String) 
  frmBtrv32.lstBtrv.AddItem Item 
End Sub 
'****************************************************************** 
'  This Subroutine Inserts the data from the first file into the 
'  second file. 
'****************************************************************** 
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 ' 
   
  'Convert the packed row to a structure. 
  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) 'no currency change 
   
    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 
'***************************************************************** 
'  This subroutine prints out the data for the selected record. 
'***************************************************************** 
Private Sub PrintData(row() As Byte) 
Dim rec As PersonRecType 
Dim msg As String 
   
  'Convert the packed row to a structure. 
  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 

Compiling, Linking, and Running the Program Example

In Visual Basic, to compile, link, and run the 16-bit program example:

  1. In the Visual Basic programming environment, choose Open Project from the File menu.
  2. Open the BtSamp16.vbp project file.
  3. Click the Start button on the toolbar.
  4. Visual Basic compiles and links the program example and creates a Btrieve Visual Basic Sample window.

  5. In the Btrieve Visual Basic Sample window, click the Run Test button.
  6. Visual Basic runs the program example.

In Visual Basic, to compile, link, and run the 32-bit program example:

  1. In the Visual Basic programming environment, choose Open Project from the File menu.
  2. Open the Btr3VbSample.vbp project file.
  3. Modify the input and output text boxes to specify the complete path to 'sample.btr' and 'sample2.btr' for your environment.
  4. Click the Start button on the toolbar.
  5. Visual Basic compiles and links the program example and creates the Btrieve Visual Basic Sample Window.

  6. In the Btrieve Visual Basic Sample window, click the Run Test button.
  7. Visual Basic runs the program example.


Chapter contents
Publication contents

Prev topic: Pascal
Next topic: