vbAccelerator - Contents of code file: cPropertyStorage.cls

This file is part of the download VB5 IMAPI Library Source, which is described in the article Image Mastering API (IMAPI) Library for VB.

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "cPropertyStorage"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As
 Any, lpvSource As Any, ByVal cbCopy As Long)
Private Declare Function CoTaskMemFree Lib "ole32" (ByVal lPtr As Long) As Long

Private m_props As IPropertyStorage
Private m_colProps As Collection

Friend Sub fInit(props As IPropertyStorage)
   
   Set m_colProps = New Collection
   
   Set m_props = props
   
   ' Nasty IPropertyStorage
   Dim hR As Long
   Dim fetched As Long
   Dim enumProps As IEnumSTATPROPSTG
   Dim propStg As STATPROPSTG
   Dim propSpecifier As PROPSPEC
   Dim sName As String
   Dim lSize As Long
   Dim Value As Variant
   Dim cProp As cProperty
   Dim lErr As Long
   
   Set enumProps = m_props.Enum
   enumProps.AddRef
   Do
      hR = enumProps.Next(1, propStg, fetched)
      If Not (FAILED(hR)) And (fetched > 0) Then
         
         ' Get the value of the property
         propSpecifier.ID_or_LPWSTR = propStg.propid
         propSpecifier.ulKind = PRSPEC_PROPID
         
         props.ReadMultiple 1, propSpecifier, Value
         Set cProp = New cProperty
         
         ' TODO Some variant types aren't supported by VB
         On Error Resume Next
         cProp.fInit propStg.propid, lpwstrPtrToString(propStg.lpwstrName),
          Value
         lErr = err.Number
         On Error GoTo 0
         If (lErr = 0) Then
            m_colProps.Add cProp
         End If
                  
         CoTaskMemFree propStg.lpwstrName
         
      End If
   Loop While Not (FAILED(hR)) And fetched > 0
   enumProps.Release
   CopyMemory enumProps, 0&, 4

End Sub

Friend Property Get PropertyStorage() As IPropertyStorage
   Set PropertyStorage = m_props
End Property

Friend Sub fUpdate()
Dim cProp As cProperty
Dim propSpecifier As PROPSPEC

   For Each cProp In m_colProps
      If (cProp.fDirty) Then
         propSpecifier.ID_or_LPWSTR = cProp.ID
         propSpecifier.ulKind = PRSPEC_PROPID
         m_props.WriteMultiple 1, propSpecifier, cProp.Value
      End If
   Next
   
End Sub

Public Property Get Count() As Long
   Count = m_colProps.Count
End Property

Public Property Get Property(ByVal nIndex As Long) As cProperty
   Set Property = m_colProps(nIndex)
End Property