pbspeed.bas

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

'*********************************************************************
'
'Purpose: Demo code showing performance of Cheetah's xdbSpeedAppend.
'
'Paul Squires (2000-2003)
'
'*********************************************************************

#Compile Exe

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

#Include "WIN32API.INC"

 
Function PbMain ( ) As Long


  Title$ = "Cheetah Database System"

'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$ = "Speed.dbf"
  IDXname$ = "Speed.idx"           
  
  msg$ = "This is a simple demo that creates a 10,000 record sample database and index " _
          & $CrLf & $CrLf & "It demonstrates Cheetah's speed at creating databases from scratch."
  
  result& = MsgBox(msg$, %MB_ICONINFORMATION Or %MB_OKCANCEL, Title$)
  
  If result& = %IDCANCEL Then Exit Function
         


'define the structure of the databases
'the database is very simple (only one field!)
'the index is on a 5 character Postal Code field.

  Dim Fd(1:1) As String
  Fd(1) = "POSTAL,C,5,0"    'Character field, length 5

'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)
  'open only allowing writing and denying all other users read/write access
  'this will improve performance.

  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$ = "POSTAL"   '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


  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& = 10000

SpeedOn& = %XDBTRUE
'SpeedOn& = %XDBFALSE


MsgBox "Press 'Okay' to create " & Str$(NumRecs&) & " database 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.
  PostalField& = xdbFieldNumber&(dbHandle&, "POSTAL")

  Postal$ = Space$(xdbFieldLength&(dbHandle&, PostalField&))

If SpeedOn& = %XDBTRUE Then
  'turn on the buffered append writes
  Call xdbSpeedAppend(dbHandle&, %XDBTRUE)
End If
 
StartTime! = Timer

  For x& = 1 To NumRecs&

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

     RSet Postal$ = LTrim$(Str$(x&+1000))
     Call xdbAssignField(dbHandle&, "", PostalField&, Postal$)

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

  Next


If SpeedOn& = %XDBTRUE Then
  'make sure to turn off buffered append writes
  'so all records are written.
  Call xdbSpeedAppend(dbHandle&, %XDBFALSE)
End If


StatusTime! = Timer
TimeResults! = (StatusTime! - StartTime!)

If xdbError& Then
   MsgBox "Error: " & Str$(xdbError&)
Else   
   MsgBox "Database Records Created.  Secs:" & Str$(TimeResults!) + " - RecsPerSec: " + Str$(Int((NumRecs&) / (TimeResults!)))
End If   



StartTime! = Timer

Call xdbReindex(dbHandle&, idxHandle&)

StatusTime! = Timer
TimeResults! = (StatusTime! - StartTime!)

If xdbError& Then
   MsgBox "Error: " & Str$(xdbError&)
Else   
   MsgBox "Index Created.  Secs:" & Str$(TimeResults!) + " - RecsPerSec: " + Str$(Int((NumRecs&) / (TimeResults!)))
End If   


ExitOut:

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



End Function