在VB中将类对象序列化为字符串

    有时候，我们需要把一个类对象序列化成字符串保存起来，或者通过网络传输给另一台机器，然后再异步或异地克隆出原来的类对象，比如ACCESS没有服务器端，而我们加它加了一个服务器代理程序，代理程序负责把查询出来的记录集传输给客户端，这时，我们可以遍历记录集内容，生成一个字符串传输给客户端，然后在客户端再加载记录集内容。其实，利用VB内置的类对象PropertyBag，我们还可以直接序列化记录集对象，传输给客户端后，客户端直接复制出该对象就可行，比遍历记录集的效率提高了N倍。

    序列化的代码如下：

Option Explicit '* ************************************** * '* 模块名称：modStream.bas '* 模块功能：序列化类对象为字符串 '* 作者：lyserver '* ************************************** * '- ----------------------------------- ' 函数说明：将类对象序列化为字符串 '- ----------------------------------- Function ObjectSaveToString(objSource As Object, KeyName As String) As String Dim i As Long Dim objBag As New PropertyBag Dim bytData() As Byte On Error Resume Next If objSource Is Nothing Or Len(KeyName) = 0 Then Exit Function objBag.WriteProperty KeyName, objSource bytData = objBag.Contents For i = 0 To UBound(bytData) ObjectSaveToString = ObjectSaveToString & IIf(bytData(i) < 16, "0", "") & Hex(bytData(i)) Next End Function '- ----------------------------------- ' 函数说明：从字符串中加载类对象 '- ----------------------------------- Function ObjectLoadFromString(strSource As String, KeyName As String) As Object Dim i As Long, nLen As Long Dim objBag As New PropertyBag Dim bytData() As Byte On Error Resume Next nLen = Len(strSource) If nLen = 0 Or Len(KeyName) = 0 Then Exit Function ReDim bytData(nLen / 2 - 1) For i = 0 To UBound(bytData) bytData(i) = Val("&H" & Mid(strSource, i * 2 + 1, 2)) Next objBag.Contents = bytData Set ObjectLoadFromString = objBag.ReadProperty(KeyName) End Function

    测试代码如下：

'测试代码如下： Sub Main() Dim rstTemp As Object Dim strStream As String '创建一个临时ADO记录集对象 Set rstTemp = CreateObject("ADODB.Recordset") rstTemp.Fields.Append "姓名", adBSTR, 4 '设置临时记录集字段 rstTemp.Fields.Append "性别", adBSTR, 1 rstTemp.Open '打开记录集 rstTemp.AddNew Array("姓名", "性别"), Array("张三", "男") '添加记录 '将记录集对象序列化为字符串 strStream = ObjectSaveToString(rstTemp, "rstTemp") '关闭并销毁ADO记录集对象 rstTemp.Close Set rstTemp = Nothing '从字符串中加载记录集对象 Set rstTemp = ObjectLoadFromString(strStream, "rstTemp") Debug.Print rstTemp.Fields(0).Value '显示结果 '关闭并销毁ADO记录集对象 rstTemp.Close Set rstTemp = Nothing End Sub