pbseek.bas

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

'*********************************************************************
'
'Purpose: Demo code showing how to seek for keys in an index. If the
'         key is found then the record is automatically loaded into 
'         the record buffer. If the key is not found then the record
'         pointer is positioned to the point where the record would
'         be located had it existed.
'
'         This code also shows how to perform Partial key searches.
'
'Paul Squires (2000-2003)
'
'*********************************************************************
 

#Compile Exe

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


Function PbMain () As Long

   Go_Cheetah    '  MACRO sends the Cheetah Authorization Signal
   
   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,N,5,0"     'Numeric field, length 5
   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         'allow duplicates in the index
   
   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& = 1000
   
   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")
   
   Randomize Timer
   
   CustID$ = Space$(xdbFieldLength&(dbHandle&, CustIDfield&))
  
   For x& = 1 To NumRecs&
   
      Call xdbClearBuffer(dbHandle&)  'this will clear the record buffer
      
      temp& = Rnd(10000, 99999)     'get a random 5 digit customer number
      CustID$ = Ltrim$(Str$(temp&))
      
      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 x&
   
   
   '  Seek for a key value. If the value is not found using an exact 
   '  Seek then perform a partial seek afterwards.
   LookFor$ = "10000"  
   
   '  Turn On exact Match Requirement
   ExactSearch& = %XDBTRUE
   
   '  Search the Index
   stat& = xdbSeek&(dbHandle&, idxHandle&, LookFor$)
   
   If stat& = 0 Then
      '  No exact match found. Perform a Partial seek to get all 
      '  customer ID's that start with "10".  
      
      LookFor$ = "10"    'DO NOT use a search string like "10   " 
      
      '  This Partial Seek will set 'stat& = 1', allowing entry 
      '  into the loop 'Do Until stat& = %XDBFALSE' block.
      stat& = xdbSeekPartial(dbHandle&, idxHandle&, LookFor$)
      ExactSearch& = %XDBFALSE
   Else
      '  Get the Record Number that Seek found an Exact Matching Key
      RecNum& = xdbRecordNumber&(dbHandle&)             
      
      '  Get the Key field Value of the Exact Matching Key
      KeyFound$ = xdbFieldValue$(dbHandle&, "", 1)
   End If                     
   
   NumFound& = 0
   
   Do Until stat& = %XDBFALSE
      NumFound& = NumFound& + 1
      
      If ExactSearch& = %XDBTRUE Then
         '   Locate any record with an exact key match
         stat& = xdbSeekNext&(dbHandle&, idxHandle&, LookFor$)
      Else
         
         While Stat& <> 0  '  Loop when mutiple results are possible
            '   Locate any record with a partial key match
            stat& = xdbSeekPartialNext&(dbHandle&, idxHandle&, LookFor$)
            
            '  If stat& = 1, then Record Buffer now has a matching record
            If stat& > 0 Then               
               '  Increment Counter
               NumFound& = NumFound& + 1
               
               '  Get the Record Number that matched Partial Seek
               RecNum& = xdbRecordNumber&(dbHandle&)             
               
               '  Get the Key field Value of the partial match
               KeyFound$ = xdbFieldValue$(dbHandle&, "", 1)
            End If
         Wend  '  Stat& <> 0      
      End If   
   Loop  '  Until stat& = %XDBFALSE
   
   
   If ExactSearch& = %XDBTRUE Then
      msg$ = "Exact key search found" & Str$(NumFound&) & " matches."
   Else
      msg$ = "Partial key search found" & Str$(NumFound&) & " matches."
   End If     
   
   MsgBox msg$
   
   
   '  Close the database and related index
   Call xdbClose(dbHandle&)
   
   MsgBox "pbSeek demo completed."
   
   
End Function