pbmove.bas

功能强大的 DBF 数据库操作 dll,可以让 VB 和 POWERBASIC 调用

'*********************************************************************
'
'Purpose: Demo code showing how to move through a database with and
'         without an index. Without an index, movement through the
'         database is based on the order the records are physically
'         stored in the database. If an index is used then the
'         database records are displayed based on the sort order
'         of the keys in the index.
'
'Paul Squires (2000-2003)
'
'*********************************************************************
 

#Compile Exe

#Include "CHEETAH2.INC"  'all declares for Cheetah Database


Function PbMain () As Long


  Title$ = "PowerBasic Cheetah Database"

'change to the directory where this program was started from. If Cheetah.dll is not
'in this directory then make sure you copy it the Windows/System directory.
  ChDir xdbAppPath$

'define the names of the database & index
  DBFname$ = "Cheetah.dbf"
  IDXname$ = "Cheetah.idx"


'define the structure of the databases
  Dim Fd(1:3) As String
  Fd(1) = "CUSTID,C,7,0"     'Character field, length 7
  Fd(2) = "CUSTNAME,C,35,0"  'Character field, length 35
  Fd(3) = "SALARY,N,14,2"    'Numeric field, length 14, 2 decimal places (i.e "###########.##")

'create the database
  Call xdbCreate(DBFname$, fd())
  If xdbError Then
     MsgBox "Error: " & Str$(xdbError&) & " creating database.",,Title$
     Call xdbResetError
     Exit Function
  End If
  

'open the database (database must be open prior to creating index)
  dbHandle& = xdbOpen&(DBFname$)
  If xdbError Then
     MsgBox "Error: " & Str$(xdbError&) & " opening database.",,Title$
     Call xdbResetError
     Exit Function
  End If


'create the index (database must be open)
  IndexExpr$ = "UPPER(CUSTID)"   'index is not case sensitive
  Duplicates& = %XDBTRUE

  Call xdbCreateIndex(IDXname$, dbHandle&, IndexExpr$, Duplicates&)
  If xdbError Then
     MsgBox "Error: " & Str$(xdbError&) & " creating index.",,Title$
     Call xdbResetError
     Exit Function
  End If


'open the index
  idxHandle& = xdbOpenIndex&(IDXname$, dbHandle&)
  If xdbError Then
     MsgBox "Error: " & Str$(xdbError&) & " opening index.",,Title$
     Call xdbResetError
     Exit Function
  End If



'add records to the database and index
  NumRecs& = 500

MsgBox "Press 'Okay' to create " & Str$(NumRecs&) & " database and index records.",, Title$

'predefine the field#'s for speed. If you already know the
'which field name corresponds to which field number then
'there is no need to do this. These functions provide
'really fast lookups.
  CustIDfield& = xdbFieldNumber&(dbHandle&, "CUSTID")
  CustNameField& = xdbFieldNumber&(dbHandle&, "CUSTNAME")
  SalaryField& = xdbFieldNumber&(dbHandle&, "SALARY")


  CustID$ = Space$(xdbFieldLength&(dbHandle&, CustIDfield&))

  For x& = 1 To NumRecs&

     Call xdbClearBuffer(dbHandle&)  'this will clear the record buffer

     RSet CustID$ = LTrim$(Str$(x&))
     Call xdbAssignField(dbHandle&, "", CustIDfield&, CustID$)
     Call xdbAssignField(dbHandle&, "", CustNameField&, "The big Cat")
     Call xdbAssignField(dbHandle&, "", SalaryField&, "-1234.50")

     'add to the end of the database (Append) & add the key to the index.
     Call xdbAddRecord(dbHandle&)
     If xdbError Then
        MsgBox "Error: " & Str$(xdbError&) & " adding database record.",,Title$
        Call xdbResetError
        Exit For
     End If

  Next



MsgBox "Press 'Okay' to MOVE FORWARD all records without index.",, Title$

'***** FORWARD MOVEMENTS *****

'using 0 as the index handle disables the use of indexes for the database.
'traverse the database using the database's natural order
  Call xdbMoveFirst(dbHandle&, 0)

  Do Until xdbEOF(dbHandle&) = %xdbTrue  'notice that xdbEOF (end of file) is used.
     'you would access the record's fields here by using
     'the xdbFieldValue functions.

      Call xdbMoveNext(dbHandle&, 0)
      
  Loop                  
  
'Note: If you are not using an index then it is acceptable to use the 
'following code instead.
'  NumRecords& = xdbRecordCount(dbHandle&)
'  
'  FOR x& = 1 TO NumRecords&
'
'      CALL xdbGetRecord(dbHandle&, x&)
'
'      'you would access the record's fields here by using
'      'the xdbFieldValue functions.
'  NEXT
       



MsgBox "Press 'Okay' to MOVE FORWARD all records using the index.",, Title$

'records will be returned based on the index's key order (UPPER(CUSTNUM))
  Call xdbMoveFirst(dbHandle&, idxHandle&)

  Do Until xdbEOF(dbHandle&) = %xdbTrue  'notice that xdbEOF (end of file) is used.
     'you would access the record's fields here by using
     'the xdbFieldValue functions.
     
      Call xdbMoveNext(dbHandle&, idxHandle&)

  Loop



'***** BACKWARDS MOVEMENTS *****

MsgBox "Press 'Okay' to MOVE BACKWARDS all records without index.",, Title$

'using 0 as the index handle disables the use of indexes for the database.
'traverse the database using the database's natural order
  Call xdbMoveLast(dbHandle&, 0)

  Do Until xdbBOF(dbHandle&) = %xdbTrue  'notice that xdbBOF (beginning of file) is used.
     'you would access the record's fields here by using
     'the xdbFieldValue functions.

      Call xdbMovePrev(dbHandle&, 0)

  Loop

'Note: If you are not using an index then it is acceptable to use the 
'following code instead.
'  NumRecords& = xdbRecordCount(dbHandle&)
'  
'  FOR x& = NumRecords& TO 1 STEP -1
'
'      CALL xdbGetRecord(dbHandle&, x&)
'
'      'you would access the record's fields here by using
'      'the xdbFieldValue functions.
'  NEXT
       


MsgBox "Press 'Okay' to MOVE BACKWARDS all records using the index.",, Title$


'records will be returned based on the index's key order (UPPER(CUSTNUM))
  Call xdbMoveLast(dbHandle&, idxHandle&)

  Do Until xdbBOF(dbHandle&) = %xdbTrue  'notice that xdbBOF (beginning of file) is used.
     'you would access the record's fields here by using
     'the xdbFieldValue functions.

      Call xdbMovePrev(dbHandle&, idxHandle&)

  Loop


'close the database and related index
  Call xdbClose(dbHandle&)

MsgBox "Completed.",, Title$

End Function