home *** CD-ROM | disk | FTP | other *** search
/ Programming Tool Box / SIMS_2.iso / vb_code2 / v_browse / mdb001m.bas < prev    next >
BASIC Source File  |  1993-09-20  |  7KB  |  192 lines
  1. Global dbngMDBDataBase As Database
  2. Global tdfgMDBTblDefs  As TableDefs
  3. Global tblgMDBTbl      As Table
  4. Global Const MDB_TBL_EOF_FLAG = -9001
  5. Global Const MDB_SEEK_NOMATCH = -9000
  6. Global Const MDB_TBL_EMPTY_FLAG = -8999
  7. Global Const MDB_NO_VALUE = -1
  8. Global Const MDB_UNKNOWN_VALUE = -99
  9. Global Const MDB_NULL_STRING = "NULL"
  10. Global Const MDB_DBL_QUESTIONS = "??"
  11. Global Const MDB_DYNASET_READONLY = 4
  12. Global Const MDB_SUCCESSFUL = 1
  13. Global Const DB_BINARY = 9
  14. Global Const DB_BOOLEAN = 1
  15. Global Const DB_BYTE = 2
  16. Global Const DB_CURRENCY = 5
  17. Global Const DB_DATE = 8
  18. Global Const DB_DOUBLE = 7
  19. Global Const DB_INTEGER = 3
  20. Global Const DB_LONG = 4
  21. Global Const DB_LONGBINARY = 11
  22. Global Const DB_MEMO = 12
  23. Global Const DB_SINGLE = 6
  24. Global Const DB_TEXT = 10
  25.  
  26. Function fntCloseMDBDataBase% ()
  27. Dim nFunctRetVal%
  28. On Error GoTo fntCloseMDBDataBaseErr
  29. '----------------------------------------------------------------------------
  30. ' NOTE-> CLOSE the DATABASE...
  31. '----------------------------------------------------------------------------
  32. dbngMDBDataBase.Close
  33. '----------------------------------------------------------------------------
  34. ' NOTE-> RELEASE memory used by DATABASE OBJECT VARIABLES...
  35. '----------------------------------------------------------------------------
  36. Set dbngMDBDataBase = Nothing
  37. Set tdfgMDBTblDefs = Nothing
  38. Set tblgMDBTbl = Nothing
  39. fntCloseMDBDataBase% = True
  40. Exit Function
  41. '----------------------------------------------------------------------------
  42. ' ERROR HANDLER-> exit procedure with FALSE status when error...
  43. '----------------------------------------------------------------------------
  44. fntCloseMDBDataBaseErr:
  45.    Resume fntCloseMDBDataBaseExit
  46. fntCloseMDBDataBaseExit:
  47.    fntCloseMDBDataBase% = True
  48. End Function
  49.  
  50. Function fntCloseMDBTbl% ()
  51. Dim nFunctRetVal%
  52. On Error GoTo fntCloseMDBTblErr
  53. tblgMDBTbl.Close
  54. fntCloseMDBTbl% = True
  55. Exit Function
  56. '----------------------------------------------------------------------------
  57. ' ERROR HANDLER-> exit procedure with FALSE status when error...
  58. '----------------------------------------------------------------------------
  59. fntCloseMDBTblErr:
  60.    Resume fntCloseMDBTblExit
  61. fntCloseMDBTblExit:
  62.    fntCloseMDBTbl% = False
  63. End Function
  64.  
  65. Function fntGetMDBTblNames% (szMDBTblName$)
  66. Dim nCols%
  67. Dim nFunctRetVal%
  68. Dim nIdx%
  69. Dim nListCols%
  70. Dim nListTbls%
  71. Dim nSelTblIdx%
  72. Dim nTbls%
  73. Dim szTbl$
  74. '----------------------------------------------------------------------------
  75. ' NOTE-> LOAD the TABLES listbox with all of the table names in the MDB...
  76. '----------------------------------------------------------------------------
  77. BRW001F.clbTbls.Clear
  78. nTbls% = BRW001F.datJET.Database.TableDefs.Count
  79. If (nTbls% < 1) Then
  80.    nFunctRetVal% = False
  81.    fntGetMDBTblNames% = nFunctRetVal%
  82. End If
  83. nListTbls% = nTbls% - 1
  84. For nIdx% = 0 To nListTbls%
  85.    szTbl$ = BRW001F.datJET.Database.TableDefs(nIdx%).Name
  86.    BRW001F.clbTbls.AddItem szTbl$
  87.    If (szTbl$ = szMDBTblName$) Then
  88.       nSelTblIdx% = nIdx%
  89.    End If
  90. Next nIdx%
  91. If (szMDBTblName$ = "UNKNOWN_AT_THIS_TIME") Then
  92.    nSelTblIdx% = 0
  93.    szMDBTblName$ = BRW001F.clbTbls.List(0)
  94. End If
  95. BRW001F.clbTbls.ListIndex = nSelTblIdx%
  96. '----------------------------------------------------------------------------
  97. ' NOTE-> LOAD the COLUMNS listbox with all of the columns names for the
  98. '        SPECIFIED TABLE (using szMDBTblName$)...
  99. '----------------------------------------------------------------------------
  100. BRW001F.clbCols.Clear
  101. BRW001F.clbTypes.Clear
  102. nCols% = BRW001F.datJET.Database.TableDefs(szMDBTblName$).Fields.Count
  103. If (nCols% < 1) Then
  104.    nFunctRetVal% = False
  105.    fntGetMDBTblNames% = nFunctRetVal%
  106.    Exit Function
  107. End If
  108. nListCols% = nCols% - 1
  109. For nIdx% = 0 To nListCols%
  110.    szItem$ = BRW001F.datJET.Database.TableDefs(szMDBTblName$).Fields(nIdx%).Name
  111.    nFldType% = BRW001F.datJET.Database.TableDefs(szMDBTblName$).Fields(nIdx%).Type
  112.    lFldSize& = BRW001F.datJET.Database.TableDefs(szMDBTblName$).Fields(nIdx%).Size
  113.    Select Case nFldType%
  114.       Case DB_BINARY
  115.          szFldType$ = "BINARY"
  116.       Case DB_BOOLEAN
  117.          szFldType$ = "BOOLEAN"
  118.       Case DB_BYTE
  119.          szFldType$ = "BYTE"
  120.          szFldType$ = szFldType$ + "(4)"
  121.       Case DB_CURRENCY
  122.          szFldType$ = "CURRENCY"
  123.          szFldType$ = szFldType$ + "(32)"
  124.       Case DB_DATE
  125.          szFldType$ = "DATE"
  126.          szFldType$ = szFldType$ + "(30)"
  127.       Case DB_DOUBLE
  128.          szFldType$ = "DOUBLE"
  129.          szFldType$ = szFldType$ + "(24)"
  130.       Case DB_INTEGER
  131.          szFldType$ = "INTEGER"
  132.          szFldType$ = szFldType$ + "(8)"
  133.       Case DB_LONG
  134.          szFldType$ = "LONG"
  135.          szFldType$ = szFldType$ + "(16)"
  136.       Case DB_LONGBINARY
  137.          szFldType$ = "LONGBINARY"
  138.          szFldType$ = szFldType$ + "(0)"
  139.       Case DB_MEMO
  140.          szFldType$ = "MEMO"
  141.          szFldType$ = szFldType$ + "(0)"
  142.       Case DB_SINGLE
  143.          szFldType$ = "SINGLE"
  144.          szFldType$ = szFldType$ + "(16)"
  145.       Case DB_TEXT
  146.          szFldType$ = "TEXT"
  147.          szFldType$ = szFldType$ + "(" + Trim$(Str$(lFldSize&)) + ")"
  148.       Case Else
  149.          szFldType$ = "UNKNOWN"
  150.          szFldType$ = szFldType$ + "(0)"
  151.    End Select
  152.    BRW001F.clbCols.AddItem szItem$
  153.    BRW001F.clbTypes.AddItem szFldType$
  154. Next nIdx%
  155. BRW001F.clbCols.ListIndex = 0
  156. BRW001F.clbTypes.ListIndex = 0
  157. nFunctRetVal% = nCols%
  158. fntGetMDBTblNames% = nFunctRetVal%
  159. End Function
  160.  
  161. Function fntOpenMDBDataBase% (szMDBDataBasePath$)
  162. Dim nFunctRetVal%
  163. On Error GoTo fntOpenMDBDataBaseErr
  164. Set dbngMDBDataBase = OpenDatabase(szMDBDataBasePath$, True)
  165. Set tdfgMDBTblDefs = dbngMDBDataBase.TableDefs
  166. fntOpenMDBDataBase% = True
  167. Exit Function
  168. '----------------------------------------------------------------------------
  169. ' ERROR HANDLER-> exit procedure with FALSE status when error...
  170. '----------------------------------------------------------------------------
  171. fntOpenMDBDataBaseErr:
  172.    Resume fntOpenMDBDataBaseExit
  173. fntOpenMDBDataBaseExit:
  174.    fntOpenMDBDataBase% = True
  175. End Function
  176.  
  177. Function fntOpenMDBTbl% (szMDBTblName$)
  178. Dim nFunctRetVal%
  179. On Error GoTo fntOpenMDBTblErr
  180. Set tblgMDBTbl = dbngMDBDataBase.OpenTable(szMDBTblName$)
  181. fntOpenMDBTbl% = True
  182. Exit Function
  183. '----------------------------------------------------------------------------
  184. ' ERROR HANDLER-> exit procedure with FALSE status when error...
  185. '----------------------------------------------------------------------------
  186. fntOpenMDBTblErr:
  187.    Resume fntOpenMDBTblExit
  188. fntOpenMDBTblExit:
  189.    fntOpenMDBTbl% = False
  190. End Function
  191.  
  192.