VBA中的StringFromIID-有什么好辦法可以避免手動管理記憶體？

我想在VBA中呼叫這個函式：

HRESULT StringFromIID(
  REFIID rclsid。
  LPOLESTR *lplpsz
)。

...列印一個REFIID用于除錯。我已經翻譯成了VBA：

Private Declare PtrSafe Function StringFromIID Lib "ole32" （ByVal rclsid As LongPtr, ByVal lpsz As LongPtr) As Long

但是我不確定第二個引數應該傳遞什么，而且我還擔心如何釋放記憶體。

給定一個指向介面ID的指標，我怎樣才能以VBA的習慣方式獲得一個字串呢？

uj5u.com熱心網友回復：

這里有一個快速實作的幾個有用的函式。注意我使用的是StringFromCLSID，而不是StringFromIID，但你會明白這個意思：

Option Explicit>

Public Declare PtrSafe Function CLSIDFromString Lib "ole32. dll" (ByVal lpsz As LongPtr, ByRef pclsid As Any) As Long
Public Declare PtrSafe Function StringFromCLSID Lib "ole32. dll"（ByRef rclsid As Any, ByRef lplpsz As LongPtr) As Long
Public Declare PtrSafe Function ProgIDFromCLSID Lib "ole32. dll"（ByRef clsID As Any, ByRef lplpszProgID As LongPtr) As Long
Public Declare PtrSafe Function SysReAllocString Lib "oleaut32. dll" (ByVal pBSTR As LongPtr, Optional ByVal pszStrPtr As LongPtr) As Long
Public Declare PtrSafe Sub CoTaskMemFree Lib "ole32. dll" (Optional ByVal pv As LongPtr)

Public Type GUID
      Data1 As Long
      Data2 As Integer
      Data3 As Integer[/span
      Data4(0 To 7) 作為 Byte
End 型別

Public Function GetProgIDFromCLSIDString(ByVal clsidString As String) As String String
    Const S_OK As Long = 0
    Dim gID As GUID
    Dim resPtr As LongPtr
    '
    If CLSIDFromString(StrPtr(clsidString), gID) = S_OK Then
        If ProgIDFromCLSID(gID, resPtr) = S_OK 然后
            SysReAllocString VarPtr(GetProgIDFromCLSIDString), resPtr
            啟用CoTaskMemFree resPtr
        End If
    End If
End Function Function

Public Function GetStringFromCLSID(ByRef) keyword">ByRef clsID As GUID) As String
    Const S_OK As Long = 0
    Dim resPtr As LongPtr
    '
    If StringFromCLSID(clsID, resPtr) = S_OK Then
        SysReAllocString VarPtr(GetStringFromCLSID), resPtr
        啟用CoTaskMemFree resPtr
    End If
結束 函式

Public Function GetCLSIDFromString(ByVal clsID As String) As GUID
    Const S_OK As Long = 0
    Dim gID As GUID
    '
    If CLSIDFromString(StrPtr(clsID), gID) = S_OK Then
        GetCLSIDFromString = gID
    End If
End Function[/span

一個快速測驗：

Sub Test()
    Const clsID As String = "{00020400-0000-0000-C000-000000000046}"/span>
    Dim gID As GUID: gID = GetCLSIDFromString(clsID)
    Debug.Print GetStringFromCLSID(gID) '回傳原始clsID。
End Sub

如果你想在MAC上使用，那么請使用這個版本，它比上面的版本更完善一些：

如果你想在MAC上使用，那么請使用這個版本。

Option Explicit
Option Private Module
Option Compare Binary

#If Mac Then
#ElseIf VBA7 Then 
    Private Declare PtrSafe Function CLSIDFromString Lib "ole32. dll" (ByVal lpsz As LongPtr, ByRef pclsid As Any) As Long
    Private Declare PtrSafe Function ProgIDFromCLSID Lib "ole32。 dll"（ByRef clsID As Any, ByRef lplpszProgID As LongPtr) As Long
    Private Declare PtrSafe Function StringFromCLSID Lib "ole32. dll"（ByRef rclsid As Any, ByRef lplpsz As LongPtr) As Long
    Private Declare PtrSafe Function SysReAllocString Lib "oleaut32. dll" (ByVal pBSTR As LongPtr, Optional ByVal pszStrPtr As LongPtr) As Long
    Private Declare PtrSafe Sub CoTaskMemFree Lib "ole32. dll" (Optional ByVal pv As LongPtr)
#Else
    Private Declare Function CLSIDFromString Lib "ole32. dll" (ByVal lpsz As Long, ByRef pclsid As Any) As Long
    Private Declare Function ProgIDFromCLSID Lib "ole32. dll" (ByRef clsID As Any, ByRef lplpszProgIDAs Long) As Long)
    Private Declare Function StringFromCLSID Lib "ole32. dll" (ByRef rclsid As Any, ByRef lplpszAs Long) As Long Long
    Private Declare Function SysReAllocString Lib "oleaut32. dll" (ByVal pBSTR As Long, Optional ByVal pszStrPtr As Long) As Long Long
    Private Declare Sub CoTaskMemFree Lib "ole32. dll" (Optional ByVal pv As Long)
#End If

