pbquery.bas

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

'*********************************************************************
'
'Purpose: Demo code showing how to perform queries. Uses a very large
'         sample database.
'
'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$ = "Catalog.dbf"
    IDXname$ = "Catalog.idx"


'***** NOTE *****
'the Catalog database is very large > 10 megs and can be downloaded separately from the
'main Cheetah distribution package. The compressed ZIP size of the database and index is
'about 1.3 megs and can be downloaded from:
'***************************************************************************************
'  http://www.PlanetSquires/SampleDBF.zip   'Note: this link is case sensitive.
'***************************************************************************************

    
'open the database (database must be open prior to creating index)
    dbHandle& = xdbOpen&(DBFname$)
    If xdbError& Then
       MsgBox "Error opening database.",,Title$
       Exit Function
    End If


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


'create some queries and display the results in a temporary disk text file

    MsgBox "Ready to process Query#1",,Title$


'each query must be specified by a unique handle. The xdbCreateQuery function allocates
'space for the query and returns a valid query handle.
    Query1& = xdbCreateQuery&(dbHandle&)
    
    If xdbError& Then
     MsgBox "Error" & Str$(xdbError&) & " creating query",,Title$
     Exit Function
    End If

'build the query by specifying "conditions". The following are specially defined constants
'for each equality.
    ' %EQUAL_TO = 1
    ' %NOT_EQUAL_TO = 2
    ' %LESS_THAN = 3
    ' %GREATER_THAN = 4
    ' %LESS_THAN_EQUAL_TO = 5
    ' %GREATER_THAN_EQUAL_TO = 6
    ' %CONTAINS = 7
    ' %BETWEEN = 8
    ' %SUM = 9 
    ' %MINIMUM = 10 
    ' %MAXIMUM = 11 
    ' %AVERAGE = 12 
    ' %WILDCARD = 13

'the first query will find all records where the manufacturer equals 3COM. We will sort the
'query results by PRICE in ascending order.
    Call xdbQueryCondition(Query1&, 0, "MANUF", %EQUAL_TO, "3COM", "")
    Call xdbQuerySort(Query1&, "PRICE", %SORT_ASCEND)
    
    If xdbError& Then
       MsgBox "Error" & Str$(xdbError&)
       Call xdbClose(dbHandle&)
       Exit Function
    End If 

'the query is created when you call xdbQueryExecute
    starttime! = Timer
    Call xdbQueryExecute(Query1&)
    endtime! = Timer
    
    MsgBox "Time for query: " & Format$(endtime!-starttime!, "###.####") & " secs." & $CrLf & "NumRecords:" & Str$(xdbRecordCount&(Query1&)),,Title$


'cycle through the record set and print the results to a text file
'you could also skip through the file from last to first using xdbMoveLast, xdbMovePrev and test for the xdbBOF flag. 
    f& = FreeFile
    Open "query1.txt" For Output As #f&
    
    Print #f&, "Record Count: " & Str$(xdbRecordCount&(Query1&))

    Call xdbMoveFirst(Query1&, 0)  'queries do not require the index parameter - it would be ignored anyway.
    
    Do Until xdbEOF&(Query1&)
       Print #f&, "Rec#:" & Str$(xdbRecordNumber&(Query1&)) & "  " & xdbFieldValue$(Query1&, "MANUF", 0) 
    
       Call xdbMoveNext(Query1&, 0)
    Loop


    'The following is an alternate method for retrieving the "i-th" record in a query result.
    'You can loop through the query results by using the ordinal record numbers for the query. 
    
    'For x& = 1 To xdbRecordCount(Query1&)
    '   Call xdbGetRecord(Query1&, x&)
    '   Print #f&, "Rec#:" & Str$(xdbRecordNumber&(Query1&)) & "  " & xdbFieldValue$(Query1&, "MANUF", 0) 
    'Next        


    
    Close #f&


'lastly, destroy the query in order to reclaim the memory used and delete the temporary
'query disk file.
    Call xdbDestroyQuery(Query1&)




MsgBox "Ready to process Query#2",,Title$

'The next query is a little more complex.
'create the next query where the manufacturer contains the text string 'COM' and the price
'contains values between 5000 and 10000. When the field is a numeric "N", then the numbers
'are automatically formatted correctly. The query results are sorted by manufacturer and
'price. The sort is specified using xdbQuerySort. This function uses the same expression
'parser as the one used to create indexes.
    Query2& = xdbCreateQuery&(dbHandle&)
    
    If xdbError& Then
       MsgBox "Error" & Str$(xdbError&) & " creating query",,Title$
       Call xdbClose(dbHandle&)
       Exit Function
    End If
    
    Call xdbQueryCondition(Query2&, 0, "MANUF", %CONTAINS, "COM", "")
    Call xdbQueryCondition(Query2&, %QUERY_AND, "PRICE", %BETWEEN, "5000", "10000")
    
    Call xdbQueryCondition(Query2&, 0, "PRICE", %SUM, "", "")
    Call xdbQueryCondition(Query2&, 0, "PRICE", %MINIMUM, "", "")
    Call xdbQueryCondition(Query2&, 0, "PRICE", %MAXIMUM, "", "")
    Call xdbQueryCondition(Query2&, 0, "PRICE", %AVERAGE, "", "")
    
    starttime! = Timer
    Call xdbQueryExecute(Query2&)
    endtime! = Timer
    MsgBox "Time for query: " & Format$(endtime!-starttime!, "###.####") & " secs." & $Lf & "NumRecords:" & Str$(xdbRecordCount&(Query2&)),,Title$
    
    
