Does anyone have an IPersistStream......

  • Thread starter Thread starter Robin Tucker
  • Start date Start date
R

Robin Tucker

Does anyone have a VB.NET IPersistStream COM interface description I can
cadge please? If I remember rightly, you have to "flatten" inherited COM
interfaces (I think IPersistStream derives from IPersist or something).

Thanks,




Robin
 
Robin Tucker said:
Does anyone have a VB.NET IPersistStream COM interface description I can
cadge please? If I remember rightly, you have to "flatten" inherited COM
interfaces (I think IPersistStream derives from IPersist or something).

Thanks,




Robin

HTH!

Namespace QCDemoServerVB

<ComImport(), Guid("0000010c-0000-0000-C000-000000000046"), _
InterfaceType(ComInterfaceType.InterfaceIsIUnknown)> _
Interface IPersist
Sub GetClassID(ByRef pClassId As Guid)
End Interface

<ComImport(), Guid("00000109-0000-0000-C000-000000000046"), _
InterfaceType(ComInterfaceType.InterfaceIsIUnknown)> _
Interface IPersistStream : Inherits IPersist
Shadows Sub GetClassID(ByRef pClassId As Guid)
<PreserveSig()> _
Function IsDirty() As Integer
Sub Load(ByVal pStm As UCOMIStream)
Sub Save(ByVal pStm As UCOMIStream, <MarshalAs(UnmanagedType.Bool)>
ByVal fClearDirty As Boolean)
Sub GetMaxSize(ByRef pCbSize As Long)
End Interface

<Serializable()> _
Public Class cMsg
Implements IPersistStream

Public mbRequiresSave As Boolean
Private strTimeEntry As String
'Private strMsg As String

Sub GetClassID1(ByRef pClassId As Guid) Implements
IPersist.GetClassID
pClassId =
Marshal.GenerateGuidForType(Type.GetType("QCDemoServer.cMsg"))
End Sub

Sub GetClassID(ByRef pClassId As Guid) Implements
IPersistStream.GetClassID
pClassId =
Marshal.GenerateGuidForType(Type.GetType("QCDemoServerVB.cMsg"))
End Sub

Function IsDirty() As Integer Implements IPersistStream.IsDirty
If mbRequiresSave Then
Return 0
Else
Return 1
End If
End Function

Sub Save(ByVal pStm As UCOMIStream, <MarshalAs(UnmanagedType.Bool)>
ByVal fClearDirty As Boolean) Implements IPersistStream.Save

WriteLog("QCDemoServerVB:Save")
If pStm Is Nothing Then
Exit Sub
Else
Dim bf As Binary.BinaryFormatter = New
Binary.BinaryFormatter
Dim ms As IO.MemoryStream = New IO.MemoryStream
bf.Serialize(ms, pStm)
End If
If fClearDirty Then
fClearDirty = False
Else
fClearDirty = True
End If

End Sub

Sub Load(ByVal pStm As UCOMIStream) Implements IPersistStream.Load

Try
WriteLog("QCDemoServerVB:Load")
Dim memStream As IO.MemoryStream = New IO.MemoryStream
Dim binForm As Binary.BinaryFormatter = New
Binary.BinaryFormatter

'Dim sta As STATSTG
'Dim arr() As Byte
'pStm.Stat(sta, 1)
'im cb As Long = CType(, Integer)
'Dim pcbRead As IntPtr
'pStm.Read(arr, sta.cbSize, pcbRead)
Dim sizearr() As Byte =
Convert.FromBase64String(strTimeEntry)
'Dim pCbSize As Long = sizearr.Length

Dim myutf As UTF8Encoding = New UTF8Encoding
strTimeEntry = myutf.GetString(sizearr)

Catch ex As Exception
Dim sb As New Text.StringBuilder
With sb
.Append("Display Message failed: ")
.Append(ex.Message)
End With
EventLog.WriteEntry("Display Message", sb.ToString,
EventLogEntryType.Error)

' then re-raise the error
Throw ex
End Try

End Sub

Sub GetMaxSize(ByRef pCbSize As Long) Implements
IPersistStream.GetMaxSize
WriteLog("QCDemoServerVB:GetMaxSize")
Dim sizearr() As Byte = Convert.FromBase64String(strTimeEntry)
pCbSize = sizearr.Length
End Sub

Public Property TimeEntry() As String
Get
Return strTimeEntry
End Get
Set(ByVal Value As String)
strTimeEntry = Value
End Set
End Property

'Public Property MessageBody() As String
'Get
' Return strMsg
'End Get
'Set(ByVal Value As String)
' strMsg = Value
'End Set
'End Property

Private Sub WriteLog(ByVal str As String)
Dim w As StreamWriter = File.AppendText("C:\QCIPersist.txt")
Log(str, w)
' Close the writer and underlying file.
w.Close()
End Sub

