Datatid 1999 #6/Datatid_1999-06.iso/internet/Tango352Promo/P.SQL/PTKPKG.1/BTRV32VB.FRM

Visual Basic Form | 1998-09-15 | 14.7 KB | 421 lines

VERSION 5.00
Begin VB.Form frmBtrv32
   Caption         =   "Btrieve Visual Basic Sample"
   ClientHeight    =   7425
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   8055
   Icon            =   "btrv32vb.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   7425
   ScaleWidth      =   8055
   StartUpPosition =   3  'Windows Default
   Begin VB.TextBox txtOutput
      Height          =   495
      Left            =   2520
      TabIndex        =   4
      Top             =   960
      Width           =   4575
   End
   Begin VB.TextBox txtInput
      Height          =   495
      Left            =   2520
      TabIndex        =   3
      Top             =   240
      Width           =   4575
   End
   Begin VB.CommandButton cmdExit
      Caption         =   "E&xit"
      Height          =   375
      Left            =   4560
      TabIndex        =   2
      Top             =   6720
      Width           =   1095
   End
   Begin VB.ListBox lstBtrv
      Height          =   4740
      ItemData        =   "btrv32vb.frx":000C
      Left            =   720
      List            =   "btrv32vb.frx":000E
      TabIndex        =   1
      Top             =   1680
      Width           =   6375
   End
   Begin VB.CommandButton cmdRunTest
      Caption         =   "&Run Test"
      Height          =   375
      Left            =   2400
      TabIndex        =   0
      Top             =   6720
      Width           =   1095
   End
   Begin VB.Label Label2
      Caption         =   "Output Path"
      Height          =   255
      Left            =   960
      TabIndex        =   6
      Top             =   1080
      Width           =   1095
   End
   Begin VB.Label Label1
      Caption         =   "Input Path"
      Height          =   255
      Left            =   960
      TabIndex        =   5
      Top             =   360
      Width           =   1095
   End
Attribute VB_Name = "frmBtrv32"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'{*************************************************************************
'**  Copyright 1998 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