ABでCOMのオブジェクトを作るのに使うCoCreateInstance関数は作成するクラスを決めるためにクラスIDを必要とします。
しかし,クラスの識別にはクラスIDだけではなく,プログラムIDなどもあります。
クラスIDはGUID型で数値の羅列ですが,プログラムIDはもう少し分かりやすく文字列になっています。
VBなどでCreateObjectを使ったことがあれば,まさにその引数がプログラムIDです。
そこでこれはプログラムIDからのオブジェクトの作成するための関数です。
またレジストリなどで見かける{xxxxxxxx-xxxx-xxxx-xxxx-xxxxxxxxxxxx}形式の文字列も受け付けるので,
いちいちGUID型の変数の初期化を書かずに済むという使い方もあります。
またプログラムIDなどからCLSIDを取り出す部分だけを抜き出してegtrGUIDFromStringという関数にまとめてあります。
どちらもどうやらBytePtr型とString型でのオーバーロードができないようなので,仕方なく関数名に接尾辞(サフィックス)を付けて対処しています。
例は次のCreateShortcutを見てください。
egtrGUIDFromString
コード: 全て選択
Function egtrGUIDFromString_PStr(pString As BytePtr, ByRef guid As GUID) As HRESULT
Function egtrGUIDFromString_Str(str As String, ByRef guid As GUID) As HRESULT
Function egtrGUIDFromString_PStrLen(pString As BytePtr, length As Long, ByRef guid As GUID) As HRESULT
Function egtrGUIDFromString_PWStr(pwString As *WCHAR, ByRef guid As GUID) As HRESULT
- pwString/pString/str 基となるプログラムID或いはGUIDの文字列を指定します。
- length pProgIDで指定された文字列の長さを指定します。ヌル終端文字列ならlengthの引数が無いオーバーロードを使用できるので,この引数は通常使わないでしょう。
- guid 結果を受け取るGUID型の変数を指定します。
コード: 全て選択
Function egtrCoCreateInstance_PStr(pProgID As BytePtr, ByRef iid As IID, ppv As *VoidPtr) As HRESULT
Function egtrCoCreateInstance_Str(strProgID As String, ByRef iid As IID, ppv As *VoidPtr) As HRESULT
Function egtrCoCreateInstance_PStrLen(pProgID As BytePtr, length As Long, ByRef iid As IID, ppv As *VoidPtr) As HRESULT
Function egtrCoCreateInstance_ProgID(pwProgID As *WCHAR, ByRef iid As IID, ppv As *VoidPtr) As HRESULT
Function egtrCoCreateInstance_ClsID(ByRef clsid As CLSID, ByRef iid As IID, ppv As *VoidPtr) As HRESULT
- pwProgID/pProgID/strProgID クラスのプログラムID或いはクラスIDの文字列を指定します。
- length pProgIDで指定された文字列の長さを指定します。ヌル終端文字列ならlengthの引数が無いオーバーロードを使用できるので,この引数は通常使わないでしょう。
- clsid クラスIDを指定します。egtrCoCreateInstance_ClsIDはCoCreateInstanceの引数が簡略化されたものとして使えます。
- iid 結果を受け取るインターフェイスのIDです。
- ppv 結果を受け取るため「インターフェイスへのポインタ」へのポインタを指定します。
[ここをクリックすると内容が表示されます]
2. CreateShortcutコード: 全て選択
TypeDef HRESULT = Long
TypeDef CLSID = GUID
TypeDef IID = GUID
Const FACILITY_WIN32 = 7
Const E_UNEXPECTED = &h8000FFFF As HRESULT
Declare Function CLSIDFromProgID Lib "OLE32" (pszProgID As *WCHAR, ByRef clsid As CLSID) As HRESULT
Declare Function CLSIDFromString Lib "OLE32" (String As *WCHAR, ByRef clsid As CLSID) As HRESULT
Function HRESULT_FROM_WIN32(x As DWord) As HRESULT
If (x As HRESULT) <= 0 Then
HRESULT_FROM_WIN32 = x As HRESULT
Else
HRESULT_FROM_WIN32 = (LOWORD(x) Or (FACILITY_WIN32 << 16) Or &h80000000) As HRESULT
End If
End Function
Function egtrGUIDFromString_PStr(pString As BytePtr, ByRef guid As GUID) As HRESULT
egtrGUIDFromString_PStr = egtrGUIDFromString_PStrLen(pString, lstrlen(pString), guid)
End Function
Function egtrGUIDFromString_Str(str As String, ByRef guid As GUID) As HRESULT
egtrGUIDFromString_PStr = egtrGUIDFromString_PStrLen(str, Len(str), guid)
End Function
Function egtrGUIDFromString_PStrLen(pString As BytePtr, length As Long, ByRef guid As GUID) As HRESULT
Dim sizeWChar As Long
sizeWChar = MultiByteToWideChar(CP_ACP, 0, pString, length, 0, 0)
If sizeWChar = 0 Then
egtrGUIDFromString_PStrLen = HRESULT_FROM_WIN32(GetLastError())
Exit Function
ElseIf sizeWChar < 0 Then
egtrGUIDFromString_PStrLen = E_UNEXPECTED
Exit Function
End If
Dim pwString As *WCHAR
sizeWChar++
pwString = malloc(sizeWChar * SizeOf (WCHAR))
If pwString = 0 Then
egtrGUIDFromString_PStrLen = E_OUTOFMEMORY
Exit Function
End If
sizeWChar = MultiByteToWideChar(CP_ACP, 0, pString, length + 1, pwString, sizeWChar)
If sizeWChar = 0 Then
egtrGUIDFromString_PStrLen = HRESULT_FROM_WIN32(GetLastError())
Exit Function
ElseIf sizeWChar < 0 Then
egtrGUIDFromString_PStrLen = E_UNEXPECTED
Exit Function
End If
egtrGUIDFromString_PStrLen = egtrGUIDFromString_PWStr(pwString, guid)
free(pwString)
End Function
Function egtrGUIDFromString_PWStr(pwString As *WCHAR, ByRef guid As GUID) As HRESULT
If pwString[0] = &h007b As WCHAR Then
' 1文字目が { ならクラスIDの文字列表現と見なしCLSIDFromStringで変換。
egtrGUIDFromString_PWStr = CLSIDFromString(pwString, guid)
Else
egtrGUIDFromString_PWStr = CLSIDFromProgID(pwString, guid)
End If
End Function
' ProgID或いはClassIDの文字列が入った文字列リテラルやBytePtr/Byte配列文字列からオブジェクトを作る。
Function egtrCoCreateInstance_PStr(pProgID As BytePtr, ByRef iid As IID, ppv As *VoidPtr) As HRESULT
egtrCoCreateInstance_PStr = egtrCoCreateInstance_PStrLen(pProgID, lstrlen(pProgID), iid, ppv)
End Function
' ProgID或いはClassIDの文字列が入ったString型文字列からオブジェクトを作る。
Function egtrCoCreateInstance_Str(strProgID As String, ByRef iid As IID, ppv As *VoidPtr) As HRESULT
egtrCoCreateInstance_Str = egtrCoCreateInstance_PStrLen(StrPtr(strProgID), Len(strProgID), iid, ppv)
End Function
' ProgID或いはClassIDの文字列が入ったBytePtrとその長さを元にワイド文字へ変換し,
' ワイド文字版のegtrCoCreateInstanceを呼んでオブジェクトを作る。
Function egtrCoCreateInstance_PStrLen(pProgID As BytePtr, length As Long, ByRef iid As IID, ppv As *VoidPtr) As HRESULT
Dim clsid As CLSID
egtrCoCreateInstance_PStrLen = egtrGUIDFromString_PStrLen(pProgID, length, clsid)
If egtrCoCreateInstance_PStrLen <> S_OK Then Exit Function
egtrCoCreateInstance_PStrLen = egtrCoCreateInstance_CLSID(clsid, iid, ppv)
End Function
' ProgID或いはClassIDの文字列が入ったWCHARへのポインタ/WCHARの配列の文字列からオブジェクトを作る。
Function egtrCoCreateInstance_ProgID(pwProgID As *WCHAR, ByRef iid As IID, ppv As *VoidPtr) As HRESULT
Dim clsid As CLSID
egtrCoCreateInstance_ProgID = egtrGUIDFromString_PWStr(pwProgID, clsid)
If egtrCoCreateInstance_ProgID <> S_OK Then Exit Function
egtrCoCreateInstance_ProgID = egtrCoCreateInstance_ClsID(clsid, iid, ppv)
End Function
' クラスIDからオブジェクトを作る。
Function egtrCoCreateInstance_ClsID(ByRef clsid As CLSID, ByRef iid As IID, ppv As *VoidPtr) As HRESULT
egtrCoCreateInstance_ClsID = CoCreateInstance(clsid, 0, CLSCTX_ALL, iid, ppv)
End Function
TypeDef PITEMIDLIST = VoidPtr
TypeDef PCITEMIDLIST = VoidPtr
Dim IID_IUnknown = [&h00000000, &h0000, &h0000, [&hc0, &h00, &h00, &h00, &h00, &h00, &h00, &h46]] As IID
' {00000000-0000-0000-C000-000000000046}
また,そのサンプルとしてショートカットを作る関数を作りました。
#サンプルのはずが結構長い分量になり,これ1つでネタにできるほどになってしまいました。
このプログラムではC:\にメモ帳へのショートカットを作っています。
使い方はShortcutInfoに情報を指定して,CreateShortcut関数を呼びます。
ShortcutInfo構造体ではショートカット先のパス以外を指定する場合,FlagsメンバをOrで指定してください。
実際に他のプログラムへ組み込んで使うには「CreateShortcutの本体」とこの後の「インターフェイスの宣言」,
「1. egtrCoCreateInstanceとegtrGUIDFromString」及び「3. GetErrorStr」のコードを適当なファイルに貼り付けてプロジェクトに参加させてください。
ウィンドウプログラムではCreateイベントでCoInitializeを,DestroyイベントでCoUninitializeを呼んでください。
そうでなければ,この例のようにプログラムの開始時と終了時に呼べばよいです。
ただし,CoInitializeとCoUninitializeはスレッド単位です。
メインスレッド以外でCOMを使う場合は,そのスレッド内でCoInitializeとCoUninitializeを呼ぶ必要があります。
コード: 全て選択
#strict
' ----------------------------------------------------------------
' ここからプログラムが実行されます。
Dim hr As HRESULT
hr = CoInitialize(0)
If hr <> S_OK Then
MessageBoxStr(0, GetErrorStr(hr As DWord), "初期化に失敗", MB_ICONERROR)
End
End If
Dim Buf[ELM(MAX_PATH)] As Byte
GetWindowsDirectory(Buf, MAX_PATH)
lstrcat(Buf, "\Notepad.exe")
Dim si As ShortcutInfo
si.pszPath = Buf
hr = CreateShortcut(si, "C:\メモ帳.lnk")
If hr <> S_OK Then
MessageBoxStr(0, GetErrorStr(hr As DWord), "ショートカット作成に失敗", MB_ICONERROR)
End If
CoUninitialize()
End
Function MessageBoxStr(hwnd As HWND, strText As String, pszCaption As BytePtr, uType As DWord) As Long
MessageBox(hwnd, StrPtr(strText), pszCaption, uType)
End Function
[ここをクリックすると内容が表示されます]
さらに例によってインターフェイスの宣言が必要です。
コード: 全て選択
Const SHORTCUT_DESCRITION = &h01
Const SHORTCUT_WORKINGDIR = &h02
Const SHORTCUT_ARGUMENTS = &h04
Const SHORTCUT_HOTKEY = &h08
Const SHORTCUT_SHOWCMD = &h10
Const SHORTCUT_ICON = &h20
Const SHORTCUT_ALL = &h3f
Type ShortcutInfo
Flags As DWord
pszPath As BytePtr ' ショートカットのリンク先
pszDescrition As BytePtr ' コメント
pszWorkingDirectory As BytePtr ' 作業フォルダ
pszArguments As BytePtr ' 引数(?)
wHotkey As Word ' ホットキー
iShowCmd As Long ' 実行時の大きさ(とショートカットのプロパティに書いてある)ShowWindowのフラグを使用
pszIconPath As BytePtr ' アイコンへのパス
iIcon As Long ' アイコンのインデックス(EXE/DLLなどを指定した場合)
End Type
Sub SetShellLinkFromShortcutInfo(psl As *IShellLink, ByRef si As ShortcutInfo)
With si
psl->SetPath(.pszPath)
If .Flags And SHORTCUT_DESCRITION Then psl->SetDescription(.pszDescrition)
If .Flags And SHORTCUT_WORKINGDIR Then psl->SetWorkingDirectory(.pszWorkingDirectory)
If .Flags And SHORTCUT_ARGUMENTS Then psl->SetArguments(.pszArguments)
If .Flags And SHORTCUT_HOTKEY Then psl->SetHotkey(.wHotkey)
If .Flags And SHORTCUT_SHOWCMD Then psl->SetShowCmd(.iShowCmd)
If .Flags And SHORTCUT_ICON Then psl->SetIconLocation(.pszIconPath, .iIcon)
End With
End Sub
Function CreateShortcut(ByRef si As ShortcutInfo, pszShortcutFile As BytePtr) As HRESULT
Dim hr As HRESULT
Dim pShellLink As *IShellLink
hr = egtrCoCreateInstance_PStr("lnkfile", IID_IShellLink, VarPtr(pShellLink) ' "lnkfile"がショートカットのプログラムID
If hr <> S_OK Then
CreateShortcut = hr
Exit Function
End If
SetShellLinkFromShortcutInfo(pShellLink, si)
Dim wszShortcutFile[MAX_PATH] As WCHAR
If MultiByteToWideChar(CP_ACP, 0, pszShortcutFile, -1, wszShortcutFile, MAX_PATH) = 0 Then
CreateShortcut = HRESULT_FROM_WIN32(GetLastError())
Exit Function
End If
Dim pPersistFile As *IPersistFile
hr = pShellLink->QueryInterface(VarPtr(IID_IPersistFile), VarPtr(pPersistFile))
pShellLink->Release()
If hr <> S_OK Then
CreateShortcut = hr
Exit Function
End If
hr = pPersistFile->Save(wszShortcutFile, TRUE)
pPersistFile->Release()
CreateShortcut = hr
End Function
[ここをクリックすると内容が表示されます]
3. GetErrorStrコード: 全て選択
Class IShellLinkA
Inherits IUnknown
Public
Virtual Function GetPath(
/* [size_is][out] */ pszFile As BytePtr,
/* [in] */ cch As Long,
/* [full][out][in] */ pfd As *WIN32_FIND_DATA,
/* [in] */ fFlags As DWord) As HRESULT
Virtual Function GetIDList(
/* [out] */ ppidl As *PITEMIDLIST) As HRESULT
Virtual Function SetIDList(
/* [in] */ pidl As PCITEMIDLIST) As HRESULT
Virtual Function GetDescription(
/* [size_is][out] */ pszName As BytePtr,
/* [in] */ cch As Long) As HRESULT
Virtual Function SetDescription(
/* [in] */ pszName As BytePtr) As HRESULT
Virtual Function GetWorkingDirectory(
/* [size_is][out] */ pszDir As BytePtr,
/* [in] */ cch As Long) As HRESULT
Virtual Function SetWorkingDirectory(
/* [in] */ pszDir As BytePtr) As HRESULT
Virtual Function GetArguments(
/* [size_is][out] */ pszArgs As BytePtr,
/* [in] */ cch As Long) As HRESULT
Virtual Function SetArguments(
/* [in] */ pszArgs As BytePtr) As HRESULT
Virtual Function GetHotkey(
/* [out] */ ByRef wHotkey As Word) As HRESULT
Virtual Function SetHotkey(
/* [in] */ wHotkey As Word) As HRESULT
Virtual Function GetShowCmd(
/* [out] */ ByRef piShowCmd As Long) As HRESULT
Virtual Function SetShowCmd(
/* [in] */ iShowCmd As Long) As HRESULT
Virtual Function GetIconLocation(
/* [size_is][out] */ pszIconPath As BytePtr,
/* [in] */ cch As Long,
/* [out] */ ByRef iIcon As Long) As HRESULT
Virtual Function SetIconLocation(
/* [in] */ pszIconPath As BytePtr,
/* [in] */ iIcon As Long) As HRESULT
Virtual Function SetRelativePath(
/* [in] */ pszPathRel As BytePtr,
/* [in] */ dwReserved As DWord) As HRESULT
Virtual Function Resolve(
/* [in] */ hwnd As HWND,
/* [in] */ fFlags As DWord) As HRESULT
Virtual Function SetPath(
/* [in] */ pszFile As BytePtr) As HRESULT
End Class
Class IPersist
Inherits IUnknown
Public
Virtual Function GetClassID(
/* [out] */ ByRef ClassID As CLSID) As HRESULT
End Class
Class IPersistFile
Inherits IPersist
Public
Virtual Function IsDirty() As HRESULT
Virtual Function Load(
/* [in] */ pszFileName As *WCHAR,
/* [in] */ dwMode As DWord) As HRESULT
Virtual Function Save(
/* [unique][in] */ pszFileName As *WCHAR,
/* [in] */ fRemember As Long) As HRESULT
Virtual Function SaveCompleted(
/* [unique][in] */ pszFileName As *WCHAR) As HRESULT
Virtual Function GetCurFile(
/* [out] */ ByRef pszFileName As *WCHAR) As HRESULT
End Class
TypeDef IShellLink = IShellLinkA
これはGetLastErrorやHRESULTの値からFormatMessageを使用してString型の文字列に変換します。
FormatMessageは,ヘルプで引いても何も書いてありませんが,実はHRESULTの値にも有効です。
逆にGetLastError()のエラー番号からHRESULT_FROM_WIN32(1. egtrCoCreateInstanceとegtrGUIDFromStringのコード内にあります)
を使えばHRESULTへ変換できるということのも覚えておいて損ではありません。
[ここをクリックすると内容が表示されます]
コード: 全て選択
Const LANG_USER_DEFAULT = MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT)
Function GetErrorStr(dwMessageId As DWord) As String
Dim pszMsg As BytePtr
FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER Or FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS, _
NULL, _
dwMessageId, _
LANG_USER_DEFAULT, _
VarPtr(pszMsg), _
0, _
NULL)
If Not pszMsg = NULL Then
GetErrorStr = pszMsg
LocalFree(pszMsg)
End If
End Function