home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Programming Tool Box
/
SIMS_2.iso
/
vb_code2
/
v_browse
/
mdb001m.bas
< prev
next >
Wrap
BASIC Source File
|
1993-09-20
|
7KB
|
192 lines
Global dbngMDBDataBase As Database
Global tdfgMDBTblDefs As TableDefs
Global tblgMDBTbl As Table
Global Const MDB_TBL_EOF_FLAG = -9001
Global Const MDB_SEEK_NOMATCH = -9000
Global Const MDB_TBL_EMPTY_FLAG = -8999
Global Const MDB_NO_VALUE = -1
Global Const MDB_UNKNOWN_VALUE = -99
Global Const MDB_NULL_STRING = "NULL"
Global Const MDB_DBL_QUESTIONS = "??"
Global Const MDB_DYNASET_READONLY = 4
Global Const MDB_SUCCESSFUL = 1
Global Const DB_BINARY = 9
Global Const DB_BOOLEAN = 1
Global Const DB_BYTE = 2
Global Const DB_CURRENCY = 5
Global Const DB_DATE = 8
Global Const DB_DOUBLE = 7
Global Const DB_INTEGER = 3
Global Const DB_LONG = 4
Global Const DB_LONGBINARY = 11
Global Const DB_MEMO = 12
Global Const DB_SINGLE = 6
Global Const DB_TEXT = 10
Function fntCloseMDBDataBase% ()
Dim nFunctRetVal%
On Error GoTo fntCloseMDBDataBaseErr
'----------------------------------------------------------------------------
' NOTE-> CLOSE the DATABASE...
'----------------------------------------------------------------------------
dbngMDBDataBase.Close
'----------------------------------------------------------------------------
' NOTE-> RELEASE memory used by DATABASE OBJECT VARIABLES...
'----------------------------------------------------------------------------
Set dbngMDBDataBase = Nothing
Set tdfgMDBTblDefs = Nothing
Set tblgMDBTbl = Nothing
fntCloseMDBDataBase% = True
Exit Function
'----------------------------------------------------------------------------
' ERROR HANDLER-> exit procedure with FALSE status when error...
'----------------------------------------------------------------------------
fntCloseMDBDataBaseErr:
Resume fntCloseMDBDataBaseExit
fntCloseMDBDataBaseExit:
fntCloseMDBDataBase% = True
End Function
Function fntCloseMDBTbl% ()
Dim nFunctRetVal%
On Error GoTo fntCloseMDBTblErr
tblgMDBTbl.Close
fntCloseMDBTbl% = True
Exit Function
'----------------------------------------------------------------------------
' ERROR HANDLER-> exit procedure with FALSE status when error...
'----------------------------------------------------------------------------
fntCloseMDBTblErr:
Resume fntCloseMDBTblExit
fntCloseMDBTblExit:
fntCloseMDBTbl% = False
End Function
Function fntGetMDBTblNames% (szMDBTblName$)
Dim nCols%
Dim nFunctRetVal%
Dim nIdx%
Dim nListCols%
Dim nListTbls%
Dim nSelTblIdx%
Dim nTbls%
Dim szTbl$
'----------------------------------------------------------------------------
' NOTE-> LOAD the TABLES listbox with all of the table names in the MDB...
'----------------------------------------------------------------------------
BRW001F.clbTbls.Clear
nTbls% = BRW001F.datJET.Database.TableDefs.Count
If (nTbls% < 1) Then
nFunctRetVal% = False
fntGetMDBTblNames% = nFunctRetVal%
End If
nListTbls% = nTbls% - 1
For nIdx% = 0 To nListTbls%
szTbl$ = BRW001F.datJET.Database.TableDefs(nIdx%).Name
BRW001F.clbTbls.AddItem szTbl$
If (szTbl$ = szMDBTblName$) Then
nSelTblIdx% = nIdx%
End If
Next nIdx%
If (szMDBTblName$ = "UNKNOWN_AT_THIS_TIME") Then
nSelTblIdx% = 0
szMDBTblName$ = BRW001F.clbTbls.List(0)
End If
BRW001F.clbTbls.ListIndex = nSelTblIdx%
'----------------------------------------------------------------------------
' NOTE-> LOAD the COLUMNS listbox with all of the columns names for the
' SPECIFIED TABLE (using szMDBTblName$)...
'----------------------------------------------------------------------------
BRW001F.clbCols.Clear
BRW001F.clbTypes.Clear
nCols% = BRW001F.datJET.Database.TableDefs(szMDBTblName$).Fields.Count
If (nCols% < 1) Then
nFunctRetVal% = False
fntGetMDBTblNames% = nFunctRetVal%
Exit Function
End If
nListCols% = nCols% - 1
For nIdx% = 0 To nListCols%
szItem$ = BRW001F.datJET.Database.TableDefs(szMDBTblName$).Fields(nIdx%).Name
nFldType% = BRW001F.datJET.Database.TableDefs(szMDBTblName$).Fields(nIdx%).Type
lFldSize& = BRW001F.datJET.Database.TableDefs(szMDBTblName$).Fields(nIdx%).Size
Select Case nFldType%
Case DB_BINARY
szFldType$ = "BINARY"
Case DB_BOOLEAN
szFldType$ = "BOOLEAN"
Case DB_BYTE
szFldType$ = "BYTE"
szFldType$ = szFldType$ + "(4)"
Case DB_CURRENCY
szFldType$ = "CURRENCY"
szFldType$ = szFldType$ + "(32)"
Case DB_DATE
szFldType$ = "DATE"
szFldType$ = szFldType$ + "(30)"
Case DB_DOUBLE
szFldType$ = "DOUBLE"
szFldType$ = szFldType$ + "(24)"
Case DB_INTEGER
szFldType$ = "INTEGER"
szFldType$ = szFldType$ + "(8)"
Case DB_LONG
szFldType$ = "LONG"
szFldType$ = szFldType$ + "(16)"
Case DB_LONGBINARY
szFldType$ = "LONGBINARY"
szFldType$ = szFldType$ + "(0)"
Case DB_MEMO
szFldType$ = "MEMO"
szFldType$ = szFldType$ + "(0)"
Case DB_SINGLE
szFldType$ = "SINGLE"
szFldType$ = szFldType$ + "(16)"
Case DB_TEXT
szFldType$ = "TEXT"
szFldType$ = szFldType$ + "(" + Trim$(Str$(lFldSize&)) + ")"
Case Else
szFldType$ = "UNKNOWN"
szFldType$ = szFldType$ + "(0)"
End Select
BRW001F.clbCols.AddItem szItem$
BRW001F.clbTypes.AddItem szFldType$
Next nIdx%
BRW001F.clbCols.ListIndex = 0
BRW001F.clbTypes.ListIndex = 0
nFunctRetVal% = nCols%
fntGetMDBTblNames% = nFunctRetVal%
End Function
Function fntOpenMDBDataBase% (szMDBDataBasePath$)
Dim nFunctRetVal%
On Error GoTo fntOpenMDBDataBaseErr
Set dbngMDBDataBase = OpenDatabase(szMDBDataBasePath$, True)
Set tdfgMDBTblDefs = dbngMDBDataBase.TableDefs
fntOpenMDBDataBase% = True
Exit Function
'----------------------------------------------------------------------------
' ERROR HANDLER-> exit procedure with FALSE status when error...
'----------------------------------------------------------------------------
fntOpenMDBDataBaseErr:
Resume fntOpenMDBDataBaseExit
fntOpenMDBDataBaseExit:
fntOpenMDBDataBase% = True
End Function
Function fntOpenMDBTbl% (szMDBTblName$)
Dim nFunctRetVal%
On Error GoTo fntOpenMDBTblErr
Set tblgMDBTbl = dbngMDBDataBase.OpenTable(szMDBTblName$)
fntOpenMDBTbl% = True
Exit Function
'----------------------------------------------------------------------------
' ERROR HANDLER-> exit procedure with FALSE status when error...
'----------------------------------------------------------------------------
fntOpenMDBTblErr:
Resume fntOpenMDBTblExit
fntOpenMDBTblExit:
fntOpenMDBTbl% = False
End Function