pbdelete.bas

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

'*********************************************************************
'
'Purpose: Demo code showing how to delete records from the database
'         and then traverse through the database ignoring deleted 
'         records.
'
'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$
     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$
     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$
     Exit Function
  End If

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


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


'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 record."
        Exit For
     End If   
  
  Next


  msg$ = "Database Records BEFORE delete: " & Str$(xdbRecordCount&(dbHandle&))
  MsgBox msg$

'delete 3 records. The record must first be loaded into the record buffer
'before it can be marked for deletion. Records are not physically removed
'from the database until xdbPack or xdbZap is called. This gives you the
'opportunity to recall (unmark from deletion) records using the xdbRecall
'function call.

  Call xdbDeleteRecord(dbHandle&, 100)    'mark record 100 for deletion
  Call xdbDeleteRecord(dbHandle&, 101)    'mark record 101 for deletion
  Call xdbDeleteRecord(dbHandle&, 102)    'mark record 102 for deletion


'notice the number of records have not changed. The records are only marked
'for deletion. If you are moving through the database and want to exclude
'processing any deleted records then you should test the record using the
'xdbDeleted& function or set the xdbSkipDeleted function to %XDBTRUE.
  msg$ = "Database Records AFTER delete: " & Str$(xdbRecordCount&(dbHandle&))
  MsgBox msg$


'now move through the database ignoring all deleted records (using the
'idxHandle& index)
  MsgBox "Move through records ignoring deleted records (xdbDeleted)."
  
  Call xdbMoveFirst(dbHandle&, idxHandle&)
  
  NumProcessed& = 0
  Do Until xdbEOF&(dbHandle&)
     
     If xdbDeleted&(dbHandle&, xdbRecordNumber&(dbHandle&)) Then
        'this record is deleted so skip it!
     Else
        'process the record
        NumProcessed& = NumProcessed& + 1
     End If
           
     Call xdbMoveNext(dbHandle&, idxHandle&)
  
  Loop
  
  MsgBox "Processed" & Str$(NumProcessed&) & " non-deleted records in the database."



'now move through the database ignoring all deleted records (using the
'idxHandle& index). Use the alternate method of using xdbSkipDeleted.
  MsgBox "Move through records ignoring deleted records (xdbSkipDeleted)."
  
  Call xdbSkipDeleted(dbHandle&, %XDBTRUE)
  
  Call xdbMoveFirst(dbHandle&, idxHandle&)
  
  NumProcessed& = 0
  Do Until xdbEOF&(dbHandle&)
     
     'process the record
     NumProcessed& = NumProcessed& + 1
           
     Call xdbMoveNext(dbHandle&, idxHandle&)
  
  Loop
  
  MsgBox "Processed" & Str$(NumProcessed&) & " non-deleted records in the database."



'pack the database. This will physically remove all records marked for
'deletion. The changes are permanent - records can not be recalled after
'this function is called. Any open indexes are automatically reindexed.

  Call xdbPack(dbHandle&)

'the record count should now be properly reflected.
  msg$ = "Database Records AFTER Pack: " & Str$(xdbRecordCount&(dbHandle&))
  MsgBox msg$

'zap the database. This instantly deletes all records and related index
'keys. You can not recover from this process so it is advisable to make
'backups of the database and indexes prior to calling this function. You
'do not have to manually call the idxReindex routine.

  Call xdbZap(dbHandle&)

'the record count should now be zero.
  msg$ = "Database Records AFTER zap: " & Str$(xdbRecordCount&(dbHandle&))
  MsgBox msg$


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

  
End Function