'序列化类对象为二进制流
Public Function ObjectToBinary(ByVal KeyName As String, Obj As Object) As Byte()
    Dim Byt() As Byte
    Dim objBag As New PropertyBag
    If Obj Is Nothing Or Len(KeyName) = 0 Then Exit Function
    objBag.WriteProperty KeyName, Obj
    Byt = objBag.Contents
    ObjectToBinary = Byt
End Function

'从二进制流加载对象
Public Function BinaryToObject(ByVal KeyName As String, Byt() As Byte) As Object
    Dim oP As New PropertyBag
    If Len(KeyName) = 0 Then Exit Function
    oP.Contents = Byt
    Set BinaryToObject = oP.ReadProperty(KeyName)
End Function

'记录集对象序列化为二进制流
'传入的记录集游标需要为 CursorLocation = adUseClient 否则 rs.Save s, adPersistADTG 会报错
Public Function RecordsetToBinary(rs As ADODB.Recordset) As Byte()
    Dim s As New ADODB.Stream
    s.Open
    s.Type = adTypeBinary
    rs.Save s, adPersistADTG
    RecordsetToBinary = s.Read()
    Set s = Nothing
End Function

'二进制流转换为记录集
Public Function BinaryToRecordset(Byt() As Byte) As ADODB.Recordset
    Dim s As New ADODB.Stream
    Dim rs As New ADODB.Recordset
    s.Open
    s.Type = adTypeBinary
    s.Write Byt
    s.Position = 0
    rs.Open s
    Set BinaryToRecordset = rs
End Function