COM Api'leri

[FONT=Arial]Option Explicit 

'CLSID/GUID structure'ı 
'==================== 

Private Type GUID 
Data1 As Long 
Data2 As Integer 
Data3 As Integer 
Data4(7) As Byte 
End Type 

'API Tanımlamaları: 
'================= 

Private Declare Function CLSIDFromProgID _ 
Lib "ole32.dll" (ByVal lpszProgID As Long, _ 
pCLSID As GUID) As Long 

Private Declare Function ProgIDFromCLSID _ 
Lib "ole32.dll" (pCLSID As GUID, lpszProgID As Long) As Long 

Private Declare Function StringFromCLSID _ 
Lib "ole32.dll" (pCLSID As GUID, lpszProgID As Long) As Long 

Private Declare Function CLSIDFromString _ 
Lib "ole32.dll" (ByVal lpszProgID As Long, _ 
pCLSID As GUID) As Long 

Private Declare Sub CopyMemory Lib "kernel32" Alias _ 
"RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long) 

Private Sub Command1_Click() 
Dim strProgID As String * 255 
Dim pProgID As Long 
Dim udtCLSID As GUID 
Dim strCLSID As String * 255 
Dim pCLSID As Long 
Dim lngRet As Long 
Dim strTemp As String 
Dim i As Integer 

'Bir ProgID al. 
strTemp = Text1.Text 

'CLSID'yi bul. 
lngRet = CLSIDFromProgID(StrPtr(strTemp), udtCLSID) 

'CLSID elemanlarını göster. 
With List1 
.AddItem Hex(udtCLSID.Data1) 
.AddItem Hex(udtCLSID.Data2) 
.AddItem Hex(udtCLSID.Data3) 
For i = 0 To 7 
.AddItem Hex(udtCLSID.Data4(i)) 
Next 
End With 

'CLSID'yi texte çevir ve pointer'ı geri döndür. 
lngRet = StringFromCLSID(udtCLSID, pCLSID) 

'CLSID'yi string olarak bul ve görüntüle. 
StringFromPointer pCLSID, strCLSID 
Text2.Text = strCLSID 

'CLSID'yi kontrol et. 
With udtCLSID 
.Data1 = 0 
.Data2 = 0 
.Data3 = 0 
For i = 0 To 7 
.Data4(i) = 0 
Next 
End With 

'Texti tekrar CLSID'ye dönüştür. 
strTemp = Text2.Text 
lngRet = CLSIDFromString(StrPtr(strTemp), udtCLSID) 

'ProgID texti için bir pointer bul. Bu bir Unicode texttir. 
lngRet = ProgIDFromCLSID(udtCLSID, pProgID) 

'ProgID'yi bul ve göster. 
StringFromPointer pProgID, strProgID 
Text3.Text = strProgID 

End Sub 

'Bu fonksiyon Unicode string'i gösteren bir pointerve bir string buffer alarak 
'byte'ları VB'nin string buffer'ı içine atar. 

Private Sub StringFromPointer(pOLESTR As Long, strOut As String) 
Dim ByteArray(255) As Byte 
Dim intTemp As Integer 
Dim intCount As Integer 
Dim i As Integer 

intTemp = 1 

'String'ler üzerinde gezerek her WORD'ün ilk byte'ını bulur. 
While intTemp <> 0 
CopyMemory intTemp, ByVal pOLESTR + i, 2 
ByteArray(intCount) = intTemp 
intCount = intCount + 1 
i = i + 2 
Wend 

'Byte dizinini bizim string'e kopyalar. 
CopyMemory ByVal strOut, ByteArray(0), intCount 
End Sub 

Private Sub Form_Load() 
Text1.Text = "Project1.Class1" 
End Sub [/FONT]