Option Explicit
Option Compare Text
Public MyDepartment As String
Public MyEmployees As ADODB.Recordset
Dim objBag As New PropertyBag
Private Sub Class_InitProperties()
Set MyEmployees = New ADODB.Recordset
MyEmployees.Fields.Append "EmpName", adVarChar, 30
MyEmployees.Fields.Append "EmpSal", adCurrency
MyEmployees.Open
End Sub
Public Sub SaveMyProperties()
Dim intFile%, bytRec() As Byte
objBag.WriteProperty "MyDepartment", MyDepartment
objBag.WriteProperty "MyEmployees", MyEmployees
Save this a in a file for later retrieval
intFile = FreeFile
If Dir("C:\MyData.txt", vbNormal) = "" Then
Else
Kill "C:\MyData.txt"
End If
Open "C:\MyData.txt" For Binary Access Write As #intFile
bytRec = objBag.Contents
Put #intFile, , bytRec
Close #intFile
End Sub
Public Sub RestoreMyProperties()
Dim intFile%, bytRec() As Byte
Read the saved data from the file.
ReDim bytRec(FileLen("C:\MyData.txt"))
intFile = FreeFile
Open "C:\MyData.txt" For Binary Access Read As #intFile
Get #intFile, , bytRec
objBag.Contents = bytRec
Close #intFile
PropertBag restored. Lets restore the properties now.
MyDepartment = objBag.ReadProperty("MyDepartment")
Set MyEmployees = objBag.ReadProperty("MyEmployees")
End Sub
在客户应用中保存属性
Private Sub Command1_Click()
Dim objDept As New MyComp.clsMyDept
objDept.MyDepartment = "Research"
Add one employee
objDept.MyEmployees.AddNew
objDept.MyEmployees!EmpName = "Harry"
objDept.MyEmployees!EmpSal = 2500
objDept.MyEmployees.Update
Add second employee
objDept.MyEmployees.AddNew
objDept.MyEmployees!EmpName = "Potter"
objDept.MyEmployees!EmpSal = 3000
objDept.MyEmployees.Update
Save the properties by calling the method from our component
objDept.SaveMyProperties
Set objDept = Nothing
End Sub
取回保存的属性
Private Sub Command2_Click()
Dim objDept As New MyComp.clsMyDept
Restore properties by calling the method from our component
objDept.RestoreMyProperties
Lets see what is restored
Debug.Print objDept.MyDepartment Will print Research
objDept.MyEmployees.MoveFirst
Debug.Print "" & objDept.MyEmployees!EmpName Will print Harry
objDept.MyEmployees.MoveNext
Debug.Print "" & objDept.MyEmployees!EmpName Will print Potter
Set objDept = Nothing
End Sub