home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PC World 1999 December
/
PCWorld_1999-12_cd.bin
/
Software
/
Servis
/
UrthMDB
/
Codegen
/
mdbUmcgTest.ba_
/
mdbUmcgTest.ba
Wrap
Text File
|
1999-10-03
|
46KB
|
1,577 lines
Attribute VB_Name = "mdbUmcgTest"
Option Explicit
'--------------------------------------------------------------------------------
' mdbUmcgTest.bas: Generated using Urthman's MDB Code Generator v1.00.0191
' Urthman's MDB Code Generator: Copyright⌐ 1999, John Stanley Enterprises
' Create Date: Sunday, October 03, 1999 at 4:11:32 PM
' Created by User Urthman on Machine STAR
' This copy of Urthman's MDB Code Generator is registered to Hugh J S Field
'--------------------------------------------------------------------------------
Dim TestStrg As String
Dim CrntIndx As String
Public MdbFileName as String
Private Const MdbUserName As String = "admin"
Private Const MdbPassWord As String = vbNullString
Public wsUmcgTest as Workspace
Public dbUmcgTest as Database
Dim Opened as Boolean
'--------------------------------------------------------------------------------
' **** Variables for Table: MultiKey
'--------------------------------------------------------------------------------
Dim tbMultiKey as Recordset ' Defines the table object MultiKey
Dim MultiKeyOpen as Boolean ' Indicates if MultiKey is open or not
Public MultiKeyERR as Boolean ' Indicates an error reading from MultiKey
Public MultiKeySiz as Long ' The number of records in MultiKey
' MultiKey field variables
Public MultiKey_IndexText as String * 25 ' Text Index Field25
Public MultiKey_IntLong as Long ' 32-bit signed integer
Public MultiKey_IntInteger as Integer ' 16-bit signed integer
Public MultiKey_IntByte as Byte ' 8-bit unsigned byte
Public MultiKey_FptSingle as Long ' Single Precision FPT
Public MultiKey_FptDouble as Long ' Double Precision FPT
Public MultiKey_TextField as String * 50 ' Text (string) Field
Public MultiKey_MemoField as String ' Memo (string) Field
Public MultiKey_Today as Date ' Todays Date
Public MultiKey_Flag1 as Boolean ' Boolean Flag Data
Public MultiKey_Flag2 as Boolean ' Boolean Flag Data
Public MultiKey_Money as Currency ' Currency Value
'--------------------------------------------------------------------------------
' **** Variables for Table: NoIndexes
'--------------------------------------------------------------------------------
Dim tbNoIndexes as Recordset ' Defines the table object NoIndexes
Dim NoIndexesOpen as Boolean ' Indicates if NoIndexes is open or not
Public NoIndexesERR as Boolean ' Indicates an error reading from NoIndexes
Public NoIndexesSiz as Long ' The number of records in NoIndexes
' NoIndexes field variables
Public NoIndexes_IntLong as Long ' 32-bit signed integer
Public NoIndexes_IntInteger as Integer ' 16-bit signed integer
Public NoIndexes_IntByte as Byte ' 8-bit unsigned byte
Public NoIndexes_FptSingle as Long ' Single Precision FPT
Public NoIndexes_FptDouble as Long ' Double Precision FPT
Public NoIndexes_TextField as String ' Text (string) Field
Public NoIndexes_MemoField as String ' Memo (string) Field
Public NoIndexes_Today as Date ' Todays Date
Public NoIndexes_Flag1 as Boolean ' Boolean Flag Data
Public NoIndexes_Flag2 as Boolean ' Boolean Flag Data
Public NoIndexes_Money as Currency ' Currency Value
'--------------------------------------------------------------------------------
' **** Variables for Table: PrimeKey
'--------------------------------------------------------------------------------
Dim tbPrimeKey as Recordset ' Defines the table object PrimeKey
Dim PrimeKeyOpen as Boolean ' Indicates if PrimeKey is open or not
Public PrimeKeyERR as Boolean ' Indicates an error reading from PrimeKey
Public PrimeKeySiz as Long ' The number of records in PrimeKey
' PrimeKey field variables
Public PrimeKey_IndexText as String * 25 ' Text Index Field25
Public PrimeKey_IntLong as Long ' 32-bit signed integer
Public PrimeKey_IntInteger as Integer ' 16-bit signed integer
Public PrimeKey_IntByte as Byte ' 8-bit unsigned byte
Public PrimeKey_FptSingle as Long ' Single Precision FPT
Public PrimeKey_FptDouble as Long ' Double Precision FPT
Public PrimeKey_TextField as String ' Text (string) Field
Public PrimeKey_MemoField as String ' Memo (string) Field
Public PrimeKey_Today as Date ' Todays Date
Public PrimeKey_Flag1 as Boolean ' Boolean Flag Data
Public PrimeKey_Flag2 as Boolean ' Boolean Flag Data
Public PrimeKey_Money as Currency ' Currency Value
' zzInitUmcgTest: Routine for initializing the database
Private Sub zzInitUmcgTest()
If Opened Then Exit Sub
Set wsUmcgTest = CreateWorkspace(vbNullString, MdbUserName, MdbPassWord, dbUseJet)
Set dbUmcgTest = wsUmcgTest.OpenDatabase(MdbFileName, False)
Opened = True
End Sub
' CloseUmcgTest: This routine shuts down the database
'
Public Sub CloseUmcgTest()
If Not Opened Then Exit Sub
If MultiKeyOpen Then
tbMultiKey.Close
MultiKeyOpen = False
Set tbMultiKey = Nothing
End If
If NoIndexesOpen Then
tbNoIndexes.Close
NoIndexesOpen = False
Set tbNoIndexes = Nothing
End If
If PrimeKeyOpen Then
tbPrimeKey.Close
PrimeKeyOpen = False
Set tbPrimeKey = Nothing
End If
dbUmcgTest.Close
Set dbUmcgTest = Nothing
wsUmcgTest.Close
Set wsUmcgTest = Nothing
Opened = False
End Sub
' MultiKeyClear: Will clear all field variables.
'
Public Sub MultiKeyClear()
MultiKeyERR = True
Call zzMultiKeyRead
MultiKeyERR = False
End Sub
' MultiKeyFind: Will attempt to find a record based
' on the indexed variables of the PrimaryKey index
' and call the read routine.
'
Public Sub MultiKeyFind(fnd_IndexText as String)
If Not MultiKeyOpen Then Call zzMultiKeyOpen
' Copy the parameters into the variables associated
' with index PrimaryKey
MultiKey_IndexText = fnd_IndexText
' Validate any string variables related to index PrimaryKey
TestStrg = Trim(MultiKey_IndexText)
If (Len(Trim(TestStrg)) = 0) Then MultiKey_IndexText = String(25, " ")
If (MultiKeySiz > 0) Then
' If not already set, set index to PrimaryKey
If (tbMultiKey.Index <> "PrimaryKey") Then tbMultiKey.Index = "PrimaryKey"
tbMultiKey.Seek "=", MultiKey_IndexText
MultiKeyERR = tbMultiKey.NoMatch
Else
MultiKeyERR = True
End If
Call zzMultiKeyRead
If MultiKeyERR Then
MultiKey_IndexText = fnd_IndexText
End If
End Sub
' MultiKeyBySecondary: Will attempt to find a record based
' on the indexed variables of the Secondary index
' and call the read routine.
'
Public Sub MultiKeyBySecondary(fnd_TextField as String, fnd_IndexText as String)
If Not MultiKeyOpen Then Call zzMultiKeyOpen
' Copy the parameters into the variables associated
' with index Secondary
MultiKey_TextField = fnd_TextField
MultiKey_IndexText = fnd_IndexText
' Validate any string variables related to index Secondary
TestStrg = Trim(MultiKey_TextField)
If (Len(Trim(TestStrg)) = 0) Then MultiKey_TextField = String(50, " ")
TestStrg = Trim(MultiKey_IndexText)
If (Len(Trim(TestStrg)) = 0) Then MultiKey_IndexText = String(25, " ")
If (MultiKeySiz > 0) Then
' If not already set, set index to Secondary
If (tbMultiKey.Index <> "Secondary") Then tbMultiKey.Index = "Secondary"
tbMultiKey.Seek "=", MultiKey_TextField, MultiKey_IndexText
MultiKeyERR = tbMultiKey.NoMatch
Else
MultiKeyERR = True
End If
Call zzMultiKeyRead
If MultiKeyERR Then
MultiKey_TextField = fnd_TextField
MultiKey_IndexText = fnd_IndexText
End If
End Sub
' MultiKeyByTiertiary: Will attempt to find a record based
' on the indexed variables of the Tiertiary index
' and call the read routine.
'
Public Sub MultiKeyByTiertiary(fnd_Today as Date, fnd_TextField as String, fnd_IndexText as String)
If Not MultiKeyOpen Then Call zzMultiKeyOpen
' Copy the parameters into the variables associated
' with index Tiertiary
MultiKey_Today = fnd_Today
MultiKey_TextField = fnd_TextField
MultiKey_IndexText = fnd_IndexText
' Validate any string variables related to index Tiertiary
TestStrg = Trim(MultiKey_TextField)
If (Len(Trim(TestStrg)) = 0) Then MultiKey_TextField = String(50, " ")
TestStrg = Trim(MultiKey_IndexText)
If (Len(Trim(TestStrg)) = 0) Then MultiKey_IndexText = String(25, " ")
If (MultiKeySiz > 0) Then
' If not already set, set index to Tiertiary
If (tbMultiKey.Index <> "Tiertiary") Then tbMultiKey.Index = "Tiertiary"
tbMultiKey.Seek "=", MultiKey_Today, MultiKey_TextField, MultiKey_IndexText
MultiKeyERR = tbMultiKey.NoMatch
Else
MultiKeyERR = True
End If
Call zzMultiKeyRead
If MultiKeyERR Then
MultiKey_Today = fnd_Today
MultiKey_TextField = fnd_TextField
MultiKey_IndexText = fnd_IndexText
End If
End Sub
' MultiKeyFindNx: Will attempt to find a next record
' based on the indexed variables of the PrimaryKey
' and call the read routine.
'
Public Sub MultiKeyFindNX()
If Not MultiKeyOpen Then Call zzMultiKeyOpen
If (MultiKeySiz > 0) Then
CrntIndx = tbMultiKey.Index
Select Case CrntIndx
Case "PrimaryKey"
' Validate any string variables related to index PrimaryKey
TestStrg = Trim(MultiKey_IndexText)
If (Len(Trim(TestStrg)) = 0) Then MultiKey_IndexText = String(25, " ")
tbMultiKey.Seek ">", MultiKey_IndexText
Case "Secondary"
' Validate any string variables related to index Secondary
TestStrg = Trim(MultiKey_TextField)
If (Len(Trim(TestStrg)) = 0) Then MultiKey_TextField = String(50, " ")
TestStrg = Trim(MultiKey_IndexText)
If (Len(Trim(TestStrg)) = 0) Then MultiKey_IndexText = String(25, " ")
tbMultiKey.Seek ">", MultiKey_TextField, MultiKey_IndexText
Case "Tiertiary"
' Validate any string variables related to index Tiertiary
TestStrg = Trim(MultiKey_TextField)
If (Len(Trim(TestStrg)) = 0) Then MultiKey_TextField = String(50, " ")
TestStrg = Trim(MultiKey_IndexText)
If (Len(Trim(TestStrg)) = 0) Then MultiKey_IndexText = String(25, " ")
tbMultiKey.Seek ">", MultiKey_Today, MultiKey_TextField, MultiKey_IndexText
End Select
MultiKeyERR = tbMultiKey.NoMatch
Else
MultiKeyERR = True
End If
Call zzMultiKeyRead
End Sub
' MultiKeyFindPv: Will attempt to find a previous record
' based on the indexed variables of the PrimaryKey
' and call the read routine.
'
Public Sub MultiKeyFindPV()
If Not MultiKeyOpen Then Call zzMultiKeyOpen
If (MultiKeySiz > 0) Then
CrntIndx = tbMultiKey.Index
Select Case CrntIndx
Case "PrimaryKey"
' Validate any string variables related to index PrimaryKey
TestStrg = Trim(MultiKey_IndexText)
If (Len(Trim(TestStrg)) = 0) Then MultiKey_IndexText = String(25, " ")
tbMultiKey.Seek "<", MultiKey_IndexText
Case "Secondary"
' Validate any string variables related to index Secondary
TestStrg = Trim(MultiKey_TextField)
If (Len(Trim(TestStrg)) = 0) Then MultiKey_TextField = String(50, " ")
TestStrg = Trim(MultiKey_IndexText)
If (Len(Trim(TestStrg)) = 0) Then MultiKey_IndexText = String(25, " ")
tbMultiKey.Seek "<", MultiKey_TextField, MultiKey_IndexText
Case "Tiertiary"
' Validate any string variables related to index Tiertiary
TestStrg = Trim(MultiKey_TextField)
If (Len(Trim(TestStrg)) = 0) Then MultiKey_TextField = String(50, " ")
TestStrg = Trim(MultiKey_IndexText)
If (Len(Trim(TestStrg)) = 0) Then MultiKey_IndexText = String(25, " ")
tbMultiKey.Seek "<", MultiKey_Today, MultiKey_TextField, MultiKey_IndexText
End Select
MultiKeyERR = tbMultiKey.NoMatch
Else
MultiKeyERR = True
End If
Call zzMultiKeyRead
End Sub
' MultiKeyFirst: Will change the current record to the
' first record and call the read routine.
'
Public Sub MultiKeyFirst()
If Not MultiKeyOpen Then Call zzMultiKeyOpen
If (MultiKeySiz > 0) Then
tbMultiKey.MoveFirst
MultiKeyERR = False
Else
MultiKeyERR = True
End If
Call zzMultiKeyRead
End Sub
' MultiKeyIsKey: A function that returns true if the
' current index is the Primary Key
Public Function MultiKeyIsKey() As Boolean
If Not MultiKeyOpen Then
MultiKeyIsKey = False
Exit Function
End If
If (tbMultiKey.Index = "PrimaryKey") Then
MultiKeyIsKey = True
Else
MultiKeyIsKey = False
End If
End Function
' MultiKeyKill: Will attempt to find a record based
' on the indexed variables of the PrimaryKey
' and subsequently delete that record.
'
Public Sub MultiKeyKill(fnd_IndexText as String)
If Not MultiKeyOpen Then Call zzMultiKeyOpen
' Copy the parameters into the variables associated
' with index PrimaryKey
MultiKey_IndexText = fnd_IndexText
' Validate any string variables related to index PrimaryKey
TestStrg = Trim(MultiKey_IndexText)
If (Len(Trim(TestStrg)) = 0) Then MultiKey_IndexText = String(25, " ")
If (MultiKeySiz > 0) Then
' Hang on the the current index and set index to PrimaryKey
CrntIndx = tbMultiKey.Index
If (tbMultiKey.Index <> "PrimaryKey") Then tbMultiKey.Index = "PrimaryKey"
tbMultiKey.Seek "=", MultiKey_IndexText
If Not tbMultiKey.NoMatch Then tbMultiKey.Delete
MultiKeySiz = tbMultiKey.RecordCount
If (MultiKeySiz > 0) Then
' Restore the original index saved in CrntIndx
If (tbMultiKey.Index <> CrntIndx) Then tbMultiKey.Index = CrntIndx
Select Case CrntIndx
Case "PrimaryKey"
tbMultiKey.Seek ">=", MultiKey_IndexText
If tbMultiKey.NoMatch Then tbMultiKey.Seek "<=", MultiKey_IndexText
Case "Secondary"
tbMultiKey.Seek ">=", MultiKey_TextField, MultiKey_IndexText
If tbMultiKey.NoMatch Then tbMultiKey.Seek "<=", MultiKey_TextField, MultiKey_IndexText
Case "Tiertiary"
tbMultiKey.Seek ">=", MultiKey_Today, MultiKey_TextField, MultiKey_IndexText
If tbMultiKey.NoMatch Then tbMultiKey.Seek "<=", MultiKey_Today, MultiKey_TextField, MultiKey_IndexText
End Select
MultiKeyERR = False
Else
MultiKeyERR = True
End If
End If
Call zzMultiKeyRead
End Sub
' MultiKeyLast: Will change the current record to the
' last record and call the read routine.
'
Public Sub MultiKeyLast()
If Not MultiKeyOpen Then Call zzMultiKeyOpen
If (MultiKeySiz > 0) Then
tbMultiKey.MoveLast
MultiKeyERR = False
Else
MultiKeyERR = True
End If
Call zzMultiKeyRead
End Sub
' MultiKeyNext: Will change the current record to the
' next record and call the read routine.
'
Public Sub MultiKeyNext()
If Not MultiKeyOpen Then Call zzMultiKeyOpen
If (MultiKeySiz > 0) Then
tbMultiKey.MoveNext
If tbMultiKey.EOF Then
MultiKeyERR = True
Else
MultiKeyERR = False
End If
Else
MultiKeyERR = True
End If
Call zzMultiKeyRead
End Sub
' MultiKeyPrevious: Will change the current record to the
' previous record and call the read routine.
'
Public Sub MultiKeyPrevious()
If Not MultiKeyOpen Then Call zzMultiKeyOpen
If (MultiKeySiz > 0) Then
tbMultiKey.MovePrevious
If tbMultiKey.BOF Then
MultiKeyERR = True
Else
MultiKeyERR = False
End If
Else
MultiKeyERR = True
End If
Call zzMultiKeyRead
End Sub
' MultiKeySave: Designed to either save data as a
' new record, or update an existing record. If there
' is no PrimaryKey, the record will simply be added.
'
Public Sub MultiKeySave()
If Not MultiKeyOpen Then Call zzMultiKeyOpen
' Validate any string variables related to index PrimaryKey
TestStrg = Trim(MultiKey_IndexText)
If (Len(Trim(TestStrg)) = 0) Then MultiKey_IndexText = String(25, " ")
If (MultiKeySiz > 0) Then
' Hang on the the current index and set index to PrimaryKey
CrntIndx = tbMultiKey.Index
If (tbMultiKey.Index <> "PrimaryKey") Then tbMultiKey.Index = "PrimaryKey"
tbMultiKey.Seek "=", MultiKey_IndexText
If tbMultiKey.NoMatch Then
GoSub AddMultiKey
Else
GoSub WriteMultiKey
End If
' Restore the original index saved in CrntIndx
If (tbMultiKey.Index <> CrntIndx) Then tbMultiKey.Index = CrntIndx
Select Case CrntIndx
Case "PrimaryKey"
tbMultiKey.Seek ">=", MultiKey_IndexText
If tbMultiKey.NoMatch Then tbMultiKey.Seek "<=", MultiKey_IndexText
Case "Secondary"
tbMultiKey.Seek ">=", MultiKey_TextField, MultiKey_IndexText
If tbMultiKey.NoMatch Then tbMultiKey.Seek "<=", MultiKey_TextField, MultiKey_IndexText
Case "Tiertiary"
tbMultiKey.Seek ">=", MultiKey_Today, MultiKey_TextField, MultiKey_IndexText
If tbMultiKey.NoMatch Then tbMultiKey.Seek "<=", MultiKey_Today, MultiKey_TextField, MultiKey_IndexText
End Select
MultiKeyERR = False
Else
GoSub AddMultiKey
' If not already set, set index to PrimaryKey
If (tbMultiKey.Index <> "PrimaryKey") Then tbMultiKey.Index = "PrimaryKey"
End If
Exit Sub
'--------------------------------------------------------------------------------
' Subroutine to ADD a record to MultiKey
'--------------------------------------------------------------------------------
AddMultiKey:
tbMultiKey.AddNew
' Write variable "MultiKey_IndexText" into field "IndexText"
If (Trim(MultiKey_IndexText) = vbNullString) Then
tbMultiKey.Fields("IndexText") = String(25, " ")
ElseIf (Len(Trim(MultiKey_IndexText)) > 25) Then
tbMultiKey.Fields("IndexText") = Left(Trim(MultiKey_IndexText), 25)
Else
tbMultiKey.Fields("IndexText") = Trim(MultiKey_IndexText)
End If
GoSub WriteTheRecord
tbMultiKey.Update
MultiKeySiz = (MultiKeySiz + 1)
Return
'--------------------------------------------------------------------------------
' Subroutine to update the MultiKey record
'--------------------------------------------------------------------------------
WriteMultiKey:
tbMultiKey.Edit
GoSub WriteTheRecord
tbMultiKey.Update
Return
'--------------------------------------------------------------------------------
' The Subroutine for Transferring MultiKey variable
' data to the MultiKey record fields
'--------------------------------------------------------------------------------
WriteTheRecord:
' Write variable "MultiKey_IntLong" into field "IntLong"
tbMultiKey.Fields("IntLong") = MultiKey_IntLong
' Write variable "MultiKey_IntInteger" into field "IntInteger"
tbMultiKey.Fields("IntInteger") = MultiKey_IntInteger
' Write variable "MultiKey_IntByte" into field "IntByte"
tbMultiKey.Fields("IntByte") = MultiKey_IntByte
' Write variable "MultiKey_FptSingle" into field "FptSingle"
tbMultiKey.Fields("FptSingle") = MultiKey_FptSingle
' Write variable "MultiKey_FptDouble" into field "FptDouble"
tbMultiKey.Fields("FptDouble") = MultiKey_FptDouble
' Write variable "MultiKey_TextField" into field "TextField"
If (Trim(MultiKey_TextField) = vbNullString) Then
tbMultiKey.Fields("TextField") = String(50, " ")
ElseIf (Len(Trim(MultiKey_TextField)) > 50) Then
tbMultiKey.Fields("TextField") = Left(Trim(MultiKey_TextField), 50)
Else
tbMultiKey.Fields("TextField") = Trim(MultiKey_TextField)
End If
' Write variable "MultiKey_MemoField" into field "MemoField"
tbMultiKey.Fields("MemoField") = Trim(MultiKey_MemoField)
' Write variable "MultiKey_Today" into field "Today"
tbMultiKey.Fields("Today") = MultiKey_Today
' Write variable "MultiKey_Flag1" into field "Flag1"
tbMultiKey.Fields("Flag1") = MultiKey_Flag1
' Write variable "MultiKey_Flag2" into field "Flag2"
tbMultiKey.Fields("Flag2") = MultiKey_Flag2
' Write variable "MultiKey_Money" into field "Money"
tbMultiKey.Fields("Money") = MultiKey_Money
Return
End Sub
' MultiKeyPurge: The purpose of this
' routine is to provide a means to delete
' all records from a given file
'
Public Sub MultiKeyPurge()
If Not MultiKeyOpen Then Call zzMultiKeyOpen
If (MultiKeySiz > 0) Then
Do Until (tbMultiKey.RecordCount = 0)
tbMultiKey.MoveLast
tbMultiKey.Delete
Loop
MultiKeySiz = tbMultiKey.RecordCount
End If
End Sub
' zzMultiKeyOpen(): Will open the recordset/table and
' if necessary will initialize the database
'
Private Sub zzMultiKeyOpen()
If MultiKeyOpen Then Exit Sub
If Not Opened Then Call zzInitUmcgTest
Set tbMultiKey = dbUmcgTest.OpenRecordset("MultiKey", dbOpenTable, dbSeeChanges, dbOptimistic)
MultiKeySiz = tbMultiKey.RecordCount
If (MultiKeySiz >0) Then
' If not already set, set index to PrimaryKey
If (tbMultiKey.Index <> "PrimaryKey") Then tbMultiKey.Index = "PrimaryKey"
MultiKeyERR = False
Else
MultiKeyERR = True
End If
MultiKeyOpen = True
End Sub
' zzMultiKeyRead(): Following a successful read, this routine
' will populate the proper variables, or will neutralize
' the variables if the read failed.
'
Private Sub zzMultiKeyRead()
If MultiKeyERR Then
MultiKey_IndexText = vbNullString
MultiKey_IntLong = 0
MultiKey_IntInteger = 0
MultiKey_IntByte = 0
MultiKey_FptSingle = 0
MultiKey_FptDouble = 0
MultiKey_TextField = vbNullString
MultiKey_MemoField = vbNullString
MultiKey_Today = TimeValue("12:00:00")
MultiKey_Flag1 = False
MultiKey_Flag2 = False
MultiKey_Money = 0
Else
' Read field IndexText
If IsNull(tbMultiKey.Fields("IndexText")) Then
MultiKey_IndexText = vbNullString
Else
MultiKey_IndexText = tbMultiKey.Fields("IndexText")
End If
' Read field IntLong
If IsNull(tbMultiKey.Fields("IntLong")) Then
MultiKey_IntLong = 0
Else
MultiKey_IntLong = tbMultiKey.Fields("IntLong")
End If
' Read field IntInteger
If IsNull(tbMultiKey.Fields("IntInteger")) Then
MultiKey_IntInteger = 0
Else
MultiKey_IntInteger = tbMultiKey.Fields("IntInteger")
End If
' Read field IntByte
If IsNull(tbMultiKey.Fields("IntByte")) Then
MultiKey_IntByte = 0
Else
MultiKey_IntByte = tbMultiKey.Fields("IntByte")
End If
' Read field FptSingle
If IsNull(tbMultiKey.Fields("FptSingle")) Then
MultiKey_FptSingle = 0
Else
MultiKey_FptSingle = tbMultiKey.Fields("FptSingle")
End If
' Read field FptDouble
If IsNull(tbMultiKey.Fields("FptDouble")) Then
MultiKey_FptDouble = 0
Else
MultiKey_FptDouble = tbMultiKey.Fields("FptDouble")
End If
' Read field TextField
If IsNull(tbMultiKey.Fields("TextField")) Then
MultiKey_TextField = vbNullString
Else
MultiKey_TextField = tbMultiKey.Fields("TextField")
End If
' Read field MemoField
If IsNull(tbMultiKey.Fields("MemoField")) Then
MultiKey_MemoField = vbNullString
Else
MultiKey_MemoField = tbMultiKey.Fields("MemoField")
End If
' Read field Today
If IsNull(tbMultiKey.Fields("Today")) Then
MultiKey_Today = TimeValue("12:00:00")
Else
MultiKey_Today = tbMultiKey.Fields("Today")
End If
' Read field Flag1
If IsNull(tbMultiKey.Fields("Flag1")) Then
MultiKey_Flag1 = 0
Else
MultiKey_Flag1 = tbMultiKey.Fields("Flag1")
End If
' Read field Flag2
If IsNull(tbMultiKey.Fields("Flag2")) Then
MultiKey_Flag2 = 0
Else
MultiKey_Flag2 = tbMultiKey.Fields("Flag2")
End If
' Read field Money
If IsNull(tbMultiKey.Fields("Money")) Then
MultiKey_Money = 0
Else
MultiKey_Money = tbMultiKey.Fields("Money")
End If
End If
End Sub
' NoIndexesClear: Will clear all field variables.
'
Public Sub NoIndexesClear()
NoIndexesERR = True
Call zzNoIndexesRead
NoIndexesERR = False
End Sub
' NoIndexesFirst: Will change the current record to the
' first record and call the read routine.
'
Public Sub NoIndexesFirst()
If Not NoIndexesOpen Then Call zzNoIndexesOpen
If (NoIndexesSiz > 0) Then
tbNoIndexes.MoveFirst
NoIndexesERR = False
Else
NoIndexesERR = True
End If
Call zzNoIndexesRead
End Sub
' NoIndexesKill: Will attempt to find a record based
' on the indexed variables of the PrimaryKey
' and subsequently delete that record.
'
Public Sub NoIndexesKill()
If Not NoIndexesOpen Then Call zzNoIndexesOpen
tbNoIndexes.Delete
tbNoIndexes.MoveNext
If tbNoIndexes.EOF Then
tbNoIndexes.MovePrevious
NoIndexesERR = tbNoIndexes.BOF
Else
NoIndexesERR = False
End If
NoIndexesSiz = tbNoIndexes.RecordCount
Call zzNoIndexesRead
End Sub
' NoIndexesLast: Will change the current record to the
' last record and call the read routine.
'
Public Sub NoIndexesLast()
If Not NoIndexesOpen Then Call zzNoIndexesOpen
If (NoIndexesSiz > 0) Then
tbNoIndexes.MoveLast
NoIndexesERR = False
Else
NoIndexesERR = True
End If
Call zzNoIndexesRead
End Sub
' NoIndexesNext: Will change the current record to the
' next record and call the read routine.
'
Public Sub NoIndexesNext()
If Not NoIndexesOpen Then Call zzNoIndexesOpen
If (NoIndexesSiz > 0) Then
tbNoIndexes.MoveNext
If tbNoIndexes.EOF Then
NoIndexesERR = True
Else
NoIndexesERR = False
End If
Else
NoIndexesERR = True
End If
Call zzNoIndexesRead
End Sub
' NoIndexesPrevious: Will change the current record to the
' previous record and call the read routine.
'
Public Sub NoIndexesPrevious()
If Not NoIndexesOpen Then Call zzNoIndexesOpen
If (NoIndexesSiz > 0) Then
tbNoIndexes.MovePrevious
If tbNoIndexes.BOF Then
NoIndexesERR = True
Else
NoIndexesERR = False
End If
Else
NoIndexesERR = True
End If
Call zzNoIndexesRead
End Sub
' NoIndexesSave: Designed to either save data as a
' new record, or update an existing record. If there
' is no PrimaryKey, the record will simply be added.
'
Public Sub NoIndexesSave()
If Not NoIndexesOpen Then Call zzNoIndexesOpen
AddNoIndexes:
tbNoIndexes.AddNew
' Write variable "NoIndexes_IntLong" into field "IntLong"
tbNoIndexes.Fields("IntLong") = NoIndexes_IntLong
' Write variable "NoIndexes_IntInteger" into field "IntInteger"
tbNoIndexes.Fields("IntInteger") = NoIndexes_IntInteger
' Write variable "NoIndexes_IntByte" into field "IntByte"
tbNoIndexes.Fields("IntByte") = NoIndexes_IntByte
' Write variable "NoIndexes_FptSingle" into field "FptSingle"
tbNoIndexes.Fields("FptSingle") = NoIndexes_FptSingle
' Write variable "NoIndexes_FptDouble" into field "FptDouble"
tbNoIndexes.Fields("FptDouble") = NoIndexes_FptDouble
' Write variable "NoIndexes_TextField" into field "TextField"
If (Len(Trim(NoIndexes_TextField)) > 50) Then
tbNoIndexes.Fields("TextField") = Left(Trim(NoIndexes_TextField), 50)
Else
tbNoIndexes.Fields("TextField") = Trim(NoIndexes_TextField)
End If
' Write variable "NoIndexes_MemoField" into field "MemoField"
tbNoIndexes.Fields("MemoField") = Trim(NoIndexes_MemoField)
' Write variable "NoIndexes_Today" into field "Today"
tbNoIndexes.Fields("Today") = NoIndexes_Today
' Write variable "NoIndexes_Flag1" into field "Flag1"
tbNoIndexes.Fields("Flag1") = NoIndexes_Flag1
' Write variable "NoIndexes_Flag2" into field "Flag2"
tbNoIndexes.Fields("Flag2") = NoIndexes_Flag2
' Write variable "NoIndexes_Money" into field "Money"
tbNoIndexes.Fields("Money") = NoIndexes_Money
tbNoIndexes.Update
End Sub
' NoIndexesPurge: The purpose of this
' routine is to provide a means to delete
' all records from a given file
'
Public Sub NoIndexesPurge()
If Not NoIndexesOpen Then Call zzNoIndexesOpen
If (NoIndexesSiz > 0) Then
Do Until (tbNoIndexes.RecordCount = 0)
tbNoIndexes.MoveLast
tbNoIndexes.Delete
Loop
NoIndexesSiz = tbNoIndexes.RecordCount
End If
End Sub
' zzNoIndexesOpen(): Will open the recordset/table and
' if necessary will initialize the database
'
Private Sub zzNoIndexesOpen()
If NoIndexesOpen Then Exit Sub
If Not Opened Then Call zzInitUmcgTest
Set tbNoIndexes = dbUmcgTest.OpenRecordset("NoIndexes", dbOpenTable, dbSeeChanges, dbOptimistic)
NoIndexesSiz = tbNoIndexes.RecordCount
If (NoIndexesSiz >0) Then
NoIndexesERR = False
Else
NoIndexesERR = True
End If
NoIndexesOpen = True
End Sub
' zzNoIndexesRead(): Following a successful read, this routine
' will populate the proper variables, or will neutralize
' the variables if the read failed.
'
Private Sub zzNoIndexesRead()
If NoIndexesERR Then
NoIndexes_IntLong = 0
NoIndexes_IntInteger = 0
NoIndexes_IntByte = 0
NoIndexes_FptSingle = 0
NoIndexes_FptDouble = 0
NoIndexes_TextField = vbNullString
NoIndexes_MemoField = vbNullString
NoIndexes_Today = TimeValue("12:00:00")
NoIndexes_Flag1 = False
NoIndexes_Flag2 = False
NoIndexes_Money = 0
Else
' Read field IntLong
If IsNull(tbNoIndexes.Fields("IntLong")) Then
NoIndexes_IntLong = 0
Else
NoIndexes_IntLong = tbNoIndexes.Fields("IntLong")
End If
' Read field IntInteger
If IsNull(tbNoIndexes.Fields("IntInteger")) Then
NoIndexes_IntInteger = 0
Else
NoIndexes_IntInteger = tbNoIndexes.Fields("IntInteger")
End If
' Read field IntByte
If IsNull(tbNoIndexes.Fields("IntByte")) Then
NoIndexes_IntByte = 0
Else
NoIndexes_IntByte = tbNoIndexes.Fields("IntByte")
End If
' Read field FptSingle
If IsNull(tbNoIndexes.Fields("FptSingle")) Then
NoIndexes_FptSingle = 0
Else
NoIndexes_FptSingle = tbNoIndexes.Fields("FptSingle")
End If
' Read field FptDouble
If IsNull(tbNoIndexes.Fields("FptDouble")) Then
NoIndexes_FptDouble = 0
Else
NoIndexes_FptDouble = tbNoIndexes.Fields("FptDouble")
End If
' Read field TextField
If IsNull(tbNoIndexes.Fields("TextField")) Then
NoIndexes_TextField = vbNullString
Else
NoIndexes_TextField = tbNoIndexes.Fields("TextField")
End If
' Read field MemoField
If IsNull(tbNoIndexes.Fields("MemoField")) Then
NoIndexes_MemoField = vbNullString
Else
NoIndexes_MemoField = tbNoIndexes.Fields("MemoField")
End If
' Read field Today
If IsNull(tbNoIndexes.Fields("Today")) Then
NoIndexes_Today = TimeValue("12:00:00")
Else
NoIndexes_Today = tbNoIndexes.Fields("Today")
End If
' Read field Flag1
If IsNull(tbNoIndexes.Fields("Flag1")) Then
NoIndexes_Flag1 = 0
Else
NoIndexes_Flag1 = tbNoIndexes.Fields("Flag1")
End If
' Read field Flag2
If IsNull(tbNoIndexes.Fields("Flag2")) Then
NoIndexes_Flag2 = 0
Else
NoIndexes_Flag2 = tbNoIndexes.Fields("Flag2")
End If
' Read field Money
If IsNull(tbNoIndexes.Fields("Money")) Then
NoIndexes_Money = 0
Else
NoIndexes_Money = tbNoIndexes.Fields("Money")
End If
End If
End Sub
' PrimeKeyClear: Will clear all field variables.
'
Public Sub PrimeKeyClear()
PrimeKeyERR = True
Call zzPrimeKeyRead
PrimeKeyERR = False
End Sub
' PrimeKeyFind: Will attempt to find a record based
' on the indexed variables of the PrimaryKey index
' and call the read routine.
'
Public Sub PrimeKeyFind(fnd_IndexText as String)
If Not PrimeKeyOpen Then Call zzPrimeKeyOpen
' Copy the parameters into the variables associated
' with index PrimaryKey
PrimeKey_IndexText = fnd_IndexText
' Validate any string variables related to index PrimaryKey
TestStrg = Trim(PrimeKey_IndexText)
If (Len(Trim(TestStrg)) = 0) Then PrimeKey_IndexText = String(25, " ")
If (PrimeKeySiz > 0) Then
tbPrimeKey.Seek "=", PrimeKey_IndexText
PrimeKeyERR = tbPrimeKey.NoMatch
Else
PrimeKeyERR = True
End If
Call zzPrimeKeyRead
If PrimeKeyERR Then
PrimeKey_IndexText = fnd_IndexText
End If
End Sub
' PrimeKeyFindNx: Will attempt to find a next record
' based on the indexed variables of the PrimaryKey
' and call the read routine.
'
Public Sub PrimeKeyFindNX()
If Not PrimeKeyOpen Then Call zzPrimeKeyOpen
If (PrimeKeySiz > 0) Then
tbPrimeKey.Seek ">", PrimeKey_IndexText
PrimeKeyERR = tbPrimeKey.NoMatch
Else
PrimeKeyERR = True
End If
Call zzPrimeKeyRead
End Sub
' PrimeKeyFindPv: Will attempt to find a previous record
' based on the indexed variables of the PrimaryKey
' and call the read routine.
'
Public Sub PrimeKeyFindPV()
If Not PrimeKeyOpen Then Call zzPrimeKeyOpen
If (PrimeKeySiz > 0) Then
tbPrimeKey.Seek "<", PrimeKey_IndexText
PrimeKeyERR = tbPrimeKey.NoMatch
Else
PrimeKeyERR = True
End If
Call zzPrimeKeyRead
End Sub
' PrimeKeyFirst: Will change the current record to the
' first record and call the read routine.
'
Public Sub PrimeKeyFirst()
If Not PrimeKeyOpen Then Call zzPrimeKeyOpen
If (PrimeKeySiz > 0) Then
tbPrimeKey.MoveFirst
PrimeKeyERR = False
Else
PrimeKeyERR = True
End If
Call zzPrimeKeyRead
End Sub
' PrimeKeyKill: Will attempt to find a record based
' on the indexed variables of the PrimaryKey
' and subsequently delete that record.
'
Public Sub PrimeKeyKill(fnd_IndexText as String)
If Not PrimeKeyOpen Then Call zzPrimeKeyOpen
' Copy the parameters into the variables associated
' with index PrimaryKey
PrimeKey_IndexText = fnd_IndexText
' Validate any string variables related to index PrimaryKey
TestStrg = Trim(PrimeKey_IndexText)
If (Len(Trim(TestStrg)) = 0) Then PrimeKey_IndexText = String(25, " ")
If (PrimeKeySiz > 0) Then
tbPrimeKey.Seek "=", PrimeKey_IndexText
If Not tbPrimeKey.NoMatch Then tbPrimeKey.Delete
PrimeKeySiz = tbPrimeKey.RecordCount
If (PrimeKeySiz > 0) Then
tbPrimeKey.Seek ">=", PrimeKey_IndexText
If tbPrimeKey.NoMatch Then tbPrimeKey.Seek "<=", PrimeKey_IndexText
PrimeKeyERR = False
Else
PrimeKeyERR = True
End If
End If
Call zzPrimeKeyRead
End Sub
' PrimeKeyLast: Will change the current record to the
' last record and call the read routine.
'
Public Sub PrimeKeyLast()
If Not PrimeKeyOpen Then Call zzPrimeKeyOpen
If (PrimeKeySiz > 0) Then
tbPrimeKey.MoveLast
PrimeKeyERR = False
Else
PrimeKeyERR = True
End If
Call zzPrimeKeyRead
End Sub
' PrimeKeyNext: Will change the current record to the
' next record and call the read routine.
'
Public Sub PrimeKeyNext()
If Not PrimeKeyOpen Then Call zzPrimeKeyOpen
If (PrimeKeySiz > 0) Then
tbPrimeKey.MoveNext
If tbPrimeKey.EOF Then
PrimeKeyERR = True
Else
PrimeKeyERR = False
End If
Else
PrimeKeyERR = True
End If
Call zzPrimeKeyRead
End Sub
' PrimeKeyPrevious: Will change the current record to the
' previous record and call the read routine.
'
Public Sub PrimeKeyPrevious()
If Not PrimeKeyOpen Then Call zzPrimeKeyOpen
If (PrimeKeySiz > 0) Then
tbPrimeKey.MovePrevious
If tbPrimeKey.BOF Then
PrimeKeyERR = True
Else
PrimeKeyERR = False
End If
Else
PrimeKeyERR = True
End If
Call zzPrimeKeyRead
End Sub
' PrimeKeySave: Designed to either save data as a
' new record, or update an existing record. If there
' is no PrimaryKey, the record will simply be added.
'
Public Sub PrimeKeySave()
If Not PrimeKeyOpen Then Call zzPrimeKeyOpen
' Validate any string variables related to index PrimaryKey
TestStrg = Trim(PrimeKey_IndexText)
If (Len(Trim(TestStrg)) = 0) Then PrimeKey_IndexText = String(25, " ")
If (PrimeKeySiz > 0) Then
tbPrimeKey.Seek "=", PrimeKey_IndexText
If tbPrimeKey.NoMatch Then
GoSub AddPrimeKey
Else
GoSub WritePrimeKey
End If
Else
GoSub AddPrimeKey
tbPrimeKey.Index = "PrimaryKey"
End If
Exit Sub
'--------------------------------------------------------------------------------
' Subroutine to ADD a record to PrimeKey
'--------------------------------------------------------------------------------
AddPrimeKey:
tbPrimeKey.AddNew
' Write variable "PrimeKey_IndexText" into field "IndexText"
If (Trim(PrimeKey_IndexText) = vbNullString) Then
tbPrimeKey.Fields("IndexText") = String(25, " ")
ElseIf (Len(Trim(PrimeKey_IndexText)) > 25) Then
tbPrimeKey.Fields("IndexText") = Left(Trim(PrimeKey_IndexText), 25)
Else
tbPrimeKey.Fields("IndexText") = Trim(PrimeKey_IndexText)
End If
GoSub WriteTheRecord
tbPrimeKey.Update
PrimeKeySiz = (PrimeKeySiz + 1)
Return
'--------------------------------------------------------------------------------
' Subroutine to update the PrimeKey record
'--------------------------------------------------------------------------------
WritePrimeKey:
tbPrimeKey.Edit
GoSub WriteTheRecord
tbPrimeKey.Update
Return
'--------------------------------------------------------------------------------
' The Subroutine for Transferring PrimeKey variable
' data to the PrimeKey record fields
'--------------------------------------------------------------------------------
WriteTheRecord:
' Write variable "PrimeKey_IntLong" into field "IntLong"
tbPrimeKey.Fields("IntLong") = PrimeKey_IntLong
' Write variable "PrimeKey_IntInteger" into field "IntInteger"
tbPrimeKey.Fields("IntInteger") = PrimeKey_IntInteger
' Write variable "PrimeKey_IntByte" into field "IntByte"
tbPrimeKey.Fields("IntByte") = PrimeKey_IntByte
' Write variable "PrimeKey_FptSingle" into field "FptSingle"
tbPrimeKey.Fields("FptSingle") = PrimeKey_FptSingle
' Write variable "PrimeKey_FptDouble" into field "FptDouble"
tbPrimeKey.Fields("FptDouble") = PrimeKey_FptDouble
' Write variable "PrimeKey_TextField" into field "TextField"
If (Trim(PrimeKey_TextField) = vbNullString) Then
PrimeKey_TextField = "Default Text"
Else
tbPrimeKey.Fields("TextField") = Trim(PrimeKey_TextField)
End If
' Write variable "PrimeKey_MemoField" into field "MemoField"
tbPrimeKey.Fields("MemoField") = Trim(PrimeKey_MemoField)
' Write variable "PrimeKey_Today" into field "Today"
tbPrimeKey.Fields("Today") = PrimeKey_Today
' Write variable "PrimeKey_Flag1" into field "Flag1"
tbPrimeKey.Fields("Flag1") = PrimeKey_Flag1
' Write variable "PrimeKey_Flag2" into field "Flag2"
tbPrimeKey.Fields("Flag2") = PrimeKey_Flag2
' Write variable "PrimeKey_Money" into field "Money"
tbPrimeKey.Fields("Money") = PrimeKey_Money
Return
End Sub
' PrimeKeyPurge: The purpose of this
' routine is to provide a means to delete
' all records from a given file
'
Public Sub PrimeKeyPurge()
If Not PrimeKeyOpen Then Call zzPrimeKeyOpen
If (PrimeKeySiz > 0) Then
Do Until (tbPrimeKey.RecordCount = 0)
tbPrimeKey.MoveLast
tbPrimeKey.Delete
Loop
PrimeKeySiz = tbPrimeKey.RecordCount
End If
End Sub
' zzPrimeKeyOpen(): Will open the recordset/table and
' if necessary will initialize the database
'
Private Sub zzPrimeKeyOpen()
If PrimeKeyOpen Then Exit Sub
If Not Opened Then Call zzInitUmcgTest
Set tbPrimeKey = dbUmcgTest.OpenRecordset("PrimeKey", dbOpenTable, dbSeeChanges, dbOptimistic)
PrimeKeySiz = tbPrimeKey.RecordCount
If (PrimeKeySiz >0) Then
tbPrimeKey.Index = "PrimaryKey"
PrimeKeyERR = False
Else
PrimeKeyERR = True
End If
PrimeKeyOpen = True
End Sub
' zzPrimeKeyRead(): Following a successful read, this routine
' will populate the proper variables, or will neutralize
' the variables if the read failed.
'
Private Sub zzPrimeKeyRead()
If PrimeKeyERR Then
PrimeKey_IndexText = vbNullString
PrimeKey_IntLong = 0
PrimeKey_IntInteger = 0
PrimeKey_IntByte = 19
PrimeKey_FptSingle = 0
PrimeKey_FptDouble = 0
PrimeKey_TextField = "Default Text"
PrimeKey_MemoField = vbNullString
PrimeKey_Today = Now
PrimeKey_Flag1 = False
PrimeKey_Flag2 = True
PrimeKey_Money = 0
Else
' Read field IndexText
If IsNull(tbPrimeKey.Fields("IndexText")) Then
PrimeKey_IndexText = vbNullString
Else
PrimeKey_IndexText = tbPrimeKey.Fields("IndexText")
End If
' Read field IntLong
If IsNull(tbPrimeKey.Fields("IntLong")) Then
PrimeKey_IntLong = 0
Else
PrimeKey_IntLong = tbPrimeKey.Fields("IntLong")
End If
' Read field IntInteger
If IsNull(tbPrimeKey.Fields("IntInteger")) Then
PrimeKey_IntInteger = 0
Else
PrimeKey_IntInteger = tbPrimeKey.Fields("IntInteger")
End If
' Read field IntByte
If IsNull(tbPrimeKey.Fields("IntByte")) Then
PrimeKey_IntByte = 0
Else
PrimeKey_IntByte = tbPrimeKey.Fields("IntByte")
End If
' Read field FptSingle
If IsNull(tbPrimeKey.Fields("FptSingle")) Then
PrimeKey_FptSingle = 0
Else
PrimeKey_FptSingle = tbPrimeKey.Fields("FptSingle")
End If
' Read field FptDouble
If IsNull(tbPrimeKey.Fields("FptDouble")) Then
PrimeKey_FptDouble = 0
Else
PrimeKey_FptDouble = tbPrimeKey.Fields("FptDouble")
End If
' Read field TextField
If IsNull(tbPrimeKey.Fields("TextField")) Then
PrimeKey_TextField = vbNullString
Else
PrimeKey_TextField = tbPrimeKey.Fields("TextField")
End If
' Read field MemoField
If IsNull(tbPrimeKey.Fields("MemoField")) Then
PrimeKey_MemoField = vbNullString
Else
PrimeKey_MemoField = tbPrimeKey.Fields("MemoField")
End If
' Read field Today
If IsNull(tbPrimeKey.Fields("Today")) Then
PrimeKey_Today = TimeValue("12:00:00")
Else
PrimeKey_Today = tbPrimeKey.Fields("Today")
End If
' Read field Flag1
If IsNull(tbPrimeKey.Fields("Flag1")) Then
PrimeKey_Flag1 = 0
Else
PrimeKey_Flag1 = tbPrimeKey.Fields("Flag1")
End If
' Read field Flag2
If IsNull(tbPrimeKey.Fields("Flag2")) Then
PrimeKey_Flag2 = 0
Else
PrimeKey_Flag2 = tbPrimeKey.Fields("Flag2")
End If
' Read field Money
If IsNull(tbPrimeKey.Fields("Money")) Then
PrimeKey_Money = 0
Else
PrimeKey_Money = tbPrimeKey.Fields("Money")
End If
End If
End Sub