pbupdate.bas

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

'*********************************************************************
'
'Purpose: Demo code showing how to retrieve the values of each field
'         in a record and how to update those field values and store
'         the results in the database (updating any changed key fields
'         as necessary).
'
'
'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
'NOTE: When adding a large number of records it is better to close
'the index, do the appends to the database and then open the
'index and reindex.
  NumRecs& = 100

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&, "Billy Gates" & Str$(x&))
     Call xdbAssignField(dbHandle&, "", SalaryField&, "100234.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


msg$ = "Database and Index records created." & $Lf & $Lf & "Next, retrieve record field values..."
MsgBox msg$,, Title$


'the database and index now contains records. Get one of the records, check its
'field values, change a value and post it back to the database (which automatically
'updates any open indexes if the key field was changed).

'Get a record. This automatically loads the RecordBuffer with the record's data.
'I'll retrieve and update the first record in the database.

RecordNumber& = 1
Call xdbGetRecord(dbHandle&, RecordNumber&)  'the recordbuffer is now loaded

'Instead of using xdbGetRecord you could also have used any of the xdbMove
'functions. When the position in the database/index is changed using the
'xdbMove functions, the RecordBuffer is automatically loaded correctly.

'You can view the raw recordbuffer using the xdbRecordBuffer function. However,
'it is recommended that you use the xdbFieldValue functions (refer to the
'Cheetah Help file for syntax usage).

'retrieve the field values from the current record. I will use the field numbers
'because they are already known. You could just as easily pass the field name
'instead. There is barely any difference in speed because Cheetah uses an
'EXTREMELY fast lookup for fieldnames! 

'using the FieldNumber&
CustID$ = xdbFieldValue$(dbHandle&, "", CustIDfield&)
'or, use the FieldName$ instead.
'CustID$ = xdbFieldValue$(dbHandle&, "CUSTID", 0)

CustName$ = xdbFieldValue$(dbHandle&, "", CustNamefield&)
'CustName$ = xdbFieldValue$(dbHandle&, "CUSTNAME", 0)

Salary$ = xdbFieldValue$(dbHandle&, "", SalaryField&)
'Salary$ = xdbFieldValue$(dbHandle&, "SALARY", 0)

'display the values
msg$ = "Record #" & Str$(xdbRecordNumber&(dbHandle&)) & " Field Values:" & $Lf & $Lf _ 
        & "CustID: " & CustID$ & $Lf _
        & "CustName: " & CustName$ & $Lf _
        & "Salary: " & Salary$ & $Lf & $Lf _
        & "Now, change the CustName and store it back in the database...."

MsgBox msg$,,title$        


'update the record in the record buffer and store it back in the database. This
'will automatically update the index if necessary (in this case the key, CustID, is
'not being changed so the index will not be updated).

'store new CustName$. This updates the RecordBuffer (not the actual database)
Call xdbAssignField(dbHandle&, "CUSTNAME", 0, "Paul Squires")

'store the RecordBuffer in the database/index.
Call xdbPutRecord(dbHandle&, RecordNumber&)

msg$ = "The record has been updated. Now read the database again" & $Lf _
       & "to ensure that the changes are there..."
MsgBox msg$,,title$       



'verify that the values were written correctly.
Call xdbGetRecord(dbHandle&, RecordNumber&)  'the recordbuffer is now loaded

CustID$ = xdbFieldValue$(dbHandle&, "CUSTID", 0)
CustName$ = xdbFieldValue$(dbHandle&, "CUSTNAME", 0)
Salary$ = xdbFieldValue$(dbHandle&, "", SalaryField&)

'display the values
msg$ = "Record #" & Str$(xdbRecordNumber&(dbHandle&)) & " Field Values:" & $Lf & $Lf _ 
        & "CustID: " & CustID$ & $Lf _
        & "CustName: " & CustName$ & $Lf _
        & "Salary: " & Salary$ & $Lf & $Lf _
        & "That's it! ...."

MsgBox msg$,,title$        


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

MsgBox "pbUpdate demo completed."
  
End Function