Private Sub Log(ByVal logMessage As String, ByVal w As TextWriter)
w.Write(ControlChars.CrLf & "Log Entry : ")
w.WriteLine("{0} {1}", DateTime.Now.ToLongTimeString(),
DateTime.Now.ToLongDateString())
w.WriteLine(" :")
w.WriteLine(" :{0}", logMessage)
w.WriteLine("-------------------------------")
' Update the underlying file.
w.Flush()
End Sub

End Class
End Namespace
 
Much appreciated, thanks.

3l33t said:
HTH!

Namespace QCDemoServerVB

<ComImport(), Guid("0000010c-0000-0000-C000-000000000046"), _
InterfaceType(ComInterfaceType.InterfaceIsIUnknown)> _
Interface IPersist
Sub GetClassID(ByRef pClassId As Guid)
End Interface

<ComImport(), Guid("00000109-0000-0000-C000-000000000046"), _
InterfaceType(ComInterfaceType.InterfaceIsIUnknown)> _
Interface IPersistStream : Inherits IPersist
Shadows Sub GetClassID(ByRef pClassId As Guid)
<PreserveSig()> _
Function IsDirty() As Integer
Sub Load(ByVal pStm As UCOMIStream)
Sub Save(ByVal pStm As UCOMIStream, <MarshalAs(UnmanagedType.Bool)>
ByVal fClearDirty As Boolean)
Sub GetMaxSize(ByRef pCbSize As Long)
End Interface

<Serializable()> _
Public Class cMsg
Implements IPersistStream

Public mbRequiresSave As Boolean
Private strTimeEntry As String
'Private strMsg As String

Sub GetClassID1(ByRef pClassId As Guid) Implements
IPersist.GetClassID
pClassId =
Marshal.GenerateGuidForType(Type.GetType("QCDemoServer.cMsg"))
End Sub

Sub GetClassID(ByRef pClassId As Guid) Implements
IPersistStream.GetClassID
pClassId =
Marshal.GenerateGuidForType(Type.GetType("QCDemoServerVB.cMsg"))
End Sub

Function IsDirty() As Integer Implements IPersistStream.IsDirty
If mbRequiresSave Then
Return 0
Else
Return 1
End If
End Function

Sub Save(ByVal pStm As UCOMIStream, <MarshalAs(UnmanagedType.Bool)>
ByVal fClearDirty As Boolean) Implements IPersistStream.Save

WriteLog("QCDemoServerVB:Save")
If pStm Is Nothing Then
Exit Sub
Else
Dim bf As Binary.BinaryFormatter = New
Binary.BinaryFormatter
Dim ms As IO.MemoryStream = New IO.MemoryStream
bf.Serialize(ms, pStm)
End If
If fClearDirty Then
fClearDirty = False
Else
fClearDirty = True
End If

End Sub

Sub Load(ByVal pStm As UCOMIStream) Implements IPersistStream.Load

Try
WriteLog("QCDemoServerVB:Load")
Dim memStream As IO.MemoryStream = New IO.MemoryStream
Dim binForm As Binary.BinaryFormatter = New
Binary.BinaryFormatter

'Dim sta As STATSTG
'Dim arr() As Byte
'pStm.Stat(sta, 1)
'im cb As Long = CType(, Integer)
'Dim pcbRead As IntPtr
'pStm.Read(arr, sta.cbSize, pcbRead)
Dim sizearr() As Byte =
Convert.FromBase64String(strTimeEntry)
'Dim pCbSize As Long = sizearr.Length

Dim myutf As UTF8Encoding = New UTF8Encoding
strTimeEntry = myutf.GetString(sizearr)

Catch ex As Exception
Dim sb As New Text.StringBuilder
With sb
.Append("Display Message failed: ")
.Append(ex.Message)
End With
EventLog.WriteEntry("Display Message", sb.ToString,
EventLogEntryType.Error)

' then re-raise the error
Throw ex
End Try

End Sub

Sub GetMaxSize(ByRef pCbSize As Long) Implements
IPersistStream.GetMaxSize
WriteLog("QCDemoServerVB:GetMaxSize")
Dim sizearr() As Byte = Convert.FromBase64String(strTimeEntry)
pCbSize = sizearr.Length
End Sub

Public Property TimeEntry() As String
Get
Return strTimeEntry
End Get
Set(ByVal Value As String)
strTimeEntry = Value
End Set
End Property

'Public Property MessageBody() As String
'Get
' Return strMsg
'End Get
'Set(ByVal Value As String)
' strMsg = Value
'End Set
'End Property

Private Sub WriteLog(ByVal str As String)
Dim w As StreamWriter = File.AppendText("C:\QCIPersist.txt")
Log(str, w)
' Close the writer and underlying file.
w.Close()
End Sub

Private Sub Log(ByVal logMessage As String, ByVal w As TextWriter)
w.Write(ControlChars.CrLf & "Log Entry : ")
w.WriteLine("{0} {1}", DateTime.Now.ToLongTimeString(),
DateTime.Now.ToLongDateString())
w.WriteLine(" :")
w.WriteLine(" :{0}", logMessage)
w.WriteLine("-------------------------------")
' Update the underlying file.
w.Flush()
End Sub

End Class
End Namespace
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Back
Top