pbcreate.bas

来自「功能强大的 DBF 数据库操作 dll,可以让 VB 和 POWERBASIC 」· BAS 代码 · 共 114 行

'*********************************************************************
'
'Purpose: Demo code showing how to create a database and index. Also
'         shows how to open and close the database and index.
'
'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())
  'to create a database using encyption and/or variable length memo fields then 
  'use the xdbCreateEX function.
  If xdbError Then
     MsgBox "Error: " & Str$(xdbError&) & " creating database.",,Title$
     Call xdbResetError
     Exit Function
  End If


'some languages do not recognize the string array that is passed to
'the xdbCreate function (e.g. UltiMade). In those cases you should
'use the following alternative database creation code.

'CALL xdbAddField("CUSTID,C,7,0")
'CALL xdbAddField("CUSTNAME,C,35,0")
'CALL xdbAddField("SALARY,N,14,2)
'CALL xdbCreateFields(DBFname$)   'this creates the database



'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 duplicate customer ID's

  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
  
  msg$ = "DBFname: " & DBFname$ & $CrLf & "dbHandle:" & Str$(dbHandle&) & $CrLf & $CrLf & "IDXname: " & IDXname$ & $CrLf & "idxHandle:" & Str$(idxHandle&)
  MsgBox msg$
  

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


End Function