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 data 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