pbmemo.bas

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

'*********************************************************************
'
'Purpose: Demo code showing how to add and delete memo records. Memo 
'         fields are created using the "M" or "Z" field types. The 
'         actual memo data is stored in a separate file. For this
'         reason it is more efficient for you to store smaller strings
'         in "C" character fields. Those fields can store strings up
'         to 256 characters in length. Any strings longer than that 
'         will have to be stored in memo fields.
'
'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:4) 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 "###########.##")
  Fd(4) = "NOTES,M,10,0"     'Memo field, this is a pointer into the .dbt memo file

'create the database. Because the database contains a Memo field ("M" or "Z") then
'the associated .dbt memo file will created automatically.
  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 database.",,Title$
     Call xdbResetError
     Exit Function
  End If


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

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")
  NotesField& = xdbFieldNumber&(dbHandle&, "NOTES")


  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 database record.",,Title$
        Call xdbResetError
        Exit For
     End If
  
  Next


'update record #100 by adding a notes memo to it.
  Notes$ = "This is my first note that I am adding to record #100."
  Call xdbGetRecord(dbHandle&, 100)
  Call xdbAssignField(dbHandle&, "", NotesField&, Notes$)
  Call xdbPutRecord(dbHandle&, 100)

'display the note
  Call xdbGetRecord(dbHandle&, 100)
  Notes$ = xdbFieldValue$(dbHandle&, "", NotesField&)
  
  MsgBox "Memo for Record# 100: " & Notes$
  
'delete the note (this is accomplished by writing "" to the memo field.
  Call xdbGetRecord(dbHandle&, 100)
  Call xdbAssignField(dbHandle&, "", NotesField&, "")
  Call xdbPutRecord(dbHandle&, 100)
  
'display the note (it should not exist)
  Call xdbGetRecord(dbHandle&, 100)
  Notes$ = xdbFieldValue$(dbHandle&, "", NotesField&)
  
  MsgBox "Updated Memo (deleted) for Record# 100: " & Notes$


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

MsgBox "Completed."
  
End Function