home *** CD-ROM | disk | FTP | other *** search
/ Programming Tool Box / SIMS_2.iso / bp_3_94 / vbwin / makro / odbc.bas < prev   
BASIC Source File  |  1994-04-30  |  7KB  |  202 lines
  1. ' Option argument values (CreateDynaset, etc)
  2. Option Explicit
  3. Global Const DB_DENYWRITE = &H1
  4. Global Const DB_DENYREAD = &H2
  5. Global Const DB_READONLY = &H4
  6. Global Const DB_APPENDONLY = &H8
  7. Global Const DB_INCONSISTENT = &H10
  8. Global Const DB_CONSISTENT = &H20
  9. Global Const DB_SQLPASSTHROUGH = &H40
  10. ' SetDataAccessOption
  11. Global Const DB_OPTIONINIPATH = 1
  12. ' Field Attributes
  13. Global Const DB_FIXEDFIELD = &H1
  14. Global Const DB_VARIABLEFIELD = &H2
  15. Global Const DB_AUTOINCRFIELD = &H10
  16. Global Const DB_UPDATABLEFIELD = &H20
  17. ' Field Data Types
  18. Global Const DB_BOOLEAN = 1
  19. Global Const DB_BYTE = 2
  20. Global Const DB_INTEGER = 3
  21. Global Const DB_LONG = 4
  22. Global Const DB_CURRENCY = 5
  23. Global Const DB_SINGLE = 6
  24. Global Const DB_DOUBLE = 7
  25. Global Const DB_DATE = 8
  26. Global Const DB_TEXT = 10
  27. Global Const DB_LONGBINARY = 11
  28. Global Const DB_MEMO = 12
  29. ' TableDef Attributes
  30. Global Const DB_ATTACHEXCLUSIVE = &H10000
  31. Global Const DB_ATTACHSAVEPWD = &H20000
  32. Global Const DB_SYSTEMOBJECT = &H80000002
  33. Global Const DB_ATTACHEDTABLE = &H40000000
  34. Global Const DB_ATTACHEDODBC = &H20000000
  35.  
  36. ' ListTables TableType
  37. Global Const DB_TABLE = 1
  38. Global Const DB_QUERYDEF = 5
  39.  
  40. ' ListTables Attributes (for QueryDefs)
  41. Global Const DB_QACTION = &HF0
  42. Global Const DB_QCROSSTAB = &H10
  43. Global Const DB_QDELETE = &H20
  44. Global Const DB_QUPDATE = &H30
  45. Global Const DB_QAPPEND = &H40
  46. Global Const DB_QMAKETABLE = &H50
  47.  
  48. ' ListIndexes IndexAttributes values
  49. Global Const DB_UNIQUE = 1
  50. Global Const DB_PRIMARY = 2
  51. Global Const DB_PROHIBITNULL = 4
  52. Global Const DB_IGNORENULL = 8
  53. ' ListIndexes FieldAttributes value
  54. Global Const DB_DESCENDING = 1  'For each field in Index
  55.  
  56. ' CreateDatabase and CompactDatabase Language constants
  57. Global Const DB_LANG_GENERAL = ";LANGID=0x0809;CP=1252;COUNTRY=0"
  58. Global Const DB_LANG_SPANISH = ";LANGID=0x040A;CP=1252;COUNTRY=0"
  59. Global Const DB_LANG_DUTCH = ";LANGID=0x0413;CP=1252;COUNTRY=0"
  60. Global Const DB_LANG_SWEDFIN = ";LANGID=0x040C;CP=1252;COUNTRY=0"   'VB3 and Access 1.1 Databases
  61. Global Const DB_LANG_NORWDAN = ";LANGID=0x0414;CP=1252;COUNTRY=0"   'VB3 and Access 1.1 Databases
  62. Global Const DB_LANG_ICELANDIC = ";LANGID=0x040F;CP=1252;COUNTRY=0" 'VB3 and Access 1.1 Databases
  63. Global Const DB_LANG_NORDIC = ";LANGID=0x041D;CP=1252;COUNTRY=0"    'Access 1.0 Databases only
  64.  
  65. ' CreateDatabase and CompactDatabase options
  66. Global Const DB_VERSION10 = 1        ' Microsoft Access Version 1.0
  67. Global Const DB_ENCRYPT = 2          ' Make database encrypted.
  68. Global Const DB_DECRYPT = 4          ' Decrypt database while compacting.
  69.  
  70. 'Collating order values
  71. Global Const DB_SORTGENERAL = 256    ' Sort by EFGPI rules (English, French, German,Portuguese, Italian)
  72. Global Const DB_SORTSPANISH = 258    ' Sort by Spanish rules
  73. Global Const DB_SORTDUTCH = 259      ' Sort by Dutch rules
  74. Global Const DB_SORTSWEDFIN = 260    ' Sort by Swedish, Finnish rules
  75. Global Const DB_SORTNORWDAN = 261    ' Sort by Norwegian, Danish rules
  76. Global Const DB_SORTICELANDIC = 262  ' Sort by Icelandic rules
  77. Global Const DB_SORTPDXINTL = 4096   ' Sort by Paradox international rules
  78. Global Const DB_SORTPDXSWE = 4097    ' Sort by Paradox Swedish, Finnish rules
  79. Global Const DB_SORTPDXNOR = 4098    ' Sort by Paradox Norwegian, Danish rules
  80. Global Const DB_SORTUNDEFINED = -1   ' Sort rules are undefined or unknown
  81.  
  82. Global Const ODBC_DBASE_III = &H1&
  83. Global Const ODBC_DBASE_IV = &H2&
  84. Global Const ODBC_PARADOX_IIIX = &H4&
  85. Global Const ODBC_FOXPRO20 = &H8&
  86. Global Const ODBC_FOXPRO25 = &H10&
  87. Global Const ODBC_BTRIEVE = &H20&
  88.  
  89. Dim MainDB As Database
  90. Dim MainTable As Table
  91.  
  92. Function Exist (FileName$)
  93.     Dim ff
  94.     On Error Resume Next
  95.     ff = FreeFile
  96.     Open FileName For Input As ff
  97.     If Err = 0 Then
  98.         Exist = True
  99.     Else Exist = False
  100.     End If
  101.     Close ff
  102. End Function
  103.  
  104. Sub FileClose ()
  105.     Dim Makrotext As String, Arr$(), x As Integer, i
  106.     If GetMakroByName("Autoclose", Makrotext$) Then
  107.         x = LineUndoBreak(Makrotext$, Arr$())
  108.         ReDim Makro(UBound(Arr)) As MakroLine
  109.         For i = 1 To UBound(Arr)
  110.             Makro(i).LineIndex = i
  111.             Makro(i).LineCommand = Arr$(i)
  112.         Next
  113.         x = InterpretMakro(MODE_REALIZE, Makro(), x)
  114.     End If
  115.     
  116.     MainTable.Close
  117.     MainDB.Close
  118. End Sub
  119.  
  120. Sub FileInit ()
  121.     Dim Makrotext As String, Arr$(), x As Integer, i', Makro() As Makroline
  122.     FileOpen
  123.     If GetMakroByName("Autoexec", Makrotext$) Then
  124.         x = LineUndoBreak(Makrotext$, Arr$())
  125.         ReDim Makro(UBound(Arr)) As MakroLine
  126.         For i = 1 To UBound(Arr)
  127.             Makro(i).LineIndex = i
  128.             Makro(i).LineCommand = Arr$(i)
  129.         Next
  130.         x = InterpretMakro(MODE_REALIZE, Makro(), x)
  131.     End If
  132.     ShowAllMakros frmMain!cbo_Makro
  133. End Sub
  134.  
  135. Sub FileOpen ()
  136.     Dim FileName As String
  137.     FileName$ = App.Path
  138.     If Right$(FileName$, 1) <> "\" Then FileName$ = FileName$ & "\"
  139.     FileName$ = FileName$ & "makro.cmd"
  140.     If Not Exist(FileName$) Then
  141.         Dim t1 As New TableDef, i1 As New Index
  142.         Dim f1 As New Field, f2 As New Field
  143.         Set MainDB = CreateDatabase(FileName$, DB_LANG_GENERAL)
  144.         t1.Name = "Makros"
  145.         f1.Name = "Makroname"
  146.         f1.Type = DB_TEXT
  147.         f1.Size = 50
  148.             t1.Fields.Append f1
  149.         f2.Name = "Makrotext"
  150.         f2.Type = DB_MEMO
  151.             t1.Fields.Append f2
  152.         i1.Name = "Makroname"
  153.         i1.Fields = "Makroname"
  154.         i1.Primary = True
  155.         i1.Unique = True
  156.             t1.Indexes.Append i1
  157.         MainDB.TableDefs.Append t1
  158.         MainDB.Close
  159.     End If
  160.     Set MainDB = OpenDatabase(FileName$)
  161.     Set MainTable = MainDB.OpenTable("Makros")
  162. End Sub
  163.  
  164. Function GetMakroByName (Makroname$, Makrotext$)
  165.     MainTable.Index = "Makroname"
  166.     MainTable.Seek "=", Makroname$
  167.     If Not MainTable.NoMatch Then
  168.         GetMakroByName = True
  169.         Makrotext = MainTable("Makrotext")
  170.     End If
  171. End Function
  172.  
  173. Sub MakroDelete (Makroname$)
  174.     MainTable.Index = "Makroname"
  175.     MainTable.Seek "=", Makroname$
  176.     If Not MainTable.NoMatch Then MainTable.Delete
  177. End Sub
  178.  
  179. Function SetMakroByName (Makroname$, Makrotext$)
  180.     MainTable.Index = "Makroname"
  181.     MainTable.Seek "=", Makroname$
  182.     If MainTable.NoMatch Then
  183.         MainTable.AddNew
  184.     Else MainTable.Edit
  185.     End If
  186.     MainTable("Makroname") = Makroname$
  187.     MainTable("Makrotext") = Makrotext$
  188.     MainTable.Update
  189. End Function
  190.  
  191. Sub ShowAllMakros (C As ComboBox)
  192.     C.Clear
  193.     If MainTable.RecordCount > 0 Then
  194.         MainTable.MoveFirst
  195.         Do While Not MainTable.EOF
  196.             C.AddItem MainTable("Makroname")
  197.             MainTable.MoveNext
  198.         Loop
  199.     End If
  200. End Sub
  201.  
  202.