Find Code:
All Words
Any of the Words
Exact Phrase
Home
:
Code
:
Forums
:
Submit
:
Mailing List
:
About
:
Contact
Code
All
VB.NET
ASP.NET
C#
VB Classic
ASP Classic
Snippets
Popular
Resources
Submit Code
Forums
Articles
Tips
Links
Books
Contest
Link to us
VLRecord - Variable Lookup Record Encapsulates a ...
Author:
Stephen Goguen
E-mail:
Click to e-mail author
Submitted:
9/15/2000
Version:
VB6
Compatibility:
VB6
Category:
Databases
Views:
9148
VLRecord - Variable Lookup Record Encapsulates a Collection to behave like a HashTable and Record. Great generic method of copying ADO/DAO records to other records which have similar structures, or anything else with a Name/Value pair. Very versatile and virtually bug free.
Declarations:
INSTRUCTIONS: * Insert this into a class file and copy code after WARNING to seperate module if needed * Use Tools > Procedure Attributes to make "Item" [Default] property
Code:
'FILE: VLRecord.cls 'Author: Stephen Goguen 'Email : gsteve@hotmail.com 'Instructions: Insert this into a class file 'CLASS: VLRecord 'DESCRIPTION: Provides the user with a simple Key->Value lookup interface, 'where the user can retrieve and set keys, but cannot enumerate keys or 'values like a hash table. 'EXAMPLE USE: 'Dim George As New Lookup 'Dim Dennis As New Lookup ' ' George("First Name") = "George" ' George("Last Name") = "Wilson" ' George("Age") = 45 ' George("Demeanor") = "Irate" ' Dennis("First Name") = "Dennis" ' Dennis("Last Name") = "The Meanace" ' Dennis("Age") = "Young" ' Set Dennis("Target") = George ' Debug.Print Dennis("Target")("First Name") 'Prints George ' Dennis.Remove "Target" ' George.RemoveAll 'NOTES: After reading Advanced Microsoft Visual Basic 5 on the MSDN CD's, 'I rethought using first class data types and using variants instead for 'a number of compelling reasons. ' 'IMPORTANT: Use 'Tools > Procedure Attributes' to define Item as [Default] 'method. Option Explicit Dim mKeyLookup As New Collection 'PROPERTY: Get Item 'DESCRIPTION: Retrieves a Variant VALUE given the KEY. If value exists 'for the key Null is returned... Public Property Get Item(ByVal Key As Variant) As Variant On Error Resume Next Key = CStr(Key) If IsObject(mKeyLookup(Key)) = True Then Set Item = mKeyLookup(Key) Else Item = mKeyLookup(Key) End If If IsEmpty(Item) = True Then Item = Null End If End Property 'PROPERTY: Let Item 'DESCRIPTION: Sets the value of a Key for a simple data type. Public Property Let Item(ByVal Key As Variant, ByVal Value As Variant) On Error Resume Next Key = CStr(Key) mKeyLookup.Add Value, Key If Err.Number <> 0 Then mKeyLookup.Remove Key mKeyLookup.Add Value, Key End If End Property 'PROPERTY: Set Item 'DESCRIPTION: Sets the value of a Key for object data types. Public Property Set Item(ByVal Key As Variant, ByVal Value As Variant) On Error Resume Next Key = CStr(Key) mKeyLookup.Add Value, Key If Err.Number <> 0 Then mKeyLookup.Remove Key mKeyLookup.Add Value, Key End If End Property 'FUNCTION: Remove 'DESCRIPTION: Removes a Key->Value pair Public Function Remove(ByVal Key As Variant) On Error Resume Next mKeyLookup.Remove Key End Function 'FUNCTION: ClearAll 'DESCRIPTION: Removes all Key->Value pairs Public Function RemoveAll() Set mKeyLookup = New Collection End Function !@#$%/ WARNING: Copy this to seperate module 'FUNCTION: ReadDAORecord 'DESCRIPTION: Reads from DAO type Recordset to VLRecord Public Function ReadDAORecord(DAORecordset As DAO.Recordset) As VLRecord Dim Field As DAO.Field Dim Record As New VLRecord For Each Field In DAORecordset.Fields Record(Field.Name) = Field.Value Next Set ReadDAORecord = Record End Function 'FUNCTION: WriteDAORecord 'DESCRIPTION: Writes record to DAO type recordset Public Function WriteDAORecord(DAORecordset As DAO.Recordset, Record As VLRecord) Dim Field As DAO.Field For Each Field In DAORecordset.Fields Field.Value = Record(Field.Name) Next End Function 'FUNCTION: ReadADORecord 'DESCRIPTION: Read Public Function ReadADORecord(ADORecordset As ADODB.Recordset) As VLRecord Dim Field As ADODB.Field Dim Record As New VLRecord For Each Field In ADORecordset.Fields Record(Field.Name) = Field.Value Next Set ReadDAORecord = Record End Function 'FUNCTION: WriteADORecord 'DESCRIPTION: Writes record to ADO type recordset Public Function WriteADORecord(ADORecordset As ADODB.Recordset, Record As VLRecord) Dim Field As ADODB.Field For Each Field In ADORecordset.Fields Field.Value = Record(Field.Name) Next End Function
Home
|
Forums
|
Submit
|
Books
|
Mailing List
|
Advertising
|
About
|
Contact
© 2024 A1VBCode. All rights reserved.
Legal disclaimer & terms of use
Privacy statement