'cycle through the record set and print the results to a text file
'notice how the results are sorted by MANUF then by PRICE.
    f& = FreeFile
    Open "query2.txt" For Output As #f&
    
'to access the SUM of the PRICE field you need to call the xdbQuerySUM function specifying the PRICE field
'print the SUM to the text file so you can view it. SUM returns a DOUBLE value.
    SumValue# = xdbQuerySUM#(Query2&, "PRICE")
    MinValue# = xdbQueryMIN#(Query2&, "PRICE")
    MaxValue# = xdbQueryMAX#(Query2&, "PRICE")
    AvgValue# = xdbQueryAVG#(Query2&, "PRICE")
    
    Call xdbFieldPadding(Query2&, %XDBTRUE)

    Print #f&, "Record Count: " & Str$(xdbRecordCount&(Query2&))
    Print #f&, "PRICE SUM: " & Str$(SumValue#)
    Print #f&, "PRICE MIN: " & Str$(MinValue#)
    Print #f&, "PRICE MAX: " & Str$(MaxValue#)
    Print #f&, "PRICE AVG: " & Str$(AvgValue#)
    Print #f&, ""
    
    Call xdbMoveFirst(Query2&, 0)  'queries do not require the index parameter - it would be ignored anyway.

    Do Until xdbEOF&(Query2&)
       RecNum$ = Str$(xdbRecordNumber&(Query2&))
       manuf$ = xdbFieldValue$(Query2&, "MANUF", 0)
       price$ = xdbFieldValue$(Query2&, "PRICE", 0) 
       
       st$ = "Rec#:" & RecNum$ & "  " & manuf$ & price$
       
       Print #f&, st$
       Call xdbMoveNext(Query2&, 0)
    Loop
    
    Close #f&
    
    
    Call xdbDestroyQuery(Query2&)


'the third query is the most complex query. It uses parenthesis in the field names in order to create 
'subexpressions that will be evaluated together.
'The following query represents: 
  '(MANUF %CONTAINS "COM" .And. CPU_OS = "PC") .Or. (PRICE %BETWEEN 3000, 6000 .And. MEDIA = "EXT")
 
    Query3& = xdbCreateQuery&(dbHandle&)
    
    If xdbError& Then
       MsgBox "Error" & Str$(xdbError&) & " creating query",,Title$
       Call xdbClose(dbHandle&)
       Exit Function
    End If

    Call xdbQueryCondition(Query3&, 0, "(MANUF", %CONTAINS, "COM", "")
    Call xdbQueryCondition(Query3&, %QUERY_AND, "CPU_OS)", %EQUAL_TO, "PC", "")
    Call xdbQueryCondition(Query3&, %QUERY_OR, "(PRICE", %BETWEEN, "3000", "6000")
    Call xdbQueryCondition(Query3&, %QUERY_AND, "MEDIA)", %EQUAL_TO, "EXT", "")

    starttime! = Timer
    Call xdbQueryExecute(Query3&)
    endtime! = Timer
    MsgBox "Time for query: " & Format$(endtime!-starttime!, "###.####") & " secs." & $Lf & "NumRecords:" & Str$(xdbRecordCount&(Query3&)),,Title$
    
    
'cycle through the record set and print the results to a text file
    f& = FreeFile
    Open "query3.txt" For Output As #f&
    
    Call xdbMoveFirst(Query3&, 0)  'queries do not require the index parameter - it would be ignored anyway.
    
    Call xdbFieldPadding(Query3&, %XDBTRUE)
    
    Print #f&, "Record Count: " & Str$(xdbRecordCount&(Query3&))

    Do Until xdbEOF&(Query3&)      
       RecNum$ = Str$(xdbRecordNumber&(Query3&))
       manuf$ = xdbFieldValue$(Query3&, "MANUF", 0)
       cpu_os$ = xdbFieldValue$(Query3&, "CPU_OS", 0) 
       price$ = xdbFieldValue$(Query3&, "PRICE", 0) 
       media$ = xdbFieldValue$(Query3&, "MEDIA", 0) 
       
       st$ = "Rec#:" & RecNum$ & "  " & manuf$ & cpu_os$ & "  " & price$ & "  " & media$
       
       Print #f&, st$
       Call xdbMoveNext(Query3&, 0)
    Loop
    
    Close #f&

MsgBox "All Queries Completed.",,Title$


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



End Function