VB Forum / COM / December 2007

No, the Type in LightWeight-COM-Objects is only
needed to store a *pointer* to the VTable (together
with Private Var-stuff), not the VTable-Entries itself

Finally time to get "The Curland-Book" I'd say. ;-)

Here's an example, wich is based on code of Eduardo Morcillo
(just google for his website) and wich also depends on his
great OleLib.tlb (wich BTW also contains the IStream-Interface).

The Code demonstrates, what is basically going on under
the hood of VBs PropertyBag - and it shows you how to
use the OleLib-defined Types (e.g. IStream).

'***Into a form
Option Explicit

Private Sub Form_Load()
Dim B() As Byte
 'let's serialize a Test-(Std-)Picture (loaded from disk)
 B = WriteObject(LoadPicture("c:\sometest.bmp"))
 Debug.Print "Obj serialized into: " & UBound(B) + 1 & " Bytes."

 'now the opposite direction
 Set Me.Picture = ReadObject(B)
End Sub

Public Function WriteObject(ByVal Obj As Object) As Byte()
Dim CLSID As UUID, oPSI As IPersistStreamInit, oPS As IPersistStream
Dim oStrm As olelib.IStream, Stat As STATSTG, B() As Byte, Bytes&
 If Obj Is Nothing Then
   WriteClassStm oStrm, CLSID ' Write the empty CLSID
 Else
   On Error Resume Next
   Set oStrm = CreateStreamOnHGlobal(0, True)
   If Err Then
     On Error GoTo 0
     Err.Raise vbObjectError, , "Cannot create Stream-Object"
   End If
   Set oPS = Obj 'Query for IPersistStream
   If Err.Number = 0 Then
     oPS.GetClassID CLSID
     WriteClassStm oStrm, CLSID
     oPS.Save oStrm, 0
   Else
     Err.Clear
     Set oPSI = Obj 'Query for IPersistStreamInit
     If Err.Number = 0 Then
       oPSI.GetClassID CLSID
       WriteClassStm oStrm, CLSID
       oPSI.Save oStrm, 0
     Else
       On Error GoTo 0
       Err.Raise 5, , "Oject class isn't persistable: " & TypeName(Obj)
     End If
   End If
 End If

 If Err Then
   On Error GoTo 0
   Err.Raise vbObjectError Or 1, , "The object can't be saved."
 Else
   oStrm.Stat Stat
   Bytes = Stat.cbSize * 10000
   If Bytes > 0 Then
     ReDim B(0 To Bytes - 1)
     oStrm.Seek 0, 0
     oStrm.Read B(0), Bytes
     WriteObject = B
   End If
 End If
End Function

Public Function ReadObject(B() As Byte) As Object
Dim CLSID As UUID, IID_Null As UUID, IID_IUnknown As UUID
Dim oPSI As IPersistStreamInit, oPS As IPersistStream, lRes As Long
Dim Bytes&, IU As olelib.IUnknown, oStrm As olelib.IStream
 On Error Resume Next
 Bytes = UBound(B) - LBound(B) + 1
 If Bytes = 0 Then Err.Clear: Exit Function

 Set oStrm = CreateStreamOnHGlobal(0, True)
 If Err Then
   On Error GoTo 0
   Err.Raise vbObjectError, , "Cannot create Stream-Object"
 End If
 oStrm.Write B(LBound(B)), Bytes
 oStrm.Seek 0, 0
 ReadClassStm oStrm, CLSID ' Read the CLSID

 If IsEqualGUID(CLSID, IID_Null) Then Exit Function

 IID_IUnknown.Data4(0) = &HC0: IID_IUnknown.Data4(7) = &H46 'init
 lRes = CoCreateInstance(CLSID, Nothing, CLSCTX_INPROC_HANDLER Or _
 CLSCTX_INPROC_SERVER Or CLSCTX_LOCAL_SERVER Or CLSCTX_REMOTE_SERVER, _
 IID_IUnknown, IU)

 If lRes = S_OK Then
   Set oPS = IU ' Query for IPersistStream
   If Err.Number = 0 Then
     oPS.Load oStrm
   Else
     Err.Clear
     Set oPSI = IU ' Query for IPersistStreamInit
     If Err.Number = 0 Then
       oPSI.Load oStrm 'Load the object data
     End If
   End If
   Set ReadObject = IU
 Else
   Err.Raise 429
 End If
End Function

Olaf