Public Type GUID
    data1 As Long
    data2 As Integer 
    data3 As Integer Integer
    data4(0 To 7) 作為 Byte
End 型別

Public Const S_OK As Long = 0

'OLE自動化協議GUIDs。
Public Const IID_IRecordInfo = "{0000002F-0000-0000-C000-000000000046}"/span>
Public Const IID_IDispatch = "{000020400-0000-C000-0000000046}"/span>
Public Const IID_ITypeComp = "{00020403-0000-0000-C000-0000000046}"/span>
Public Const IID_ITypeInfo = "{00020401-0000-0000-C000-0000000046}"/span>
Public Const IID_ITypeInfo2 = "{00020412-0000-0000-C000-0000000046}"/span>
Public Const IID_ITypeLib = "{00020402-0000-0000-C000-0000000046}"/span>
Public Const IID_ITypeLib2 = "{00020411-0000-0000-C000-0000000046}"/span>
Public Const IID_IUnknown = "{00000000-0000-C000-0000000046}"/span>
Public Const IID_IEnumVARIANT = "{00020404-0000-0000-C000-0000000046}"
Public Const IID_NULL = "{00000000-0000-0000-0000}"

'*******************************************************************************
'將一個字串轉換為一個GUID結構。
'注意'CLSIDFromString'贏取API的速度只是略快（<10%），相比之下'與純VB方法（僅用于MAc）相比，它的優點是
' 引起其他型別的錯誤（如類不在注冊表中）。
'*******************************************************************************
#If Mac Then
Public Function GUIDFromString(ByVal sGUID As String) As GUID
    Const methodName As String = "GuidFromString"
    Const hexPrefix As String = "&H" 
    Static模式 As String
    '
    If pattern = vbNullString Then pattern = Replace(IID_NULL, "0"/span>, "[0-9A-F]")
    如果 不是 sGUID Like pattern Then Err. Raise 5, methodName, "Invalid string"。
    '。
    Dim parts() As String: parts = Split(Mid$(sGUID, 2, Len(sGUID) - 2), "-")
    Dim我 As Long
    '
    With GUIDFromString
        .data1 = CLng（hexPrefix & parts(0)
        .data2 = CInt(hexPrefix & parts(1)
        .data3 = CInt(hexPrefix & parts(2)
        For I = 0 To 1
            . data4(I) = CByte(hexPrefix & Mid$(parts(3), I * 2   1, 2)
        Next I
        For I = 2  To 7
            . data4(I) = CByte(hexPrefix & Mid$(parts(4), (I - 1) * 2 - 1, 2)
        Next I
    結束 與
End Function[/span
#Else
'https://docs.microsoft.com/en-us/windows/win32/api/combaseapi/nf-combaseapi-clsidfromstring
Public Function GUIDFromString(ByVal sGUIDAs String) As GUID
    Const methodName As String = "GuidFromString"
    Dim hResult As Long: hResult = CLSIDFromString(StrPtr(sGUID), GUIDFromString)
    If hResult <> S_OK Then Err.Raise hResult, methodName, "無效字串"。
End Function
#End If

'*******************************************************************************
'將一個GUID結構轉換為一個字串。
'注意，這種方法比運行的組合要快4倍。
' 以下3個Windows APIs。StringFromCLSID、SysReAllocString、CoTaskMemFree。
'*******************************************************************************
Public Function GUIDToString(ByRef) keyword">ByRef gID As GUID) As String
    Dim parts(0 To 4) 作為 String
    '/span>
    With gID
        parts(0) = AlignHex(Hex$(.data1), 8)
        parts(1) = AlignHex(Hex$(.data2), 4)
        parts(2) = AlignHex(Hex$(.data3), 4)
        parts(3) = AlignHex(Hex$(.data4(0) * 256&/span>   . data4(1)), 4)
        parts(4) = AlignHex(Hex$(.data4(2) * 65536   . data4(3) * 256&   . data4(4) _
                          & Hex$(.data4(5) * 65536   . data4(6) * 256&   .data4(7) ), 12)
    結束 與
    GUIDToString = "{" & Join(parts, "-") & "｝"
結束 功能
Private Function AlignHex(ByRef h As String, ByVal charsCount As Long) As String As
    Const maxHex As String = "000000000000" '16 chars（LongLong max chars）
    If Len(h) < charsCount Then
        AlignHex = Right$(maxHex & h, charsCount)
    Else
        AlignHex = h
    End If
End Function[/span

'*******************************************************************************
'將一個CLSID字串轉換為一個progid字串。僅適用于Windows。
'如果不成功回傳一個空字串。
'*******************************************************************************
#If Mac Then
#Else
Public Function GetProgIDFromCLSID(ByRef) keyword">ByRef cID As GUID) As String
 #If VBA7 Then 
        Dim resPtr As LongPtr
 #Else
        Dim resPtr As Long
 #End If
    If ProgIDFromCLSID(cID, resPtr) = S_OK Then
        SysReAllocString VarPtr(GetProgIDFromCLSID), resPtr
        啟用 "任務記憶體釋放"(CoTaskMemFree) resPtr
    End If
End Function[/span
#End If>

標籤：

上一篇：SendInput()的問題

下一篇：如何在c#應用程式中使用win32獲得具有完整路徑的目錄和檔案串列