home *** CD-ROM | disk | FTP | other *** search
/ PC World 1999 December / PCWorld_1999-12_cd.bin / Software / Servis / UrthMDB / Codegen / mdbUmcgTest.ba_ / mdbUmcgTest.ba
Encoding:
Text File  |  1999-10-03  |  45.1 KB  |  1,577 lines
  1. Attribute VB_Name = "mdbUmcgTest"
  2. Option Explicit
  3.  
  4. '--------------------------------------------------------------------------------
  5. ' mdbUmcgTest.bas: Generated using Urthman's MDB Code Generator v1.00.0191
  6. ' Urthman's MDB Code Generator: Copyright⌐ 1999, John Stanley Enterprises
  7.  
  8. ' Create Date: Sunday, October 03, 1999 at 4:11:32 PM
  9. ' Created by User Urthman on Machine STAR
  10.  
  11. ' This copy of Urthman's MDB Code Generator is registered to Hugh J S Field
  12. '--------------------------------------------------------------------------------
  13.  
  14. Dim TestStrg As String
  15. Dim CrntIndx As String
  16.  
  17. Public MdbFileName as String
  18. Private Const MdbUserName As String = "admin"
  19. Private Const MdbPassWord As String = vbNullString
  20.  
  21. Public wsUmcgTest as Workspace
  22. Public dbUmcgTest as Database
  23.  
  24. Dim Opened as Boolean
  25.  
  26. '--------------------------------------------------------------------------------
  27. '   ****    Variables for Table: MultiKey
  28. '--------------------------------------------------------------------------------
  29.  
  30. Dim tbMultiKey as Recordset             ' Defines the table object MultiKey
  31. Dim MultiKeyOpen as Boolean             ' Indicates if MultiKey is open or not
  32.  
  33. Public MultiKeyERR as Boolean           ' Indicates an error reading from MultiKey
  34. Public MultiKeySiz as Long              ' The number of records in MultiKey
  35.  
  36. '   MultiKey field variables
  37.  
  38. Public MultiKey_IndexText as String * 25        ' Text Index Field25
  39. Public MultiKey_IntLong as Long         ' 32-bit signed integer
  40. Public MultiKey_IntInteger as Integer   ' 16-bit signed integer
  41. Public MultiKey_IntByte as Byte         ' 8-bit unsigned byte
  42. Public MultiKey_FptSingle as Long       ' Single Precision FPT
  43. Public MultiKey_FptDouble as Long       ' Double Precision FPT
  44. Public MultiKey_TextField as String * 50        ' Text (string) Field
  45. Public MultiKey_MemoField as String     ' Memo (string) Field
  46. Public MultiKey_Today as Date           ' Todays Date
  47. Public MultiKey_Flag1 as Boolean        ' Boolean Flag Data
  48. Public MultiKey_Flag2 as Boolean        ' Boolean Flag Data
  49. Public MultiKey_Money as Currency       ' Currency Value
  50.  
  51. '--------------------------------------------------------------------------------
  52. '   ****    Variables for Table: NoIndexes
  53. '--------------------------------------------------------------------------------
  54.  
  55. Dim tbNoIndexes as Recordset            ' Defines the table object NoIndexes
  56. Dim NoIndexesOpen as Boolean            ' Indicates if NoIndexes is open or not
  57.  
  58. Public NoIndexesERR as Boolean          ' Indicates an error reading from NoIndexes
  59. Public NoIndexesSiz as Long             ' The number of records in NoIndexes
  60.  
  61. '   NoIndexes field variables
  62.  
  63. Public NoIndexes_IntLong as Long        ' 32-bit signed integer
  64. Public NoIndexes_IntInteger as Integer  ' 16-bit signed integer
  65. Public NoIndexes_IntByte as Byte        ' 8-bit unsigned byte
  66. Public NoIndexes_FptSingle as Long      ' Single Precision FPT
  67. Public NoIndexes_FptDouble as Long      ' Double Precision FPT
  68. Public NoIndexes_TextField as String    ' Text (string) Field
  69. Public NoIndexes_MemoField as String    ' Memo (string) Field
  70. Public NoIndexes_Today as Date          ' Todays Date
  71. Public NoIndexes_Flag1 as Boolean       ' Boolean Flag Data
  72. Public NoIndexes_Flag2 as Boolean       ' Boolean Flag Data
  73. Public NoIndexes_Money as Currency      ' Currency Value
  74.  
  75. '--------------------------------------------------------------------------------
  76. '   ****    Variables for Table: PrimeKey
  77. '--------------------------------------------------------------------------------
  78.  
  79. Dim tbPrimeKey as Recordset             ' Defines the table object PrimeKey
  80. Dim PrimeKeyOpen as Boolean             ' Indicates if PrimeKey is open or not
  81.  
  82. Public PrimeKeyERR as Boolean           ' Indicates an error reading from PrimeKey
  83. Public PrimeKeySiz as Long              ' The number of records in PrimeKey
  84.  
  85. '   PrimeKey field variables
  86.  
  87. Public PrimeKey_IndexText as String * 25        ' Text Index Field25
  88. Public PrimeKey_IntLong as Long         ' 32-bit signed integer
  89. Public PrimeKey_IntInteger as Integer   ' 16-bit signed integer
  90. Public PrimeKey_IntByte as Byte         ' 8-bit unsigned byte
  91. Public PrimeKey_FptSingle as Long       ' Single Precision FPT
  92. Public PrimeKey_FptDouble as Long       ' Double Precision FPT
  93. Public PrimeKey_TextField as String     ' Text (string) Field
  94. Public PrimeKey_MemoField as String     ' Memo (string) Field
  95. Public PrimeKey_Today as Date           ' Todays Date
  96. Public PrimeKey_Flag1 as Boolean        ' Boolean Flag Data
  97. Public PrimeKey_Flag2 as Boolean        ' Boolean Flag Data
  98. Public PrimeKey_Money as Currency       ' Currency Value
  99.  
  100.  
  101. ' zzInitUmcgTest: Routine for initializing the database
  102.  
  103. Private Sub zzInitUmcgTest()
  104.  
  105.     If Opened Then Exit Sub
  106.  
  107.     Set wsUmcgTest = CreateWorkspace(vbNullString, MdbUserName, MdbPassWord, dbUseJet)
  108.     Set dbUmcgTest = wsUmcgTest.OpenDatabase(MdbFileName, False)
  109.  
  110.     Opened = True
  111.  
  112. End Sub
  113.  
  114.  
  115. ' CloseUmcgTest: This routine shuts down the database
  116. '
  117. Public Sub CloseUmcgTest()
  118.  
  119.     If Not Opened Then Exit Sub
  120.  
  121.     If MultiKeyOpen Then
  122.         tbMultiKey.Close
  123.         MultiKeyOpen = False
  124.         Set tbMultiKey = Nothing
  125.     End If
  126.  
  127.     If NoIndexesOpen Then
  128.         tbNoIndexes.Close
  129.         NoIndexesOpen = False
  130.         Set tbNoIndexes = Nothing
  131.     End If
  132.  
  133.     If PrimeKeyOpen Then
  134.         tbPrimeKey.Close
  135.         PrimeKeyOpen = False
  136.         Set tbPrimeKey = Nothing
  137.     End If
  138.  
  139.     dbUmcgTest.Close
  140.     Set dbUmcgTest = Nothing
  141.  
  142.     wsUmcgTest.Close
  143.     Set wsUmcgTest = Nothing
  144.  
  145.     Opened = False
  146.  
  147. End Sub
  148.  
  149.  
  150. ' MultiKeyClear: Will clear all field variables.
  151. '
  152. Public Sub MultiKeyClear()
  153.  
  154.     MultiKeyERR = True
  155.     Call zzMultiKeyRead
  156.     MultiKeyERR = False
  157.  
  158. End Sub
  159.  
  160.  
  161. ' MultiKeyFind: Will attempt to find a record based
  162. '    on the indexed variables of the PrimaryKey index
  163. '    and call the read routine.
  164. '
  165. Public Sub MultiKeyFind(fnd_IndexText as String)
  166.  
  167.     If Not MultiKeyOpen Then Call zzMultiKeyOpen
  168.  
  169. ' Copy the parameters into the variables associated
  170. '    with index PrimaryKey
  171.     MultiKey_IndexText = fnd_IndexText
  172.  
  173. ' Validate any string variables related to index PrimaryKey
  174.     TestStrg = Trim(MultiKey_IndexText)
  175.     If (Len(Trim(TestStrg)) = 0) Then MultiKey_IndexText = String(25, " ")
  176.  
  177.     If (MultiKeySiz > 0) Then
  178. ' If not already set, set index to PrimaryKey
  179.         If (tbMultiKey.Index <> "PrimaryKey") Then tbMultiKey.Index = "PrimaryKey"
  180.         tbMultiKey.Seek "=", MultiKey_IndexText
  181.         MultiKeyERR = tbMultiKey.NoMatch
  182.     Else
  183.         MultiKeyERR = True
  184.     End If
  185.  
  186.     Call zzMultiKeyRead
  187.  
  188.     If MultiKeyERR Then
  189.         MultiKey_IndexText = fnd_IndexText
  190.     End If
  191.  
  192. End Sub
  193.  
  194.  
  195. ' MultiKeyBySecondary: Will attempt to find a record based
  196. '    on the indexed variables of the Secondary index
  197. '    and call the read routine.
  198. '
  199. Public Sub MultiKeyBySecondary(fnd_TextField as String, fnd_IndexText as String)
  200.  
  201.     If Not MultiKeyOpen Then Call zzMultiKeyOpen
  202.  
  203. ' Copy the parameters into the variables associated
  204. '    with index Secondary
  205.     MultiKey_TextField = fnd_TextField
  206.     MultiKey_IndexText = fnd_IndexText
  207.  
  208. ' Validate any string variables related to index Secondary
  209.     TestStrg = Trim(MultiKey_TextField)
  210.     If (Len(Trim(TestStrg)) = 0) Then MultiKey_TextField = String(50, " ")
  211.  
  212.     TestStrg = Trim(MultiKey_IndexText)
  213.     If (Len(Trim(TestStrg)) = 0) Then MultiKey_IndexText = String(25, " ")
  214.  
  215.     If (MultiKeySiz > 0) Then
  216. ' If not already set, set index to Secondary
  217.         If (tbMultiKey.Index <> "Secondary") Then tbMultiKey.Index = "Secondary"
  218.         tbMultiKey.Seek "=", MultiKey_TextField, MultiKey_IndexText
  219.         MultiKeyERR = tbMultiKey.NoMatch
  220.     Else
  221.         MultiKeyERR = True
  222.     End If
  223.  
  224.     Call zzMultiKeyRead
  225.  
  226.     If MultiKeyERR Then
  227.         MultiKey_TextField = fnd_TextField
  228.         MultiKey_IndexText = fnd_IndexText
  229.     End If
  230.  
  231. End Sub
  232.  
  233.  
  234. ' MultiKeyByTiertiary: Will attempt to find a record based
  235. '    on the indexed variables of the Tiertiary index
  236. '    and call the read routine.
  237. '
  238. Public Sub MultiKeyByTiertiary(fnd_Today as Date, fnd_TextField as String, fnd_IndexText as String)
  239.  
  240.     If Not MultiKeyOpen Then Call zzMultiKeyOpen
  241.  
  242. ' Copy the parameters into the variables associated
  243. '    with index Tiertiary
  244.     MultiKey_Today = fnd_Today
  245.     MultiKey_TextField = fnd_TextField
  246.     MultiKey_IndexText = fnd_IndexText
  247.  
  248. ' Validate any string variables related to index Tiertiary
  249.     TestStrg = Trim(MultiKey_TextField)
  250.     If (Len(Trim(TestStrg)) = 0) Then MultiKey_TextField = String(50, " ")
  251.  
  252.     TestStrg = Trim(MultiKey_IndexText)
  253.     If (Len(Trim(TestStrg)) = 0) Then MultiKey_IndexText = String(25, " ")
  254.  
  255.     If (MultiKeySiz > 0) Then
  256. ' If not already set, set index to Tiertiary
  257.         If (tbMultiKey.Index <> "Tiertiary") Then tbMultiKey.Index = "Tiertiary"
  258.         tbMultiKey.Seek "=", MultiKey_Today, MultiKey_TextField, MultiKey_IndexText
  259.         MultiKeyERR = tbMultiKey.NoMatch
  260.     Else
  261.         MultiKeyERR = True
  262.     End If
  263.  
  264.     Call zzMultiKeyRead
  265.  
  266.     If MultiKeyERR Then
  267.         MultiKey_Today = fnd_Today
  268.         MultiKey_TextField = fnd_TextField
  269.         MultiKey_IndexText = fnd_IndexText
  270.     End If
  271.  
  272. End Sub
  273.  
  274.  
  275. ' MultiKeyFindNx: Will attempt to find a next record
  276. '    based on the indexed variables of the PrimaryKey
  277. '    and call the read routine.
  278. '
  279. Public Sub MultiKeyFindNX()
  280.  
  281.     If Not MultiKeyOpen Then Call zzMultiKeyOpen
  282.  
  283.     If (MultiKeySiz > 0) Then
  284.         CrntIndx = tbMultiKey.Index
  285.         Select Case CrntIndx
  286.         Case "PrimaryKey"
  287. ' Validate any string variables related to index PrimaryKey
  288.             TestStrg = Trim(MultiKey_IndexText)
  289.             If (Len(Trim(TestStrg)) = 0) Then MultiKey_IndexText = String(25, " ")
  290.  
  291.             tbMultiKey.Seek ">", MultiKey_IndexText
  292.         Case "Secondary"
  293. ' Validate any string variables related to index Secondary
  294.             TestStrg = Trim(MultiKey_TextField)
  295.             If (Len(Trim(TestStrg)) = 0) Then MultiKey_TextField = String(50, " ")
  296.  
  297.             TestStrg = Trim(MultiKey_IndexText)
  298.             If (Len(Trim(TestStrg)) = 0) Then MultiKey_IndexText = String(25, " ")
  299.  
  300.             tbMultiKey.Seek ">", MultiKey_TextField, MultiKey_IndexText
  301.         Case "Tiertiary"
  302. ' Validate any string variables related to index Tiertiary
  303.             TestStrg = Trim(MultiKey_TextField)
  304.             If (Len(Trim(TestStrg)) = 0) Then MultiKey_TextField = String(50, " ")
  305.  
  306.             TestStrg = Trim(MultiKey_IndexText)
  307.             If (Len(Trim(TestStrg)) = 0) Then MultiKey_IndexText = String(25, " ")
  308.  
  309.             tbMultiKey.Seek ">", MultiKey_Today, MultiKey_TextField, MultiKey_IndexText
  310.         End Select
  311.         MultiKeyERR = tbMultiKey.NoMatch
  312.     Else
  313.         MultiKeyERR = True
  314.     End If
  315.  
  316.     Call zzMultiKeyRead
  317.  
  318. End Sub
  319.  
  320.  
  321. ' MultiKeyFindPv: Will attempt to find a previous record
  322. '    based on the indexed variables of the PrimaryKey
  323. '    and call the read routine.
  324. '
  325. Public Sub MultiKeyFindPV()
  326.  
  327.     If Not MultiKeyOpen Then Call zzMultiKeyOpen
  328.  
  329.     If (MultiKeySiz > 0) Then
  330.         CrntIndx = tbMultiKey.Index
  331.         Select Case CrntIndx
  332.         Case "PrimaryKey"
  333. ' Validate any string variables related to index PrimaryKey
  334.             TestStrg = Trim(MultiKey_IndexText)
  335.             If (Len(Trim(TestStrg)) = 0) Then MultiKey_IndexText = String(25, " ")
  336.  
  337.             tbMultiKey.Seek "<", MultiKey_IndexText
  338.         Case "Secondary"
  339. ' Validate any string variables related to index Secondary
  340.             TestStrg = Trim(MultiKey_TextField)
  341.             If (Len(Trim(TestStrg)) = 0) Then MultiKey_TextField = String(50, " ")
  342.  
  343.             TestStrg = Trim(MultiKey_IndexText)
  344.             If (Len(Trim(TestStrg)) = 0) Then MultiKey_IndexText = String(25, " ")
  345.  
  346.             tbMultiKey.Seek "<", MultiKey_TextField, MultiKey_IndexText
  347.         Case "Tiertiary"
  348. ' Validate any string variables related to index Tiertiary
  349.             TestStrg = Trim(MultiKey_TextField)
  350.             If (Len(Trim(TestStrg)) = 0) Then MultiKey_TextField = String(50, " ")
  351.  
  352.             TestStrg = Trim(MultiKey_IndexText)
  353.             If (Len(Trim(TestStrg)) = 0) Then MultiKey_IndexText = String(25, " ")
  354.  
  355.             tbMultiKey.Seek "<", MultiKey_Today, MultiKey_TextField, MultiKey_IndexText
  356.         End Select
  357.         MultiKeyERR = tbMultiKey.NoMatch
  358.     Else
  359.         MultiKeyERR = True
  360.     End If
  361.  
  362.     Call zzMultiKeyRead
  363.  
  364. End Sub
  365.  
  366.  
  367. ' MultiKeyFirst: Will change the current record to the
  368. '    first record and call the read routine.
  369. '
  370. Public Sub MultiKeyFirst()
  371.  
  372.     If Not MultiKeyOpen Then Call zzMultiKeyOpen
  373.  
  374.     If (MultiKeySiz > 0) Then
  375.         tbMultiKey.MoveFirst
  376.         MultiKeyERR = False
  377.     Else
  378.         MultiKeyERR = True
  379.     End If
  380.  
  381.     Call zzMultiKeyRead
  382.  
  383. End Sub
  384.  
  385.  
  386. ' MultiKeyIsKey: A function that returns true if the
  387. '   current index is the Primary Key
  388. Public Function MultiKeyIsKey() As Boolean
  389.  
  390.     If Not MultiKeyOpen Then
  391.         MultiKeyIsKey = False
  392.         Exit Function
  393.     End If
  394.  
  395.     If (tbMultiKey.Index = "PrimaryKey") Then
  396.         MultiKeyIsKey = True
  397.     Else
  398.         MultiKeyIsKey = False
  399.     End If
  400.  
  401. End Function
  402.  
  403.  
  404. ' MultiKeyKill: Will attempt to find a record based
  405. '    on the indexed variables of the PrimaryKey
  406. '    and subsequently delete that record.
  407. '
  408. Public Sub MultiKeyKill(fnd_IndexText as String)
  409.  
  410.     If Not MultiKeyOpen Then Call zzMultiKeyOpen
  411.  
  412. ' Copy the parameters into the variables associated
  413. '    with index PrimaryKey
  414.     MultiKey_IndexText = fnd_IndexText
  415.  
  416. ' Validate any string variables related to index PrimaryKey
  417.     TestStrg = Trim(MultiKey_IndexText)
  418.     If (Len(Trim(TestStrg)) = 0) Then MultiKey_IndexText = String(25, " ")
  419.  
  420.     If (MultiKeySiz > 0) Then
  421. ' Hang on the the current index and set index to PrimaryKey
  422.         CrntIndx = tbMultiKey.Index
  423.         If (tbMultiKey.Index <> "PrimaryKey") Then tbMultiKey.Index = "PrimaryKey"
  424.         tbMultiKey.Seek "=", MultiKey_IndexText
  425.         If Not tbMultiKey.NoMatch Then tbMultiKey.Delete
  426.  
  427.         MultiKeySiz = tbMultiKey.RecordCount
  428.         If (MultiKeySiz > 0) Then
  429.  
  430. ' Restore the original index saved in CrntIndx
  431.             If (tbMultiKey.Index <> CrntIndx) Then tbMultiKey.Index = CrntIndx
  432.  
  433.             Select Case CrntIndx
  434.             Case "PrimaryKey"
  435.                 tbMultiKey.Seek ">=", MultiKey_IndexText
  436.                 If tbMultiKey.NoMatch Then tbMultiKey.Seek "<=", MultiKey_IndexText
  437.             Case "Secondary"
  438.                 tbMultiKey.Seek ">=", MultiKey_TextField, MultiKey_IndexText
  439.                 If tbMultiKey.NoMatch Then tbMultiKey.Seek "<=", MultiKey_TextField, MultiKey_IndexText
  440.             Case "Tiertiary"
  441.                 tbMultiKey.Seek ">=", MultiKey_Today, MultiKey_TextField, MultiKey_IndexText
  442.                 If tbMultiKey.NoMatch Then tbMultiKey.Seek "<=", MultiKey_Today, MultiKey_TextField, MultiKey_IndexText
  443.             End Select
  444.             MultiKeyERR = False
  445.         Else
  446.             MultiKeyERR = True
  447.         End If
  448.     End If
  449.  
  450.     Call zzMultiKeyRead
  451.  
  452. End Sub
  453.  
  454.  
  455. ' MultiKeyLast: Will change the current record to the
  456. '    last record and call the read routine.
  457. '
  458. Public Sub MultiKeyLast()
  459.  
  460.     If Not MultiKeyOpen Then Call zzMultiKeyOpen
  461.  
  462.     If (MultiKeySiz > 0) Then
  463.         tbMultiKey.MoveLast
  464.         MultiKeyERR = False
  465.     Else
  466.         MultiKeyERR = True
  467.     End If
  468.  
  469.     Call zzMultiKeyRead
  470.  
  471. End Sub
  472.  
  473.  
  474. ' MultiKeyNext: Will change the current record to the
  475. '    next record and call the read routine.
  476. '
  477. Public Sub MultiKeyNext()
  478.  
  479.     If Not MultiKeyOpen Then Call zzMultiKeyOpen
  480.  
  481.     If (MultiKeySiz > 0) Then
  482.         tbMultiKey.MoveNext
  483.         If tbMultiKey.EOF Then
  484.             MultiKeyERR = True
  485.         Else
  486.             MultiKeyERR = False
  487.         End If
  488.     Else
  489.         MultiKeyERR = True
  490.     End If
  491.  
  492.     Call zzMultiKeyRead
  493.  
  494. End Sub
  495.  
  496.  
  497. ' MultiKeyPrevious: Will change the current record to the
  498. '    previous record and call the read routine.
  499. '
  500. Public Sub MultiKeyPrevious()
  501.  
  502.     If Not MultiKeyOpen Then Call zzMultiKeyOpen
  503.  
  504.     If (MultiKeySiz > 0) Then
  505.         tbMultiKey.MovePrevious
  506.         If tbMultiKey.BOF Then
  507.             MultiKeyERR = True
  508.         Else
  509.             MultiKeyERR = False
  510.         End If
  511.     Else
  512.         MultiKeyERR = True
  513.     End If
  514.  
  515.     Call zzMultiKeyRead
  516.  
  517. End Sub
  518.  
  519.  
  520. ' MultiKeySave: Designed to either save data as a
  521. '    new record, or update an existing record. If there
  522. '    is no PrimaryKey, the record will simply be added.
  523. '
  524. Public Sub MultiKeySave()
  525.  
  526.     If Not MultiKeyOpen Then Call zzMultiKeyOpen
  527.  
  528. ' Validate any string variables related to index PrimaryKey
  529.     TestStrg = Trim(MultiKey_IndexText)
  530.     If (Len(Trim(TestStrg)) = 0) Then MultiKey_IndexText = String(25, " ")
  531.  
  532.     If (MultiKeySiz > 0) Then
  533. ' Hang on the the current index and set index to PrimaryKey
  534.         CrntIndx = tbMultiKey.Index
  535.         If (tbMultiKey.Index <> "PrimaryKey") Then tbMultiKey.Index = "PrimaryKey"
  536.         tbMultiKey.Seek "=", MultiKey_IndexText
  537.         If tbMultiKey.NoMatch Then
  538.             GoSub AddMultiKey
  539.         Else
  540.             GoSub WriteMultiKey
  541.         End If
  542.  
  543. ' Restore the original index saved in CrntIndx
  544.         If (tbMultiKey.Index <> CrntIndx) Then tbMultiKey.Index = CrntIndx
  545.  
  546.         Select Case CrntIndx
  547.         Case "PrimaryKey"
  548.             tbMultiKey.Seek ">=", MultiKey_IndexText
  549.             If tbMultiKey.NoMatch Then tbMultiKey.Seek "<=", MultiKey_IndexText
  550.         Case "Secondary"
  551.             tbMultiKey.Seek ">=", MultiKey_TextField, MultiKey_IndexText
  552.             If tbMultiKey.NoMatch Then tbMultiKey.Seek "<=", MultiKey_TextField, MultiKey_IndexText
  553.         Case "Tiertiary"
  554.             tbMultiKey.Seek ">=", MultiKey_Today, MultiKey_TextField, MultiKey_IndexText
  555.             If tbMultiKey.NoMatch Then tbMultiKey.Seek "<=", MultiKey_Today, MultiKey_TextField, MultiKey_IndexText
  556.         End Select
  557.         MultiKeyERR = False
  558.     Else
  559.         GoSub AddMultiKey
  560. ' If not already set, set index to PrimaryKey
  561.         If (tbMultiKey.Index <> "PrimaryKey") Then tbMultiKey.Index = "PrimaryKey"
  562.     End If
  563.  
  564.     Exit Sub
  565.  
  566. '--------------------------------------------------------------------------------
  567. ' Subroutine to ADD a record to MultiKey
  568. '--------------------------------------------------------------------------------
  569. AddMultiKey:
  570.  
  571.     tbMultiKey.AddNew
  572.  
  573. ' Write variable "MultiKey_IndexText" into field "IndexText"
  574.     If (Trim(MultiKey_IndexText) = vbNullString) Then
  575.         tbMultiKey.Fields("IndexText") = String(25, " ")
  576.     ElseIf (Len(Trim(MultiKey_IndexText)) > 25) Then
  577.         tbMultiKey.Fields("IndexText") = Left(Trim(MultiKey_IndexText), 25)
  578.     Else
  579.         tbMultiKey.Fields("IndexText") = Trim(MultiKey_IndexText)
  580.     End If
  581.  
  582.     GoSub WriteTheRecord
  583.     tbMultiKey.Update
  584.     MultiKeySiz = (MultiKeySiz + 1)
  585.  
  586.     Return
  587.  
  588. '--------------------------------------------------------------------------------
  589. ' Subroutine to update the MultiKey record
  590. '--------------------------------------------------------------------------------
  591. WriteMultiKey:
  592.  
  593.     tbMultiKey.Edit
  594.     GoSub WriteTheRecord
  595.     tbMultiKey.Update
  596.  
  597.     Return
  598.  
  599. '--------------------------------------------------------------------------------
  600. ' The Subroutine for Transferring MultiKey variable
  601. '   data to the MultiKey record fields
  602. '--------------------------------------------------------------------------------
  603. WriteTheRecord:
  604.  
  605. ' Write variable "MultiKey_IntLong" into field "IntLong"
  606.     tbMultiKey.Fields("IntLong") = MultiKey_IntLong
  607.  
  608. ' Write variable "MultiKey_IntInteger" into field "IntInteger"
  609.     tbMultiKey.Fields("IntInteger") = MultiKey_IntInteger
  610.  
  611. ' Write variable "MultiKey_IntByte" into field "IntByte"
  612.     tbMultiKey.Fields("IntByte") = MultiKey_IntByte
  613.  
  614. ' Write variable "MultiKey_FptSingle" into field "FptSingle"
  615.     tbMultiKey.Fields("FptSingle") = MultiKey_FptSingle
  616.  
  617. ' Write variable "MultiKey_FptDouble" into field "FptDouble"
  618.     tbMultiKey.Fields("FptDouble") = MultiKey_FptDouble
  619.  
  620. ' Write variable "MultiKey_TextField" into field "TextField"
  621.     If (Trim(MultiKey_TextField) = vbNullString) Then
  622.         tbMultiKey.Fields("TextField") = String(50, " ")
  623.     ElseIf (Len(Trim(MultiKey_TextField)) > 50) Then
  624.         tbMultiKey.Fields("TextField") = Left(Trim(MultiKey_TextField), 50)
  625.     Else
  626.         tbMultiKey.Fields("TextField") = Trim(MultiKey_TextField)
  627.     End If
  628.  
  629. ' Write variable "MultiKey_MemoField" into field "MemoField"
  630.     tbMultiKey.Fields("MemoField") = Trim(MultiKey_MemoField)
  631.  
  632. ' Write variable "MultiKey_Today" into field "Today"
  633.     tbMultiKey.Fields("Today") = MultiKey_Today
  634.  
  635. ' Write variable "MultiKey_Flag1" into field "Flag1"
  636.     tbMultiKey.Fields("Flag1") = MultiKey_Flag1
  637.  
  638. ' Write variable "MultiKey_Flag2" into field "Flag2"
  639.     tbMultiKey.Fields("Flag2") = MultiKey_Flag2
  640.  
  641. ' Write variable "MultiKey_Money" into field "Money"
  642.     tbMultiKey.Fields("Money") = MultiKey_Money
  643.  
  644.     Return
  645.  
  646. End Sub
  647.  
  648.  
  649. ' MultiKeyPurge: The purpose of this
  650. '    routine is to provide a means to delete
  651. '    all records from a given file
  652. '
  653. Public Sub MultiKeyPurge()
  654.  
  655.     If Not MultiKeyOpen Then Call zzMultiKeyOpen
  656.  
  657.     If (MultiKeySiz > 0) Then
  658.         Do Until (tbMultiKey.RecordCount = 0)
  659.             tbMultiKey.MoveLast
  660.             tbMultiKey.Delete
  661.         Loop
  662.         MultiKeySiz = tbMultiKey.RecordCount
  663.     End If
  664.  
  665. End Sub
  666.  
  667.  
  668. ' zzMultiKeyOpen(): Will open the recordset/table and
  669. '    if necessary will initialize the database
  670. '
  671. Private Sub zzMultiKeyOpen()
  672.  
  673.     If MultiKeyOpen Then Exit Sub
  674.     If Not Opened Then Call zzInitUmcgTest
  675.  
  676.     Set tbMultiKey = dbUmcgTest.OpenRecordset("MultiKey", dbOpenTable, dbSeeChanges, dbOptimistic)
  677.  
  678.     MultiKeySiz = tbMultiKey.RecordCount
  679.     If (MultiKeySiz >0) Then
  680. ' If not already set, set index to PrimaryKey
  681.         If (tbMultiKey.Index <> "PrimaryKey") Then tbMultiKey.Index = "PrimaryKey"
  682.         MultiKeyERR = False
  683.     Else
  684.         MultiKeyERR = True
  685.     End If
  686.  
  687.     MultiKeyOpen = True
  688.  
  689. End Sub
  690.  
  691.  
  692. ' zzMultiKeyRead(): Following a successful read, this routine
  693. '    will populate the proper variables, or will neutralize
  694. '    the variables if the read failed.
  695. '
  696. Private Sub zzMultiKeyRead()
  697.  
  698.     If MultiKeyERR Then
  699.         MultiKey_IndexText = vbNullString
  700.         MultiKey_IntLong =  0
  701.         MultiKey_IntInteger =  0
  702.         MultiKey_IntByte =  0
  703.         MultiKey_FptSingle =  0
  704.         MultiKey_FptDouble =  0
  705.         MultiKey_TextField = vbNullString
  706.         MultiKey_MemoField = vbNullString
  707.         MultiKey_Today = TimeValue("12:00:00")
  708.         MultiKey_Flag1 = False
  709.         MultiKey_Flag2 = False
  710.         MultiKey_Money =  0
  711.     Else
  712.  
  713. ' Read field IndexText
  714.         If IsNull(tbMultiKey.Fields("IndexText")) Then
  715.             MultiKey_IndexText = vbNullString
  716.         Else
  717.             MultiKey_IndexText = tbMultiKey.Fields("IndexText")
  718.         End If
  719.  
  720. ' Read field IntLong
  721.         If IsNull(tbMultiKey.Fields("IntLong")) Then
  722.             MultiKey_IntLong = 0
  723.         Else
  724.             MultiKey_IntLong = tbMultiKey.Fields("IntLong")
  725.         End If
  726.  
  727. ' Read field IntInteger
  728.         If IsNull(tbMultiKey.Fields("IntInteger")) Then
  729.             MultiKey_IntInteger = 0
  730.         Else
  731.             MultiKey_IntInteger = tbMultiKey.Fields("IntInteger")
  732.         End If
  733.  
  734. ' Read field IntByte
  735.         If IsNull(tbMultiKey.Fields("IntByte")) Then
  736.             MultiKey_IntByte = 0
  737.         Else
  738.             MultiKey_IntByte = tbMultiKey.Fields("IntByte")
  739.         End If
  740.  
  741. ' Read field FptSingle
  742.         If IsNull(tbMultiKey.Fields("FptSingle")) Then
  743.             MultiKey_FptSingle = 0
  744.         Else
  745.             MultiKey_FptSingle = tbMultiKey.Fields("FptSingle")
  746.         End If
  747.  
  748. ' Read field FptDouble
  749.         If IsNull(tbMultiKey.Fields("FptDouble")) Then
  750.             MultiKey_FptDouble = 0
  751.         Else
  752.             MultiKey_FptDouble = tbMultiKey.Fields("FptDouble")
  753.         End If
  754.  
  755. ' Read field TextField
  756.         If IsNull(tbMultiKey.Fields("TextField")) Then
  757.             MultiKey_TextField = vbNullString
  758.         Else
  759.             MultiKey_TextField = tbMultiKey.Fields("TextField")
  760.         End If
  761.  
  762. ' Read field MemoField
  763.         If IsNull(tbMultiKey.Fields("MemoField")) Then
  764.             MultiKey_MemoField = vbNullString
  765.         Else
  766.             MultiKey_MemoField = tbMultiKey.Fields("MemoField")
  767.         End If
  768.  
  769. ' Read field Today
  770.         If IsNull(tbMultiKey.Fields("Today")) Then
  771.             MultiKey_Today = TimeValue("12:00:00")
  772.         Else
  773.             MultiKey_Today = tbMultiKey.Fields("Today")
  774.         End If
  775.  
  776. ' Read field Flag1
  777.         If IsNull(tbMultiKey.Fields("Flag1")) Then
  778.             MultiKey_Flag1 = 0
  779.         Else
  780.             MultiKey_Flag1 = tbMultiKey.Fields("Flag1")
  781.         End If
  782.  
  783. ' Read field Flag2
  784.         If IsNull(tbMultiKey.Fields("Flag2")) Then
  785.             MultiKey_Flag2 = 0
  786.         Else
  787.             MultiKey_Flag2 = tbMultiKey.Fields("Flag2")
  788.         End If
  789.  
  790. ' Read field Money
  791.         If IsNull(tbMultiKey.Fields("Money")) Then
  792.             MultiKey_Money = 0
  793.         Else
  794.             MultiKey_Money = tbMultiKey.Fields("Money")
  795.         End If
  796.     End If
  797.  
  798. End Sub
  799.  
  800.  
  801. ' NoIndexesClear: Will clear all field variables.
  802. '
  803. Public Sub NoIndexesClear()
  804.  
  805.     NoIndexesERR = True
  806.     Call zzNoIndexesRead
  807.     NoIndexesERR = False
  808.  
  809. End Sub
  810.  
  811.  
  812. ' NoIndexesFirst: Will change the current record to the
  813. '    first record and call the read routine.
  814. '
  815. Public Sub NoIndexesFirst()
  816.  
  817.     If Not NoIndexesOpen Then Call zzNoIndexesOpen
  818.  
  819.     If (NoIndexesSiz > 0) Then
  820.         tbNoIndexes.MoveFirst
  821.         NoIndexesERR = False
  822.     Else
  823.         NoIndexesERR = True
  824.     End If
  825.  
  826.     Call zzNoIndexesRead
  827.  
  828. End Sub
  829.  
  830.  
  831. ' NoIndexesKill: Will attempt to find a record based
  832. '    on the indexed variables of the PrimaryKey
  833. '    and subsequently delete that record.
  834. '
  835. Public Sub NoIndexesKill()
  836.  
  837.     If Not NoIndexesOpen Then Call zzNoIndexesOpen
  838.  
  839.     tbNoIndexes.Delete
  840.     tbNoIndexes.MoveNext
  841.     If tbNoIndexes.EOF Then
  842.         tbNoIndexes.MovePrevious
  843.         NoIndexesERR = tbNoIndexes.BOF
  844.     Else
  845.         NoIndexesERR = False
  846.     End If
  847.  
  848.     NoIndexesSiz = tbNoIndexes.RecordCount
  849.  
  850.     Call zzNoIndexesRead
  851.  
  852. End Sub
  853.  
  854.  
  855. ' NoIndexesLast: Will change the current record to the
  856. '    last record and call the read routine.
  857. '
  858. Public Sub NoIndexesLast()
  859.  
  860.     If Not NoIndexesOpen Then Call zzNoIndexesOpen
  861.  
  862.     If (NoIndexesSiz > 0) Then
  863.         tbNoIndexes.MoveLast
  864.         NoIndexesERR = False
  865.     Else
  866.         NoIndexesERR = True
  867.     End If
  868.  
  869.     Call zzNoIndexesRead
  870.  
  871. End Sub
  872.  
  873.  
  874. ' NoIndexesNext: Will change the current record to the
  875. '    next record and call the read routine.
  876. '
  877. Public Sub NoIndexesNext()
  878.  
  879.     If Not NoIndexesOpen Then Call zzNoIndexesOpen
  880.  
  881.     If (NoIndexesSiz > 0) Then
  882.         tbNoIndexes.MoveNext
  883.         If tbNoIndexes.EOF Then
  884.             NoIndexesERR = True
  885.         Else
  886.             NoIndexesERR = False
  887.         End If
  888.     Else
  889.         NoIndexesERR = True
  890.     End If
  891.  
  892.     Call zzNoIndexesRead
  893.  
  894. End Sub
  895.  
  896.  
  897. ' NoIndexesPrevious: Will change the current record to the
  898. '    previous record and call the read routine.
  899. '
  900. Public Sub NoIndexesPrevious()
  901.  
  902.     If Not NoIndexesOpen Then Call zzNoIndexesOpen
  903.  
  904.     If (NoIndexesSiz > 0) Then
  905.         tbNoIndexes.MovePrevious
  906.         If tbNoIndexes.BOF Then
  907.             NoIndexesERR = True
  908.         Else
  909.             NoIndexesERR = False
  910.         End If
  911.     Else
  912.         NoIndexesERR = True
  913.     End If
  914.  
  915.     Call zzNoIndexesRead
  916.  
  917. End Sub
  918.  
  919.  
  920. ' NoIndexesSave: Designed to either save data as a
  921. '    new record, or update an existing record. If there
  922. '    is no PrimaryKey, the record will simply be added.
  923. '
  924. Public Sub NoIndexesSave()
  925.  
  926.     If Not NoIndexesOpen Then Call zzNoIndexesOpen
  927.  
  928. AddNoIndexes:
  929.     tbNoIndexes.AddNew
  930.  
  931. ' Write variable "NoIndexes_IntLong" into field "IntLong"
  932.     tbNoIndexes.Fields("IntLong") = NoIndexes_IntLong
  933.  
  934. ' Write variable "NoIndexes_IntInteger" into field "IntInteger"
  935.     tbNoIndexes.Fields("IntInteger") = NoIndexes_IntInteger
  936.  
  937. ' Write variable "NoIndexes_IntByte" into field "IntByte"
  938.     tbNoIndexes.Fields("IntByte") = NoIndexes_IntByte
  939.  
  940. ' Write variable "NoIndexes_FptSingle" into field "FptSingle"
  941.     tbNoIndexes.Fields("FptSingle") = NoIndexes_FptSingle
  942.  
  943. ' Write variable "NoIndexes_FptDouble" into field "FptDouble"
  944.     tbNoIndexes.Fields("FptDouble") = NoIndexes_FptDouble
  945.  
  946. ' Write variable "NoIndexes_TextField" into field "TextField"
  947.     If (Len(Trim(NoIndexes_TextField)) > 50) Then
  948.         tbNoIndexes.Fields("TextField") = Left(Trim(NoIndexes_TextField), 50)
  949.     Else
  950.         tbNoIndexes.Fields("TextField") = Trim(NoIndexes_TextField)
  951.     End If
  952.  
  953. ' Write variable "NoIndexes_MemoField" into field "MemoField"
  954.     tbNoIndexes.Fields("MemoField") = Trim(NoIndexes_MemoField)
  955.  
  956. ' Write variable "NoIndexes_Today" into field "Today"
  957.     tbNoIndexes.Fields("Today") = NoIndexes_Today
  958.  
  959. ' Write variable "NoIndexes_Flag1" into field "Flag1"
  960.     tbNoIndexes.Fields("Flag1") = NoIndexes_Flag1
  961.  
  962. ' Write variable "NoIndexes_Flag2" into field "Flag2"
  963.     tbNoIndexes.Fields("Flag2") = NoIndexes_Flag2
  964.  
  965. ' Write variable "NoIndexes_Money" into field "Money"
  966.     tbNoIndexes.Fields("Money") = NoIndexes_Money
  967.  
  968.  
  969.     tbNoIndexes.Update
  970.  
  971. End Sub
  972.  
  973.  
  974. ' NoIndexesPurge: The purpose of this
  975. '    routine is to provide a means to delete
  976. '    all records from a given file
  977. '
  978. Public Sub NoIndexesPurge()
  979.  
  980.     If Not NoIndexesOpen Then Call zzNoIndexesOpen
  981.  
  982.     If (NoIndexesSiz > 0) Then
  983.         Do Until (tbNoIndexes.RecordCount = 0)
  984.             tbNoIndexes.MoveLast
  985.             tbNoIndexes.Delete
  986.         Loop
  987.         NoIndexesSiz = tbNoIndexes.RecordCount
  988.     End If
  989.  
  990. End Sub
  991.  
  992.  
  993. ' zzNoIndexesOpen(): Will open the recordset/table and
  994. '    if necessary will initialize the database
  995. '
  996. Private Sub zzNoIndexesOpen()
  997.  
  998.     If NoIndexesOpen Then Exit Sub
  999.     If Not Opened Then Call zzInitUmcgTest
  1000.  
  1001.     Set tbNoIndexes = dbUmcgTest.OpenRecordset("NoIndexes", dbOpenTable, dbSeeChanges, dbOptimistic)
  1002.  
  1003.     NoIndexesSiz = tbNoIndexes.RecordCount
  1004.     If (NoIndexesSiz >0) Then
  1005.         NoIndexesERR = False
  1006.     Else
  1007.         NoIndexesERR = True
  1008.     End If
  1009.  
  1010.     NoIndexesOpen = True
  1011.  
  1012. End Sub
  1013.  
  1014.  
  1015. ' zzNoIndexesRead(): Following a successful read, this routine
  1016. '    will populate the proper variables, or will neutralize
  1017. '    the variables if the read failed.
  1018. '
  1019. Private Sub zzNoIndexesRead()
  1020.  
  1021.     If NoIndexesERR Then
  1022.         NoIndexes_IntLong =  0
  1023.         NoIndexes_IntInteger =  0
  1024.         NoIndexes_IntByte =  0
  1025.         NoIndexes_FptSingle =  0
  1026.         NoIndexes_FptDouble =  0
  1027.         NoIndexes_TextField = vbNullString
  1028.         NoIndexes_MemoField = vbNullString
  1029.         NoIndexes_Today = TimeValue("12:00:00")
  1030.         NoIndexes_Flag1 = False
  1031.         NoIndexes_Flag2 = False
  1032.         NoIndexes_Money =  0
  1033.     Else
  1034.  
  1035. ' Read field IntLong
  1036.         If IsNull(tbNoIndexes.Fields("IntLong")) Then
  1037.             NoIndexes_IntLong = 0
  1038.         Else
  1039.             NoIndexes_IntLong = tbNoIndexes.Fields("IntLong")
  1040.         End If
  1041.  
  1042. ' Read field IntInteger
  1043.         If IsNull(tbNoIndexes.Fields("IntInteger")) Then
  1044.             NoIndexes_IntInteger = 0
  1045.         Else
  1046.             NoIndexes_IntInteger = tbNoIndexes.Fields("IntInteger")
  1047.         End If
  1048.  
  1049. ' Read field IntByte
  1050.         If IsNull(tbNoIndexes.Fields("IntByte")) Then
  1051.             NoIndexes_IntByte = 0
  1052.         Else
  1053.             NoIndexes_IntByte = tbNoIndexes.Fields("IntByte")
  1054.         End If
  1055.  
  1056. ' Read field FptSingle
  1057.         If IsNull(tbNoIndexes.Fields("FptSingle")) Then
  1058.             NoIndexes_FptSingle = 0
  1059.         Else
  1060.             NoIndexes_FptSingle = tbNoIndexes.Fields("FptSingle")
  1061.         End If
  1062.  
  1063. ' Read field FptDouble
  1064.         If IsNull(tbNoIndexes.Fields("FptDouble")) Then
  1065.             NoIndexes_FptDouble = 0
  1066.         Else
  1067.             NoIndexes_FptDouble = tbNoIndexes.Fields("FptDouble")
  1068.         End If
  1069.  
  1070. ' Read field TextField
  1071.         If IsNull(tbNoIndexes.Fields("TextField")) Then
  1072.             NoIndexes_TextField = vbNullString
  1073.         Else
  1074.             NoIndexes_TextField = tbNoIndexes.Fields("TextField")
  1075.         End If
  1076.  
  1077. ' Read field MemoField
  1078.         If IsNull(tbNoIndexes.Fields("MemoField")) Then
  1079.             NoIndexes_MemoField = vbNullString
  1080.         Else
  1081.             NoIndexes_MemoField = tbNoIndexes.Fields("MemoField")
  1082.         End If
  1083.  
  1084. ' Read field Today
  1085.         If IsNull(tbNoIndexes.Fields("Today")) Then
  1086.             NoIndexes_Today = TimeValue("12:00:00")
  1087.         Else
  1088.             NoIndexes_Today = tbNoIndexes.Fields("Today")
  1089.         End If
  1090.  
  1091. ' Read field Flag1
  1092.         If IsNull(tbNoIndexes.Fields("Flag1")) Then
  1093.             NoIndexes_Flag1 = 0
  1094.         Else
  1095.             NoIndexes_Flag1 = tbNoIndexes.Fields("Flag1")
  1096.         End If
  1097.  
  1098. ' Read field Flag2
  1099.         If IsNull(tbNoIndexes.Fields("Flag2")) Then
  1100.             NoIndexes_Flag2 = 0
  1101.         Else
  1102.             NoIndexes_Flag2 = tbNoIndexes.Fields("Flag2")
  1103.         End If
  1104.  
  1105. ' Read field Money
  1106.         If IsNull(tbNoIndexes.Fields("Money")) Then
  1107.             NoIndexes_Money = 0
  1108.         Else
  1109.             NoIndexes_Money = tbNoIndexes.Fields("Money")
  1110.         End If
  1111.     End If
  1112.  
  1113. End Sub
  1114.  
  1115.  
  1116. ' PrimeKeyClear: Will clear all field variables.
  1117. '
  1118. Public Sub PrimeKeyClear()
  1119.  
  1120.     PrimeKeyERR = True
  1121.     Call zzPrimeKeyRead
  1122.     PrimeKeyERR = False
  1123.  
  1124. End Sub
  1125.  
  1126.  
  1127. ' PrimeKeyFind: Will attempt to find a record based
  1128. '    on the indexed variables of the PrimaryKey index
  1129. '    and call the read routine.
  1130. '
  1131. Public Sub PrimeKeyFind(fnd_IndexText as String)
  1132.  
  1133.     If Not PrimeKeyOpen Then Call zzPrimeKeyOpen
  1134.  
  1135. ' Copy the parameters into the variables associated
  1136. '    with index PrimaryKey
  1137.     PrimeKey_IndexText = fnd_IndexText
  1138.  
  1139. ' Validate any string variables related to index PrimaryKey
  1140.     TestStrg = Trim(PrimeKey_IndexText)
  1141.     If (Len(Trim(TestStrg)) = 0) Then PrimeKey_IndexText = String(25, " ")
  1142.  
  1143.     If (PrimeKeySiz > 0) Then
  1144.         tbPrimeKey.Seek "=", PrimeKey_IndexText
  1145.         PrimeKeyERR = tbPrimeKey.NoMatch
  1146.     Else
  1147.         PrimeKeyERR = True
  1148.     End If
  1149.  
  1150.     Call zzPrimeKeyRead
  1151.  
  1152.     If PrimeKeyERR Then
  1153.         PrimeKey_IndexText = fnd_IndexText
  1154.     End If
  1155.  
  1156. End Sub
  1157.  
  1158.  
  1159. ' PrimeKeyFindNx: Will attempt to find a next record
  1160. '    based on the indexed variables of the PrimaryKey
  1161. '    and call the read routine.
  1162. '
  1163. Public Sub PrimeKeyFindNX()
  1164.  
  1165.     If Not PrimeKeyOpen Then Call zzPrimeKeyOpen
  1166.  
  1167.     If (PrimeKeySiz > 0) Then
  1168.         tbPrimeKey.Seek ">", PrimeKey_IndexText
  1169.         PrimeKeyERR = tbPrimeKey.NoMatch
  1170.     Else
  1171.         PrimeKeyERR = True
  1172.     End If
  1173.  
  1174.     Call zzPrimeKeyRead
  1175.  
  1176. End Sub
  1177.  
  1178.  
  1179. ' PrimeKeyFindPv: Will attempt to find a previous record
  1180. '    based on the indexed variables of the PrimaryKey
  1181. '    and call the read routine.
  1182. '
  1183. Public Sub PrimeKeyFindPV()
  1184.  
  1185.     If Not PrimeKeyOpen Then Call zzPrimeKeyOpen
  1186.  
  1187.     If (PrimeKeySiz > 0) Then
  1188.         tbPrimeKey.Seek "<", PrimeKey_IndexText
  1189.         PrimeKeyERR = tbPrimeKey.NoMatch
  1190.     Else
  1191.         PrimeKeyERR = True
  1192.     End If
  1193.  
  1194.     Call zzPrimeKeyRead
  1195.  
  1196. End Sub
  1197.  
  1198.  
  1199. ' PrimeKeyFirst: Will change the current record to the
  1200. '    first record and call the read routine.
  1201. '
  1202. Public Sub PrimeKeyFirst()
  1203.  
  1204.     If Not PrimeKeyOpen Then Call zzPrimeKeyOpen
  1205.  
  1206.     If (PrimeKeySiz > 0) Then
  1207.         tbPrimeKey.MoveFirst
  1208.         PrimeKeyERR = False
  1209.     Else
  1210.         PrimeKeyERR = True
  1211.     End If
  1212.  
  1213.     Call zzPrimeKeyRead
  1214.  
  1215. End Sub
  1216.  
  1217.  
  1218. ' PrimeKeyKill: Will attempt to find a record based
  1219. '    on the indexed variables of the PrimaryKey
  1220. '    and subsequently delete that record.
  1221. '
  1222. Public Sub PrimeKeyKill(fnd_IndexText as String)
  1223.  
  1224.     If Not PrimeKeyOpen Then Call zzPrimeKeyOpen
  1225.  
  1226. ' Copy the parameters into the variables associated
  1227. '    with index PrimaryKey
  1228.     PrimeKey_IndexText = fnd_IndexText
  1229.  
  1230. ' Validate any string variables related to index PrimaryKey
  1231.     TestStrg = Trim(PrimeKey_IndexText)
  1232.     If (Len(Trim(TestStrg)) = 0) Then PrimeKey_IndexText = String(25, " ")
  1233.  
  1234.     If (PrimeKeySiz > 0) Then
  1235.         tbPrimeKey.Seek "=", PrimeKey_IndexText
  1236.         If Not tbPrimeKey.NoMatch Then tbPrimeKey.Delete
  1237.  
  1238.         PrimeKeySiz = tbPrimeKey.RecordCount
  1239.         If (PrimeKeySiz > 0) Then
  1240.  
  1241.             tbPrimeKey.Seek ">=", PrimeKey_IndexText
  1242.             If tbPrimeKey.NoMatch Then tbPrimeKey.Seek "<=", PrimeKey_IndexText
  1243.             PrimeKeyERR = False
  1244.         Else
  1245.             PrimeKeyERR = True
  1246.         End If
  1247.     End If
  1248.  
  1249.     Call zzPrimeKeyRead
  1250.  
  1251. End Sub
  1252.  
  1253.  
  1254. ' PrimeKeyLast: Will change the current record to the
  1255. '    last record and call the read routine.
  1256. '
  1257. Public Sub PrimeKeyLast()
  1258.  
  1259.     If Not PrimeKeyOpen Then Call zzPrimeKeyOpen
  1260.  
  1261.     If (PrimeKeySiz > 0) Then
  1262.         tbPrimeKey.MoveLast
  1263.         PrimeKeyERR = False
  1264.     Else
  1265.         PrimeKeyERR = True
  1266.     End If
  1267.  
  1268.     Call zzPrimeKeyRead
  1269.  
  1270. End Sub
  1271.  
  1272.  
  1273. ' PrimeKeyNext: Will change the current record to the
  1274. '    next record and call the read routine.
  1275. '
  1276. Public Sub PrimeKeyNext()
  1277.  
  1278.     If Not PrimeKeyOpen Then Call zzPrimeKeyOpen
  1279.  
  1280.     If (PrimeKeySiz > 0) Then
  1281.         tbPrimeKey.MoveNext
  1282.         If tbPrimeKey.EOF Then
  1283.             PrimeKeyERR = True
  1284.         Else
  1285.             PrimeKeyERR = False
  1286.         End If
  1287.     Else
  1288.         PrimeKeyERR = True
  1289.     End If
  1290.  
  1291.     Call zzPrimeKeyRead
  1292.  
  1293. End Sub
  1294.  
  1295.  
  1296. ' PrimeKeyPrevious: Will change the current record to the
  1297. '    previous record and call the read routine.
  1298. '
  1299. Public Sub PrimeKeyPrevious()
  1300.  
  1301.     If Not PrimeKeyOpen Then Call zzPrimeKeyOpen
  1302.  
  1303.     If (PrimeKeySiz > 0) Then
  1304.         tbPrimeKey.MovePrevious
  1305.         If tbPrimeKey.BOF Then
  1306.             PrimeKeyERR = True
  1307.         Else
  1308.             PrimeKeyERR = False
  1309.         End If
  1310.     Else
  1311.         PrimeKeyERR = True
  1312.     End If
  1313.  
  1314.     Call zzPrimeKeyRead
  1315.  
  1316. End Sub
  1317.  
  1318.  
  1319. ' PrimeKeySave: Designed to either save data as a
  1320. '    new record, or update an existing record. If there
  1321. '    is no PrimaryKey, the record will simply be added.
  1322. '
  1323. Public Sub PrimeKeySave()
  1324.  
  1325.     If Not PrimeKeyOpen Then Call zzPrimeKeyOpen
  1326.  
  1327. ' Validate any string variables related to index PrimaryKey
  1328.     TestStrg = Trim(PrimeKey_IndexText)
  1329.     If (Len(Trim(TestStrg)) = 0) Then PrimeKey_IndexText = String(25, " ")
  1330.  
  1331.     If (PrimeKeySiz > 0) Then
  1332.         tbPrimeKey.Seek "=", PrimeKey_IndexText
  1333.         If tbPrimeKey.NoMatch Then
  1334.             GoSub AddPrimeKey
  1335.         Else
  1336.             GoSub WritePrimeKey
  1337.         End If
  1338.     Else
  1339.         GoSub AddPrimeKey
  1340.         tbPrimeKey.Index = "PrimaryKey"
  1341.     End If
  1342.  
  1343.     Exit Sub
  1344.  
  1345. '--------------------------------------------------------------------------------
  1346. ' Subroutine to ADD a record to PrimeKey
  1347. '--------------------------------------------------------------------------------
  1348. AddPrimeKey:
  1349.  
  1350.     tbPrimeKey.AddNew
  1351.  
  1352. ' Write variable "PrimeKey_IndexText" into field "IndexText"
  1353.     If (Trim(PrimeKey_IndexText) = vbNullString) Then
  1354.         tbPrimeKey.Fields("IndexText") = String(25, " ")
  1355.     ElseIf (Len(Trim(PrimeKey_IndexText)) > 25) Then
  1356.         tbPrimeKey.Fields("IndexText") = Left(Trim(PrimeKey_IndexText), 25)
  1357.     Else
  1358.         tbPrimeKey.Fields("IndexText") = Trim(PrimeKey_IndexText)
  1359.     End If
  1360.  
  1361.     GoSub WriteTheRecord
  1362.     tbPrimeKey.Update
  1363.     PrimeKeySiz = (PrimeKeySiz + 1)
  1364.  
  1365.     Return
  1366.  
  1367. '--------------------------------------------------------------------------------
  1368. ' Subroutine to update the PrimeKey record
  1369. '--------------------------------------------------------------------------------
  1370. WritePrimeKey:
  1371.  
  1372.     tbPrimeKey.Edit
  1373.     GoSub WriteTheRecord
  1374.     tbPrimeKey.Update
  1375.  
  1376.     Return
  1377.  
  1378. '--------------------------------------------------------------------------------
  1379. ' The Subroutine for Transferring PrimeKey variable
  1380. '   data to the PrimeKey record fields
  1381. '--------------------------------------------------------------------------------
  1382. WriteTheRecord:
  1383.  
  1384. ' Write variable "PrimeKey_IntLong" into field "IntLong"
  1385.     tbPrimeKey.Fields("IntLong") = PrimeKey_IntLong
  1386.  
  1387. ' Write variable "PrimeKey_IntInteger" into field "IntInteger"
  1388.     tbPrimeKey.Fields("IntInteger") = PrimeKey_IntInteger
  1389.  
  1390. ' Write variable "PrimeKey_IntByte" into field "IntByte"
  1391.     tbPrimeKey.Fields("IntByte") = PrimeKey_IntByte
  1392.  
  1393. ' Write variable "PrimeKey_FptSingle" into field "FptSingle"
  1394.     tbPrimeKey.Fields("FptSingle") = PrimeKey_FptSingle
  1395.  
  1396. ' Write variable "PrimeKey_FptDouble" into field "FptDouble"
  1397.     tbPrimeKey.Fields("FptDouble") = PrimeKey_FptDouble
  1398.  
  1399. ' Write variable "PrimeKey_TextField" into field "TextField"
  1400.     If (Trim(PrimeKey_TextField) = vbNullString) Then
  1401.         PrimeKey_TextField = "Default Text"
  1402.     Else
  1403.         tbPrimeKey.Fields("TextField") = Trim(PrimeKey_TextField)
  1404.     End If
  1405.  
  1406. ' Write variable "PrimeKey_MemoField" into field "MemoField"
  1407.     tbPrimeKey.Fields("MemoField") = Trim(PrimeKey_MemoField)
  1408.  
  1409. ' Write variable "PrimeKey_Today" into field "Today"
  1410.     tbPrimeKey.Fields("Today") = PrimeKey_Today
  1411.  
  1412. ' Write variable "PrimeKey_Flag1" into field "Flag1"
  1413.     tbPrimeKey.Fields("Flag1") = PrimeKey_Flag1
  1414.  
  1415. ' Write variable "PrimeKey_Flag2" into field "Flag2"
  1416.     tbPrimeKey.Fields("Flag2") = PrimeKey_Flag2
  1417.  
  1418. ' Write variable "PrimeKey_Money" into field "Money"
  1419.     tbPrimeKey.Fields("Money") = PrimeKey_Money
  1420.  
  1421.     Return
  1422.  
  1423. End Sub
  1424.  
  1425.  
  1426. ' PrimeKeyPurge: The purpose of this
  1427. '    routine is to provide a means to delete
  1428. '    all records from a given file
  1429. '
  1430. Public Sub PrimeKeyPurge()
  1431.  
  1432.     If Not PrimeKeyOpen Then Call zzPrimeKeyOpen
  1433.  
  1434.     If (PrimeKeySiz > 0) Then
  1435.         Do Until (tbPrimeKey.RecordCount = 0)
  1436.             tbPrimeKey.MoveLast
  1437.             tbPrimeKey.Delete
  1438.         Loop
  1439.         PrimeKeySiz = tbPrimeKey.RecordCount
  1440.     End If
  1441.  
  1442. End Sub
  1443.  
  1444.  
  1445. ' zzPrimeKeyOpen(): Will open the recordset/table and
  1446. '    if necessary will initialize the database
  1447. '
  1448. Private Sub zzPrimeKeyOpen()
  1449.  
  1450.     If PrimeKeyOpen Then Exit Sub
  1451.     If Not Opened Then Call zzInitUmcgTest
  1452.  
  1453.     Set tbPrimeKey = dbUmcgTest.OpenRecordset("PrimeKey", dbOpenTable, dbSeeChanges, dbOptimistic)
  1454.  
  1455.     PrimeKeySiz = tbPrimeKey.RecordCount
  1456.     If (PrimeKeySiz >0) Then
  1457.         tbPrimeKey.Index = "PrimaryKey"
  1458.         PrimeKeyERR = False
  1459.     Else
  1460.         PrimeKeyERR = True
  1461.     End If
  1462.  
  1463.     PrimeKeyOpen = True
  1464.  
  1465. End Sub
  1466.  
  1467.  
  1468. ' zzPrimeKeyRead(): Following a successful read, this routine
  1469. '    will populate the proper variables, or will neutralize
  1470. '    the variables if the read failed.
  1471. '
  1472. Private Sub zzPrimeKeyRead()
  1473.  
  1474.     If PrimeKeyERR Then
  1475.         PrimeKey_IndexText = vbNullString
  1476.         PrimeKey_IntLong =  0
  1477.         PrimeKey_IntInteger =  0
  1478.         PrimeKey_IntByte =  19
  1479.         PrimeKey_FptSingle =  0
  1480.         PrimeKey_FptDouble =  0
  1481.         PrimeKey_TextField = "Default Text"
  1482.         PrimeKey_MemoField = vbNullString
  1483.         PrimeKey_Today =  Now
  1484.         PrimeKey_Flag1 = False
  1485.         PrimeKey_Flag2 = True
  1486.         PrimeKey_Money =  0
  1487.     Else
  1488.  
  1489. ' Read field IndexText
  1490.         If IsNull(tbPrimeKey.Fields("IndexText")) Then
  1491.             PrimeKey_IndexText = vbNullString
  1492.         Else
  1493.             PrimeKey_IndexText = tbPrimeKey.Fields("IndexText")
  1494.         End If
  1495.  
  1496. ' Read field IntLong
  1497.         If IsNull(tbPrimeKey.Fields("IntLong")) Then
  1498.             PrimeKey_IntLong = 0
  1499.         Else
  1500.             PrimeKey_IntLong = tbPrimeKey.Fields("IntLong")
  1501.         End If
  1502.  
  1503. ' Read field IntInteger
  1504.         If IsNull(tbPrimeKey.Fields("IntInteger")) Then
  1505.             PrimeKey_IntInteger = 0
  1506.         Else
  1507.             PrimeKey_IntInteger = tbPrimeKey.Fields("IntInteger")
  1508.         End If
  1509.  
  1510. ' Read field IntByte
  1511.         If IsNull(tbPrimeKey.Fields("IntByte")) Then
  1512.             PrimeKey_IntByte = 0
  1513.         Else
  1514.             PrimeKey_IntByte = tbPrimeKey.Fields("IntByte")
  1515.         End If
  1516.  
  1517. ' Read field FptSingle
  1518.         If IsNull(tbPrimeKey.Fields("FptSingle")) Then
  1519.             PrimeKey_FptSingle = 0
  1520.         Else
  1521.             PrimeKey_FptSingle = tbPrimeKey.Fields("FptSingle")
  1522.         End If
  1523.  
  1524. ' Read field FptDouble
  1525.         If IsNull(tbPrimeKey.Fields("FptDouble")) Then
  1526.             PrimeKey_FptDouble = 0
  1527.         Else
  1528.             PrimeKey_FptDouble = tbPrimeKey.Fields("FptDouble")
  1529.         End If
  1530.  
  1531. ' Read field TextField
  1532.         If IsNull(tbPrimeKey.Fields("TextField")) Then
  1533.             PrimeKey_TextField = vbNullString
  1534.         Else
  1535.             PrimeKey_TextField = tbPrimeKey.Fields("TextField")
  1536.         End If
  1537.  
  1538. ' Read field MemoField
  1539.         If IsNull(tbPrimeKey.Fields("MemoField")) Then
  1540.             PrimeKey_MemoField = vbNullString
  1541.         Else
  1542.             PrimeKey_MemoField = tbPrimeKey.Fields("MemoField")
  1543.         End If
  1544.  
  1545. ' Read field Today
  1546.         If IsNull(tbPrimeKey.Fields("Today")) Then
  1547.             PrimeKey_Today = TimeValue("12:00:00")
  1548.         Else
  1549.             PrimeKey_Today = tbPrimeKey.Fields("Today")
  1550.         End If
  1551.  
  1552. ' Read field Flag1
  1553.         If IsNull(tbPrimeKey.Fields("Flag1")) Then
  1554.             PrimeKey_Flag1 = 0
  1555.         Else
  1556.             PrimeKey_Flag1 = tbPrimeKey.Fields("Flag1")
  1557.         End If
  1558.  
  1559. ' Read field Flag2
  1560.         If IsNull(tbPrimeKey.Fields("Flag2")) Then
  1561.             PrimeKey_Flag2 = 0
  1562.         Else
  1563.             PrimeKey_Flag2 = tbPrimeKey.Fields("Flag2")
  1564.         End If
  1565.  
  1566. ' Read field Money
  1567.         If IsNull(tbPrimeKey.Fields("Money")) Then
  1568.             PrimeKey_Money = 0
  1569.         Else
  1570.             PrimeKey_Money = tbPrimeKey.Fields("Money")
  1571.         End If
  1572.     End If
  1573.  
  1574. End Sub
  1575.  
  1576.  
  1577.