pbmisc.bas

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

'*********************************************************************
'
'Purpose: Demo code showing the miscellaneous functions.
'
'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, decimals 2

'create the database
  Call xdbCreate(DBFname$, fd())
  If xdbError& Then
     MsgBox "Error 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 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& = 200

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


'display some statistics about the database and index
  Call xdbLastUpdated(dbHandle&, yearnr&, monthnr&, daynr&)
  
  msg$ = "Version: " & xdbVersion$ & $CrLf
  msg$ = msg$ & "Registered To: " & xdbRegisteredTo$ & $CrLf & $CrLf
  msg$ = msg$ & "LastUpdated: " & Format$(yearnr&) & "/" & Format$(monthnr&) & "/" & Format$(daynr&) & $CrLf
  msg$ = msg$ & "RecordCount: " & Str$(xdbRecordCount&(dbHandle&)) & $CrLf
  msg$ = msg$ & "KeyCount:    " & Str$(xdbKeyCount&(dbHandle&, idxHandle&)) & $CrLf
  msg$ = msg$ & "FieldCount:  " & Str$(xdbFieldCount&(dbHandle&)) & $CrLf
  msg$ = msg$ & "KeyLength:   " & Str$(xdbKeyLength&(dbHandle&, idxHandle&))

  MsgBox msg$,,Title$
  
  
'close the database and related index
  Call xdbClose(dbHandle&)

MsgBox "Completed.",, Title$
  
End Function