pbextend.bas

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

'*********************************************************************
'
'Purpose: Demo code showing the creation of a database that uses
'         Cheetah extended data types.
'
'WARNING: Using extended data types will deviate the database from
'         the standard xbase database format therefore other programs
'         expecting an xbase file will not read the database correctly.
'         However, using the extended types will make your databases
'         smaller and more efficient if you can afford to forego the
'         compatibility issue.
'
'         ** Also, you can not index based on extended data types unless
'            you use the xdbMKL or xdbMKI 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:8) As String
  Fd(1) = "CUSTID,C,7,0"    'Character field, length 7
  Fd(2) = "CUSTNAME,C,35,0" 'Character field, length 35
  Fd(3) = "NUM1,I,2,0"      'Integer field, length 2 (will always be 2 regardless of the number entered)
  Fd(4) = "NUM2,W,4,0"      'Long field, length 4 (will always be 4 regardless of the number entered)
  Fd(5) = "NUM3,S,4,0"      'Single field, length 4 (will always be 4 regardless of the number entered)
  Fd(6) = "NUM4,X,8,0"      'Double field, length 8 (will always be 8 regardless of the number entered)
  Fd(7) = "NUM5,Y,8,0"      'Currency field, length 8 (will always be 8 regardless of the number entered)
  Fd(8) = "NOTES,Z,4,0"     'Binary memo field, length always 4. Replaces the "M" datatype which is length 10.

'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&) & " creating database.",,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")
  IntegerField& = xdbFieldNumber&(dbHandle&, "NUM1")
  LongField& = xdbFieldNumber&(dbHandle&, "NUM2")
  SingleField& = xdbFieldNumber&(dbHandle&, "NUM3")
  DoubleField& = xdbFieldNumber&(dbHandle&, "NUM4")
  CurrencyField& = xdbFieldNumber&(dbHandle&, "NUM5")


  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 xdbAssignFieldINT(dbHandle&, "", IntegerField&, 322)
     Call xdbAssignFieldLNG(dbHandle&, "", LongField&, 567322)
     Call xdbAssignFieldSNG(dbHandle&, "", SingleField&, 1234.5433)
     Call xdbAssignFieldDBL(dbHandle&, "", DoubleField&, 546677.5433439)
     Call xdbAssignFieldCUR(dbHandle&, "", CurrencyField&, 567.45)

     '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


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

MsgBox "Database and Index created.",,Title$
  
End Function