Hilfe... iShellExecuteHook COM Dll

Anfängerfragen zum Programmieren mit PureBasic.
Antworten
alex2pb
Beiträge: 3
Registriert: 03.10.2007 18:22
Kontaktdaten:
Kontaktdaten von alex2pb

Hilfe... iShellExecuteHook COM Dll

Beitrag von alex2pb »

Hi guys, Inf0Byt3 here.

I need to create a ShellExecute hook dll and I am stuck. This must be a COM Dll and Trond helped me so far, but as my COM knowledge is #Null, I can't get it to work. All this code must just show a messagebox with a filename when you execute something on your computer. Can anyone help me make this code work please? I need it for my malware scanner, as with a kernel driver it's way too hard to communicate.

The reason I posted here is that nobody could help me on the English Forum :(. Oh, and please excuse me I posted in english.

Thanks in advance.

Code: Alles auswählen

;===============
;By Trond
;===============

; Turn on unicode

; How to use:
;   1. Compile and put the dll in C:\ShellHook.dll
;   2. Register the dll with the supplied registry scripts
;-
;- ------- ShellExecuteHook -------

Prototype.l ProtoQueryInterface(*This, *Riid.GUID, *ppvObject.LONG)
Prototype.l ProtoAddRef(*This)
Prototype.l ProtoRelease(*This)
Prototype.l ProtoSIShellExecuteHook_Execute(*This, *info.SHELLEXECUTEINFO)

Structure SIShellExecuteHook
  QueryInterface.ProtoQueryInterface
  AddRef.ProtoAddRef
  Release.ProtoRelease
  Execute.ProtoSIShellExecuteHook_Execute
EndStructure

Structure TShellExecuteHook
  *VTable.SIShellExecuteHook
  RefCount.l
EndStructure

Global ObjectCount
Global LockCount

Procedure TShellExecuteHook_QueryInterface(*This.TShellExecuteHook, *Riid.GUID, *Object.LONG)
  If IsEqualGUID_(*Riid, ?GUID_IShellExecuteHook) Or IsEqualGUID_(*Riid, ?GUID_IUnknown)
    ; Correct GUID
    *Object\l = *This
    *This\VTable\AddRef(*This)
    ProcedureReturn #NOERROR
  Else
    ; Wrong GUID
    *Object\l = 0
    ProcedureReturn #E_NOINTERFACE
  EndIf
EndProcedure

Procedure TShellExecuteHook_AddRef(*This.TShellExecuteHook)
  *This\RefCount + 1
  ProcedureReturn *This\RefCount
EndProcedure

Procedure TShellExecuteHook_Release(*This.TShellExecuteHook)
  *This\RefCount - 1
  If *This\RefCount = 0
    FreeMemory(*This\VTable)
    FreeMemory(*This)
    ObjectCount - 1
  EndIf
  ProcedureReturn *This\RefCount
EndProcedure

Procedure TShellExecuteHook_Execute(*This.TShellExecuteHook, *info.SHELLEXECUTEINFO)
  MessageRequester("", PeekS(*info\lpFile))
  ProcedureReturn #S_FALSE
EndProcedure

Procedure New_TShellExecuteHook()
  Protected *Result.TShellExecuteHook
  *Result = AllocateMemory(SizeOf(TShellExecuteHook))
  *Result\VTable = AllocateMemory(SizeOf(SIShellExecuteHook))
  *Result\VTable\QueryInterface = @TShellExecuteHook_QueryInterface()
  *Result\VTable\AddRef = @TShellExecuteHook_AddRef()
  *Result\VTable\Release = @TShellExecuteHook_Release()
  *Result\VTable\Execute = @TShellExecuteHook_Execute()
  ProcedureReturn *Result
EndProcedure

;-
;- ------- ClassFactory -------

Prototype ProtoSIClassFactory_CreateInstance(*This, A, B, C)
Prototype ProtoSIClassFactory_LockServer(*This, Lock)

Structure SIClassFactory
  QueryInterface.ProtoQueryInterface
  AddRef.ProtoAddRef
  Release.ProtoRelease
  CreateInstance.ProtoSIClassFactory_CreateInstance
  LockServer.ProtoSIClassFactory_LockServer
EndStructure

Structure TClassFactory
  *VTable.SIClassFactory
EndStructure

Global ClassFactoryObject.TClassFactory
Global ClassFactoryObjectVTable.SIClassFactory

Procedure TClassFactory_QueryInterface(*This.TShellExecuteHook, *Riid.GUID, *Object.LONG)
  If IsEqualGUID_(*Riid, ?GUID_IClassFactory) Or IsEqualGUID_(*Riid, ?GUID_IUnknown)
    *Object\l = *This
    ProcedureReturn #NOERROR
  Else
    *Object\l = 0
    ProcedureReturn #E_NOINTERFACE
  EndIf
EndProcedure

Procedure TClassFactory_FixedReference()
  ProcedureReturn 1
EndProcedure

Procedure TClassFactory_CreateInstance(*This.TClassFactory, *Aggr, *GUID, *Object.Long)
  Protected *Hook.TShellExecuteHook
  Protected Result
  If *Aggr
    Result = #CLASS_E_NOAGGREGATION
  Else
    *Hook = New_TShellExecuteHook()
    *Hook\VTable\AddRef(*Hook)
    Result = *Hook\VTable\QueryInterface(*Hook, *GUID, *Object)
    *Hook\VTable\Release(*Hook)
    If Result = #NOERROR
      ObjectCount + 1
    EndIf
  EndIf
  ProcedureReturn Result
EndProcedure

Procedure TClassFactory_LockServer(*This, Lock)
  If Lock
    LockCount + 1
  Else
    LockCount - 1
  EndIf
  ProcedureReturn #NOERROR
EndProcedure

ProcedureDLL DllRegisterServer()
  ProcedureReturn #S_OK
EndProcedure

ProcedureDLL DllUnregisterServer()
  ProcedureReturn #S_OK
EndProcedure

ProcedureDLL AttachProcess(Instance)
  ClassFactoryObject\VTable = @ClassFactoryObjectVTable
  ClassFactoryObject\VTable\QueryInterface = @TClassFactory_QueryInterface()
  ClassFactoryObject\VTable\AddRef = @TClassFactory_FixedReference()
  ClassFactoryObject\VTable\Release = @TClassFactory_FixedReference()
  ClassFactoryObject\VTable\CreateInstance = @TClassFactory_CreateInstance()
  ClassFactoryObject\VTable\LockServer = @TClassFactory_LockServer()
EndProcedure

ProcedureDLL DllGetClassObject(*objid.GUID, *riid.GUID, *object.LONG)
  If IsEqualGUID_(*objid, ?GUID_IShellExecuteHook)
    *object\l = @ClassFactoryObject
    ProcedureReturn #S_OK
  EndIf
  *object\l = 0
  ProcedureReturn #CLASS_E_CLASSNOTAVAILABLE
EndProcedure

ProcedureDLL DllCanUnloadNow()
  If ObjectCount <= 0 And LockCount <= 0
    ProcedureReturn #S_OK
  Else
    ProcedureReturn #S_FALSE
  EndIf
EndProcedure

;-
;- Dll Server Registration


;-
;- ------- GUIDs -------

DataSection
  GUID_IUnknown:
  Data.l $00000000
  Data.w $0000, $0000
  Data.b $C0, $00, $00, $00, $00, $00, $00, $46
  GUID_IClassFactory:
  Data.l $00000001
  Data.w $0, $0
  Data.b $C0, $0, $0, $0, $0, $0, $0, $46
  GUID_IShellExecuteHook:
  Data.l $65A63651
  Data.w $8AFB, $4A2B
  Data.b $AC, $75, $CB, $4C, $68, $B0, $DD, $B0
EndDataSection
Register.REG

Code: Alles auswählen

Windows Registry Editor Version 5.00

[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\CLSID\{65A63651-8AFB-4A2B-AC75-CB4C68B0DDB0}]
@="TestHook"

[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\CLSID\{65A63651-8AFB-4A2B-AC75-CB4C68B0DDB0}\InprocServer32]
@="C:\\ShellHook.dll"
"ThreadingModel"="Apartment"

[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\ShellExecuteHooks]
"{65A63651-8AFB-4A2B-AC75-CB4C68B0DDB0}"="TestHook"

[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved]
"{65A63651-8AFB-4A2B-AC75-CB4C68B0DDB0}"="TestHook"
Unregister.REG

Code: Alles auswählen

Windows Registry Editor Version 5.00

[-HKEY_LOCAL_MACHINE\SOFTWARE\Classes\CLSID\{65A63651-8AFB-4A2B-AC75-CB4C68B0DDB0}]
@="TestHook"

[-HKEY_LOCAL_MACHINE\SOFTWARE\Classes\CLSID\{65A63651-8AFB-4A2B-AC75-CB4C68B0DDB0}\InprocServer32]
@="C:\\ShellHook.dll"
"ThreadingModel"="Apartment"

[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\ShellExecuteHooks]
"{65A63651-8AFB-4A2B-AC75-CB4C68B0DDB0}"=-

[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved]
"{65A63651-8AFB-4A2B-AC75-CB4C68B0DDB0}"=-
Thanks.
Inf0Byt3.
Nach oben
Benutzeravatar
mk-soft
Beiträge: 3855
Registriert: 24.11.2004 13:12
Wohnort: Germany

Beitrag von mk-soft »

I find any time a sample for your probleme, but i havn´t use this at time

Sample one

Code: Alles auswählen


Procedure Error(message$)
  wError = GetLastError_()
  If wError
    *ErrorBuffer = AllocateMemory(1024)
    FormatMessage_(#FORMAT_MESSAGE_FROM_SYSTEM, 0, wError, 0, *ErrorBuffer, 1024, 0)
    message$+Chr(10)+PeekS(*ErrorBuffer)
    FreeMemory(*ErrorBuffer)
  EndIf
  MessageRequester("Error", message$)
EndProcedure

; Structure SHITEMID
;   cb.w
;   abID.b[1]
; EndStructure

; Structure ITEMIDLIST
;   mkid.SHITEMID
; EndStructure

Structure ClassFactoryObject
  lpVtbl.l
  nRefCount.l
  nLockCount.l
EndStructure

Global m_pDataObj.IDataObject, cmd, hModule
Global i_Unk.IUnknown, i_SEI.IShellExtInit, i_QCM.IContextMenu
Global *p_Unk.ClassFactoryObject
Global File$

Procedure Ansi2Uni(*st, *Buffer, blen)
  If Len(PeekS(*st))<blen
    ProcedureReturn MultiByteToWideChar_(#CP_ACP, 0, *st, -1, *Buffer, blen)
  Else
    ProcedureReturn 0
  EndIf
EndProcedure

QueryInterface:
Procedure IUnknown_QueryInterface(*ti_unk.IUnknown, *riid.GUID, *ppvObject.LONG)
  If *ppvObject
    If CompareMemory(*riid, ?IID_IUnknown, SizeOf(GUID))
      MessageRequester("", "iunknown")
      *ppvObject\l = i_Unk
    ElseIf CompareMemory(*riid, ?IID_IShellExtInit, SizeOf(GUID))
      *ppvObject\l = i_SEI
    ElseIf CompareMemory(*riid, ?IID_IContextMenu, SizeOf(GUID))
      *ppvObject\l = i_QCM
    Else
      ProcedureReturn #E_NOINTERFACE
    EndIf
  Else
    ProcedureReturn #S_FALSE
  EndIf
  i_Unk\AddRef()
  ProcedureReturn #S_OK
EndProcedure

AddRef:
Procedure IUnknown_AddRef(*ti_unk.IUnknown):*p_Unk\nRefCount+1:ProcedureReturn *p_Unk\nRefCount:EndProcedure

Release:
Procedure IUnknown_Release(*ti_unk.IUnknown):*p_Unk\nRefCount-1:ProcedureReturn *p_Unk\nRefCount:EndProcedure

CreateInstance:
Procedure IClassFactory_CreateInstance(*ti_cf.IClassFactory, *pUnkOuter.IUnknown, *riid.GUID, *ppvObject)
  If *pUnkOuter
    ProcedureReturn #CLASS_E_NOAGGREGATION
  Else
    If i_SEI=#Null
      ProcedureReturn #E_OUTOFMEMORY
    Else
      hr = i_SEI\QueryInterface(*riid, *ppvObject)
    EndIf
  EndIf
  ProcedureReturn hr
EndProcedure

LockServer:
Procedure IClassFactory_LockServer(*ti_cf.IClassFactory, fLock)
  ProcedureReturn #E_FAIL
EndProcedure

; Structure FORMATETC
;   cfFormat.l
;   ptd.l
;   dwAspect.l
;   lindex.l
;   tymed.l
; EndStructure

#CF_HDROP = $0f
#DVASPECT_CONTENT = 1
#TYMED_HGLOBAL = 1
#TYMED_FILE = 2

; Structure STGMEDIUM
;   tymed.l
;   hGlobal.l
;   pUnkForRelease.l
; EndStructure

Initialize:
Procedure IShellExtInit_Initialize(*ti_sei.IShellExtInit, *pidlFolder.ITEMIDLIST, *pdtobj.IDataObject, hkeyProgID)
  If m_pDataObj
    m_pDataObj\Release()
  EndIf
  If *pdtobj
    m_pDataObj = *pdtobj
    *pdtobj\AddRef()
    fe.FORMATETC\cfFormat = #CF_HDROP
    fe\ptd = #Null
    fe\dwAspect = #DVASPECT_CONTENT
    fe\lindex = -1
    fe\tymed = #TYMED_HGLOBAL
    If *pdtobj\GetData(@fe, @medium.STGMEDIUM)=#S_OK
      uCount = DragQueryFile_(medium\hGlobal, -1, #Null, 0)
      If uCount=1
        *m_szFile = AllocateMemory(#MAX_PATH)
        DragQueryFile_(medium\hGlobal, 0, *m_szFile, #MAX_PATH)
        If Len(PeekS(*m_szFile))=0
          uCount = 0
        Else
          File$ = PeekS(*m_szFile)
        EndIf
        FreeMemory(*m_szFile)
      EndIf
      ReleaseStgMedium_(@medium)
      If uCount=1
        ProcedureReturn #S_OK
      EndIf
    EndIf
  EndIf
  ProcedureReturn #S_FALSE
EndProcedure

#MIIM_ID = 2
#MIIM_STRING = $40
#MF_STRING = 0
#MFT_STRING = #MF_STRING
#CMF_DEFAULTONLY = 1

QueryContextMenu:
Procedure IContextMenu_QueryContextMenu(*i_icm.IContextMenu, hmenu, indexMenu, idCmdFirst, idCmdLast, uFlags)
  If #CMF_DEFAULTONLY&uFlags:ProcedureReturn 0:EndIf
  cmd = indexMenu
  mii.MENUITEMINFO
  mii\cbSize = SizeOf(MENUITEMINFO)
  mii\fMask = #MIIM_STRING|#MIIM_ID
  mii\fType = #MFT_STRING
  mii\wID = idCmdFirst
  mii\dwTypeData = ?CommandString
  If InsertMenuItem_(hmenu, 0, #True, @mii)=#False
    ProcedureReturn 1<<31
  EndIf
  ProcedureReturn 1
EndProcedure

Enumeration
  #GCS_VERBA
  #GCS_HELPTEXTA
  #GCS_VALIDATEA
  #GCS_VERBW
  #GCS_HELPTEXTW
  #GCS_VALIDATEW
EndEnumeration
#GCS_UNICODE = 4
#GCS_VERB = #GCS_VERBA
#GCS_HELPTEXT = #GCS_HELPTEXTA
#GCS_VALIDATE = #GCS_VALIDATEA

GetCommandString:
Procedure IContextMenu_GetCommandString(*ti_icm.IContextMenu, idCmd, uFlags, pwReserved, pszName, cchMax)
  If idCmd=cmd
    Select uFlags
      Case #GCS_HELPTEXTA ; Sets pszName To an ANSI string containing the Help text For the command.
        CopyMemory(?CommandHelpLine, pszName, Len(PeekS(?CommandHelpLine)))
      Case #GCS_HELPTEXTW ; Sets pszName To a Unicode string containing the Help text For the command.
        If Ansi2Uni(?CommandHelpLine, pszName, cchMax)=0
          ProcedureReturn #S_FALSE
        EndIf
      Case #GCS_VALIDATEA ; Returns S_OK If the menu item exists, Or S_FALSE otherwise.
        ProcedureReturn #S_OK
      Case #GCS_VALIDATEW ; Returns S_OK If the menu item exists, Or S_FALSE otherwise.
        ProcedureReturn #S_OK
      Case #GCS_VERBA ; Sets pszName To an ANSI string containing the language-independent command name For the menu item.
        PokeS(pszName, PeekS(?CommandString))
      Case #GCS_VERBW ; Sets pszName To a Unicode string containing the language-independent command name For the menu item.
        If Ansi2Uni(?CommandString, pszName, cchMax)=0
          ProcedureReturn #S_FALSE
        EndIf
      Default
        ProcedureReturn #S_FALSE
    EndSelect
  Else
    ProcedureReturn #S_FALSE
  EndIf
  ProcedureReturn #S_OK
EndProcedure

Structure CMINVOKECOMMANDINFO
 cbSize.l
 fMask.l
 hwnd.l
 lpVerb.l
 lpParameters.l
 lpDirectory.l
 nShow.l
 dwHotKey.l
 hIcon.l
EndStructure

Structure CMINVOKECOMMANDINFOEX Extends CMINVOKECOMMANDINFO
 lpTitle.l
 lpVerbW.l
 lpParametersW.l
 lpDirectoryW.l
 lpTitleW.l
 ptInvoke.POINT
EndStructure

#SEE_MASK_UNICODE = $4000
#CMIC_MASK_UNICODE = #SEE_MASK_UNICODE

InvokeCommand:
Procedure IContextMenu_InvokeCommand(*ti_icm.IContextMenu, *pici.CMINVOKECOMMANDINFOEX)
  If *pici\cbSize=SizeOf(CMINVOKECOMMANDINFOEX)
    If *pici\fMask&#CMIC_MASK_UNICODE
      If (*pici\lpVerbW&$ffff)=cmd
        MessageRequester("Show file name", File$)
        ProcedureReturn #NOERROR
      EndIf
    EndIf
  ElseIf *pici\cbSize=SizeOf(CMINVOKECOMMANDINFO)
    If (*pici\lpVerb&$ffff)=cmd
      MessageRequester("Show file name", File$)
      ProcedureReturn #NOERROR
    EndIf
  Else
    ProcedureReturn #S_FALSE
  EndIf
EndProcedure

#SELFREG_E_FIRST = $80009E40
#SELFREG_E_CLASS = #SELFREG_E_FIRST+1

#GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS = 4

ProcedureDLL DllRegisterServer()
  InDLL:
  If RegCreateKeyEx_(#HKEY_CLASSES_ROOT, "*\shellex\ContextMenuHandlers\FastView.Image", 0, 0, #REG_OPTION_NON_VOLATILE, #KEY_ALL_ACCESS, #Null, @hKey1, 0)<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS:EndIf
  RegSetValueEx_(hKey1, "", 0, #REG_SZ, "{851aab5c-2008-4157-9c5d-a28dfa7b2660}", 38)
  If hKey1:RegCloseKey_(hKey1):hKey1 = 0:EndIf
  If RegCreateKeyEx_(#HKEY_CLASSES_ROOT, "FastView.Image\shellex\ContextMenuHandlers", 0, 0, #REG_OPTION_NON_VOLATILE, #KEY_ALL_ACCESS, #Null, @hKey1, 0)<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS:EndIf
  RegSetValueEx_(hKey1, "", 0, #REG_SZ, "{851aab5c-2008-4157-9c5d-a28dfa7b2660}", 38)
  If hKey1:RegCloseKey_(hKey1):hKey1 = 0:EndIf
  If RegCreateKeyEx_(#HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved", 0, 0, #REG_OPTION_NON_VOLATILE, #KEY_ALL_ACCESS, #Null, @hKey1, 0)<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS:EndIf
  RegSetValueEx_(hKey1, "{851aab5c-2008-4157-9c5d-a28dfa7b2660}", 0, #REG_SZ, "FastView.Image", 15)
  If hKey1:RegCloseKey_(hKey1):hKey1 = 0:EndIf
  *szBuffer = AllocateMemory(#MAX_PATH)
  If *szBuffer And GetModuleFileName_(?InDLL&$FFFF0000, *szBuffer, #MAX_PATH)
    If RegCreateKeyEx_(#HKEY_CLASSES_ROOT, "CLSID\{851aab5c-2008-4157-9c5d-a28dfa7b2660}", 0, 0, #REG_OPTION_NON_VOLATILE, #KEY_ALL_ACCESS, #Null, @hKey1, 0)<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS:EndIf
    RegSetValueEx_(hKey1, "", 0, #REG_SZ, "FastView.Image", 15)
    If hKey1:RegCloseKey_(hKey1):hKey1 = 0:EndIf
    If RegCreateKeyEx_(#HKEY_CLASSES_ROOT, "CLSID\{851aab5c-2008-4157-9c5d-a28dfa7b2660}\InProcServer32", 0, 0, #REG_OPTION_NON_VOLATILE, #KEY_ALL_ACCESS, #Null, @hKey1, 0)<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS:EndIf
    RegSetValueEx_(hKey1, "", 0, #REG_SZ, *szBuffer, Len(PeekS(*szBuffer))+1)
    RegSetValueEx_(hKey1, "ThreadingModel", 0, #REG_SZ, "Apartment", 10)
    If hKey1:RegCloseKey_(hKey1):hKey1 = 0:EndIf
  Else
    ProcedureReturn #SELFREG_E_CLASS
  EndIf
  FreeMemory(*szBuffer)
  ProcedureReturn #S_OK
EndProcedure

ProcedureDLL DllUnregisterServer()
  If RegDeleteKey_(#HKEY_CLASSES_ROOT, "*\shellex\ContextMenuHandlers\FastView.Image")<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS::EndIf
  If RegDeleteKey_(#HKEY_CLASSES_ROOT, "FastView.Image\shellex\ContextMenuHandlers")<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS::EndIf
  If RegDeleteKey_(#HKEY_CLASSES_ROOT, "FastView.Image\shellex")<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS::EndIf
  If RegDeleteKey_(#HKEY_CLASSES_ROOT, "FastView.Image")<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS::EndIf
  If RegOpenKeyEx_(#HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved", 0, #KEY_ALL_ACCESS, @hKey1)<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS:EndIf
  If RegDeleteValue_(hKey1, "{851aab5c-2008-4157-9c5d-a28dfa7b2660}")<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS::EndIf
  If hKey1:RegCloseKey_(hKey1):hKey1 = 0:EndIf
  If RegOpenKeyEx_(#HKEY_CLASSES_ROOT, "CLSID\{851aab5c-2008-4157-9c5d-a28dfa7b2660}", 0, #KEY_ALL_ACCESS, @hKey1)<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS:EndIf
  If RegDeleteKey_(hKey1, "InProcServer32")<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS::EndIf
  If hKey1:RegCloseKey_(hKey1):hKey1 = 0:EndIf
  If RegOpenKeyEx_(#HKEY_CLASSES_ROOT, "CLSID", 0, #KEY_ALL_ACCESS, @hKey1)<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS:EndIf
  If RegDeleteKey_(hKey1, "{851aab5c-2008-4157-9c5d-a28dfa7b2660}")<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS::EndIf
  If hKey1:RegCloseKey_(hKey1):hKey1 = 0:EndIf
  ProcedureReturn #S_OK
EndProcedure

ProcedureDLL AttachProcess(Instance)
  DisableThreadLibraryCalls_(Instance)
  hModule = Instance
  i_QCM = ?lpVT_IContextMenu
  i_SEI = ?lpVT_IShellExtInit
  i_Unk = ?lpVT_IUnknown
  *p_Unk = ?lpVT_IUnknown
  ProcedureReturn #True
EndProcedure

ProcedureDLL DllGetClassObject(*rclsid.GUID, *riid.GUID, *ppv.LONG)
  If *ppv
    If CompareMemory(*rclsid, ?CLSID_ContextMenuHandler, SizeOf(GUID))
      If CompareMemory(*riid, ?IID_IClassFactory, SizeOf(GUID))
        *ppv\l = ?lpVT_IClassFactory
      Else
        *ppv\l = 0
        ProcedureReturn #CLASS_E_CLASSNOTAVAILABLE
      EndIf
    Else
      *ppv\l = 0
      ProcedureReturn #CLASS_E_CLASSNOTAVAILABLE
    EndIf
  Else
    *ppv\l = 0
    ProcedureReturn #CLASS_E_CLASSNOTAVAILABLE
  EndIf
  ProcedureReturn #S_OK
EndProcedure

ProcedureDLL DllCanUnloadNow()
  If *p_Unk\nRefCount<=0 And *p_Unk\nLockCount<=0
    ProcedureReturn #S_OK
  Else
    ProcedureReturn #S_FALSE
  EndIf
EndProcedure

Procedure VTable() ; This is NOT a real procedure: PureBasic ignores ASM commands in the DataSection, so I had to put the vtable here
!section '.data' Data readable writeable
  lpVT_IUnknown:
  !dd l_vt_iunknown
  !dd 0 ; *p_Unk\nRefCount
  !dd 0 ; *p_Unk\nLockCount
  VT_IUnknown:
  !dd l_queryinterface+5
  !dd l_addref+2
  !dd l_release+2
  lpVT_IClassFactory:
  !dd l_vt_iclassfactory
  VT_IClassFactory:
  !dd l_queryinterface+5
  !dd l_addref+2
  !dd l_release+2
  !dd l_createinstance+5
  !dd l_lockserver+2
  lpVT_IShellExtInit:
  !dd l_vt_ishellextinit
  VT_IShellExtInit:
  !dd l_queryinterface+5
  !dd l_addref+2
  !dd l_release+2
  !dd l_initialize+5
  lpVT_IContextMenu:
  !dd l_vt_icontextmenu
  VT_IContextMenu:
  !dd l_queryinterface+5
  !dd l_addref+2
  !dd l_release+2
  !dd l_querycontextmenu+5
  !dd l_invokecommand+5
  !dd l_getcommandstring+5
EndProcedure

DataSection ;
CLSID_ContextMenuHandler: ; {851aab5c-2008-4157-9c5d-a28dfa7b2660}
Data.l $851aab5c
Data.w $2008, $4157
Data.b $9c, $5d, $a2, $8d, $fa, $7b, $26, $60
IID_IUnknown:
Data.l $00000000
Data.w $0000, $0000
Data.b $C0, $00, $00, $00, $00, $00, $00, $46
IID_IClassFactory:
Data.l $00000001
Data.w $0, $0
Data.b $C0, $0, $0, $0, $0, $0, $0, $46
IID_IShellExtInit:
Data.l $000214E8
Data.w 0, 0
Data.b $C0, 0, 0, 0, 0, 0, 0, $46
IID_IContextMenu:
Data.l $000214E4
Data.w 0, 0
Data.b $C0, 0, 0, 0, 0, 0, 0, $46
CommandString:
Data.s "Show file name"
CommandHelpLine:
Data.s "Shows the file name"
EndDataSection
Sample two

Code: Alles auswählen




Procedure Error(message$)
  wError = GetLastError_()
  If wError
    *ErrorBuffer = AllocateMemory(1024)
    FormatMessage_(#FORMAT_MESSAGE_FROM_SYSTEM, 0, wError, 0, *ErrorBuffer, 1024, 0)
    message$+Chr(10)+PeekS(*ErrorBuffer)
    FreeMemory(*ErrorBuffer)
  EndIf
  MessageRequester("Error", message$)
EndProcedure

Structure SHITEMID
  cb.w
  abID.b[1]
EndStructure

Structure ITEMIDLIST
  mkid.SHITEMID
EndStructure

Structure ClassFactoryObject
  lpVtbl.l
  nRefCount.l
EndStructure

Global m_pDataObj.IDataObject, cmd, hModule
Global i_Unk.IUnknown, i_SEI.IShellExtInit, i_QCM.IContextMenu, i_QCM2.IContextMenu2, i_QCM3.IContextMenu3
Global *p_Unk.ClassFactoryObject
Global File$, hImage, newImage, iWidth, iHeight, mDC, mObj

#MAX_WIDTH = 128
#MAX_HEIGHT = 64

Procedure Ansi2Uni(*st, *Buffer, blen)
  If Len(PeekS(*st))<=blen
    ProcedureReturn MultiByteToWideChar_(#CP_ACP, 0, *st, -1, *Buffer, blen)
  Else
    ProcedureReturn 0
  EndIf
EndProcedure

QueryInterface:
Procedure IUnknown_QueryInterface(*ti_unk.IUnknown, *riid.GUID, *ppvObject.LONG)
  If *ppvObject
    If CompareMemory(*riid, ?IID_IUnknown, SizeOf(GUID))
      MessageRequester("", "iunknown")
      *ppvObject\l = i_Unk
    ElseIf CompareMemory(*riid, ?IID_IShellExtInit, SizeOf(GUID))
      *ppvObject\l = i_SEI
    ElseIf CompareMemory(*riid, ?IID_IContextMenu, SizeOf(GUID))
      *ppvObject\l = i_QCM
    ElseIf CompareMemory(*riid, ?IID_IContextMenu2, SizeOf(GUID))
      *ppvObject\l = i_QCM2
    ElseIf CompareMemory(*riid, ?IID_IContextMenu3, SizeOf(GUID))
      *ppvObject\l = i_QCM3
    Else
      *ppvObject\l = 0
      ProcedureReturn #E_NOINTERFACE
    EndIf
  Else
    ProcedureReturn #S_FALSE
  EndIf
  i_Unk\AddRef()
  ProcedureReturn #S_OK
EndProcedure

AddRef:
Procedure IUnknown_AddRef(*ti_unk.IUnknown):*p_Unk\nRefCount+1:ProcedureReturn *p_Unk\nRefCount:EndProcedure

Release:
Procedure IUnknown_Release(*ti_unk.IUnknown):*p_Unk\nRefCount-1:ProcedureReturn *p_Unk\nRefCount:EndProcedure

CreateInstance:
Procedure IClassFactory_CreateInstance(*ti_cf.IClassFactory, *pUnkOuter.IUnknown, *riid.GUID, *ppvObject)
  If *pUnkOuter
    ProcedureReturn #CLASS_E_NOAGGREGATION
  Else
    If i_SEI=#Null
      ProcedureReturn #E_OUTOFMEMORY
    Else
      hr = i_SEI\QueryInterface(*riid, *ppvObject)
    EndIf
  EndIf
  ProcedureReturn hr
EndProcedure

LockServer:
Procedure IClassFactory_LockServer(*ti_cf.IClassFactory, fLock)
  ProcedureReturn #E_FAIL
EndProcedure

Structure FORMATETC
  cfFormat.l
  ptd.l
  dwAspect.l
  lindex.l
  tymed.l
EndStructure

#CF_HDROP = $0f
#DVASPECT_CONTENT = 1
#TYMED_HGLOBAL = 1
#TYMED_FILE = 2

Structure STGMEDIUM
  tymed.l
  hGlobal.l
  pUnkForRelease.l
EndStructure

Initialize:
Procedure IShellExtInit_Initialize(*ti_sei.IShellExtInit, *pidlFolder.ITEMIDLIST, *pdtobj.IDataObject, hkeyProgID)
  If m_pDataObj
    m_pDataObj\Release()
  EndIf
  If *pdtobj
    m_pDataObj = *pdtobj
    *pdtobj\AddRef()
    fe.FORMATETC\cfFormat = #CF_HDROP
    fe\ptd = #Null
    fe\dwAspect = #DVASPECT_CONTENT
    fe\lindex = -1
    fe\tymed = #TYMED_HGLOBAL
    If *pdtobj\GetData(@fe, @medium.STGMEDIUM)=#S_OK
      uCount = DragQueryFile_(medium\hGlobal, -1, #Null, 0)
      If uCount=1
        *m_szFile = AllocateMemory(#MAX_PATH)
        DragQueryFile_(medium\hGlobal, 0, *m_szFile, #MAX_PATH)
        If Len(PeekS(*m_szFile))=0
          uCount = 0
        Else
          File$ = PeekS(*m_szFile)
        EndIf
        FreeMemory(*m_szFile)
      EndIf
      ReleaseStgMedium_(@medium)
      If uCount=1
        If hImage
          If IsGadget(0)
            FreeGadget(0)
          EndIf
          If IsWindow(0)
            CloseWindow(0)
          EndIf
          FreeImage(0)
          hImage = 0
          If newImage
            FreeImage(1)
            newImage = 0
          EndIf
        EndIf
        hImage = LoadImage(0, File$)
        If hImage
          ProcedureReturn #S_OK
        EndIf
      EndIf
    EndIf
  EndIf
  ProcedureReturn #S_FALSE
EndProcedure

#MIIM_ID = 2
#MIIM_STRING = $40
#MF_STRING = 0
#MFT_STRING = #MF_STRING
#CMF_DEFAULTONLY = 1
#MIIM_TYPE = $10

QueryContextMenu:
Procedure IContextMenu_QueryContextMenu(*i_icm.IContextMenu, hmenu, indexMenu, idCmdFirst, idCmdLast, uFlags)
  If #CMF_DEFAULTONLY&uFlags:ProcedureReturn 0:EndIf
  If hImage
    cmd = indexMenu
    mii.MENUITEMINFO
    mii\cbSize = SizeOf(MENUITEMINFO)
    mii\fMask = #MIIM_TYPE|#MIIM_ID
    mii\fType = #MFT_OWNERDRAW
    mii\wID = idCmdFirst
    mii\dwTypeData = hImage
    If InsertMenuItem_(hmenu, 0, #True, @mii)=#False
      ProcedureReturn 1<<31
    EndIf
    ProcedureReturn 1
  EndIf
  ProcedureReturn 1<<31
EndProcedure

Enumeration
  #GCS_VERBA
  #GCS_HELPTEXTA
  #GCS_VALIDATEA
  #GCS_VERBW
  #GCS_HELPTEXTW
  #GCS_VALIDATEW
EndEnumeration
#GCS_UNICODE = 4
#GCS_VERB = #GCS_VERBA
#GCS_HELPTEXT = #GCS_HELPTEXTA
#GCS_VALIDATE = #GCS_VALIDATEA

GetCommandString:
Procedure IContextMenu_GetCommandString(*ti_icm.IContextMenu, idCmd, uFlags, pwReserved, pszName, cchMax)
  If idCmd=cmd
    Select uFlags
      Case #GCS_HELPTEXTA ; Sets pszName To an ANSI string containing the Help text For the command.
        CopyMemory(?CommandHelpLine, pszName, Len(PeekS(?CommandHelpLine)))
      Case #GCS_HELPTEXTW ; Sets pszName To a Unicode string containing the Help text For the command.
        If Ansi2Uni(?CommandHelpLine, pszName, Len(PeekS(?CommandHelpLine)))=0
          ProcedureReturn #S_FALSE
        EndIf
      Case #GCS_VALIDATEA ; Returns S_OK If the menu item exists, Or S_FALSE otherwise.
        ProcedureReturn #S_OK
      Case #GCS_VALIDATEW ; Returns S_OK If the menu item exists, Or S_FALSE otherwise.
        ProcedureReturn #S_OK
      Case #GCS_VERBA ; Sets pszName To an ANSI string containing the language-independent command name For the menu item.
        PokeS(pszName, PeekS(?CommandString))
      Case #GCS_VERBW ; Sets pszName To a Unicode string containing the language-independent command name For the menu item.
        If Ansi2Uni(?CommandString, pszName, cchMax)=0
          ProcedureReturn #S_FALSE
        EndIf
      Default
        ProcedureReturn #S_FALSE
    EndSelect
  Else
    ProcedureReturn #S_FALSE
  EndIf
  ProcedureReturn #S_OK
EndProcedure

Procedure WndProc(hWnd, uMsg, wParam, lParam)
  result = #PB_ProcessPureBasicEvents
  Select uMsg
    Case #WM_CLOSE
      FreeImage(0)
      hImage = 0
      FreeGadget(0)
      CloseWindow(0)
  EndSelect
  ProcedureReturn result
EndProcedure

Procedure ShowIt()
  If hImage
    UseImage(0)
    If OpenWindow(0, 0, 0, ImageWidth(), ImageHeight(), #PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_ScreenCentered, "FastView demo")
      If CreateGadgetList(WindowID())
        ImageGadget(0, 0, 0, ImageWidth(), ImageHeight(), hImage)
        newImage = 0
        FreeImage(1)
        SetWindowCallback(@WndProc())
      Else
        FreeImage(0)
        hImage = 0
        FreeImage(1)
        newImage = 0
        CloseWindow(0)
      EndIf
    EndIf
  EndIf
EndProcedure

Structure CMINVOKECOMMANDINFO
 cbSize.l
 fMask.l
 hwnd.l
 lpVerb.l
 lpParameters.l
 lpDirectory.l
 nShow.l
 dwHotKey.l
 hIcon.l
EndStructure

Structure CMINVOKECOMMANDINFOEX Extends CMINVOKECOMMANDINFO
 lpTitle.l
 lpVerbW.l
 lpParametersW.l
 lpDirectoryW.l
 lpTitleW.l
 ptInvoke.POINT
EndStructure

#SEE_MASK_UNICODE = $4000
#CMIC_MASK_UNICODE = #SEE_MASK_UNICODE

InvokeCommand:
Procedure IContextMenu_InvokeCommand(*ti_icm.IContextMenu, *pici.CMINVOKECOMMANDINFOEX)
  If *pici\cbSize=SizeOf(CMINVOKECOMMANDINFOEX)
    If *pici\fMask&#CMIC_MASK_UNICODE
      If (*pici\lpVerbW&$ffff)=cmd
        ShowIt()
        ProcedureReturn #NOERROR
      EndIf
    EndIf
  ElseIf *pici\cbSize=SizeOf(CMINVOKECOMMANDINFO)
    If (*pici\lpVerb&$ffff)=cmd
      ShowIt()
      ProcedureReturn #NOERROR
    EndIf
  Else
    ProcedureReturn #S_FALSE
  EndIf
EndProcedure

HandleMenuMsg:
Procedure IContextMenu2_HandleMenuMsg(*ti_icm2.IContextMenu2, uMsg, wParam, *lParam.MEASUREITEMSTRUCT)
  Select uMsg
    Case #WM_DRAWITEM
      *dis.DRAWITEMSTRUCT = *lParam
      left = ((*dis\rcItem\right-*dis\rcItem\left)/2)-(iWidth/2)
      top = ((*dis\rcItem\bottom-*dis\rcItem\top)/2)-(iHeight/2)
      If *dis\itemState&#ODS_SELECTED
        FillRect_(*dis\hDC, @*dis\rcItem, #COLOR_HIGHLIGHT+1)
        BitBlt_(*dis\hDC, left+*dis\rcItem\left, top+*dis\rcItem\top, iWidth, iHeight, mDC, 0, 0, #SRCCOPY)
        RasterOperation = #DSTINVERT
      Else
        FillRect_(*dis\hDC, @*dis\rcItem, #COLOR_MENU+1)
        RasterOperation = #SRCCOPY
      EndIf
      BitBlt_(*dis\hDC, left+*dis\rcItem\left, top+*dis\rcItem\top, iWidth, iHeight, mDC, 0, 0, RasterOperation)
    Case #WM_MEASUREITEM
      iWidth = ImageWidth()
      iHeight = ImageHeight()
      If iWidth>#MAX_WIDTH
        iHeight = (#MAX_WIDTH*iHeight)/iWidth
        iWidth = #MAX_WIDTH
      EndIf
      If iHeight>#MAX_HEIGHT
        iWidth = (#MAX_HEIGHT*iWidth/iHeight)
        iHeight = #MAX_HEIGHT
      EndIf
      *lParam\itemWidth = iWidth
      *lParam\itemHeight = iHeight
      CopyImage(0, 1)
      newImage = ResizeImage(1, iWidth, iHeight)
      mDC = CreateCompatibleDC_(GetDC_(GetDesktopWindow_()))
      mObj = SelectObject_(mDC, newImage)
  EndSelect
  ProcedureReturn #NOERROR
EndProcedure

HandleMenuMsg2:
Procedure IContextMenu3_HandleMenuMsg2(*ti_icm3.IContextMenu3, uMsg, wParam, lParam, *plResult.LONG)
  If *ti_icm3\HandleMenuMsg(uMsg, wParam, lParam)=#NOERROR
    *plResult\l = #True
    ProcedureReturn #NOERROR
  EndIf
  *plResult\l = #False
  ProcedureReturn #E_FAIL
EndProcedure

#SELFREG_E_FIRST = $80009E40
#SELFREG_E_CLASS = #SELFREG_E_FIRST+1

#GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS = 4

ProcedureDLL DllRegisterServer()
  InDLL:
  If RegCreateKeyEx_(#HKEY_CLASSES_ROOT, "*\shellex\ContextMenuHandlers\FastView.Image", 0, 0, #REG_OPTION_NON_VOLATILE, #KEY_ALL_ACCESS, #Null, @hKey1, 0)<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS:EndIf
  RegSetValueEx_(hKey1, "", 0, #REG_SZ, "{851aab5c-2008-4157-9c5d-a28dfa7b2660}", 38)
  If hKey1:RegCloseKey_(hKey1):hKey1 = 0:EndIf
  If RegCreateKeyEx_(#HKEY_CLASSES_ROOT, "FastView.Image\shellex\ContextMenuHandlers", 0, 0, #REG_OPTION_NON_VOLATILE, #KEY_ALL_ACCESS, #Null, @hKey1, 0)<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS:EndIf
  RegSetValueEx_(hKey1, "", 0, #REG_SZ, "{851aab5c-2008-4157-9c5d-a28dfa7b2660}", 38)
  If hKey1:RegCloseKey_(hKey1):hKey1 = 0:EndIf
  If RegCreateKeyEx_(#HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved", 0, 0, #REG_OPTION_NON_VOLATILE, #KEY_ALL_ACCESS, #Null, @hKey1, 0)<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS:EndIf
  RegSetValueEx_(hKey1, "{851aab5c-2008-4157-9c5d-a28dfa7b2660}", 0, #REG_SZ, "FastView.Image", 15)
  If hKey1:RegCloseKey_(hKey1):hKey1 = 0:EndIf
  *szBuffer = AllocateMemory(#MAX_PATH)
  If *szBuffer
    If ~GetModuleFileName_(?InDLL&$FFFF0000, *szBuffer, #MAX_PATH)
      GetModuleFileName_(hModule, *szBuffer, #MAX_PATH)
    EndIf
  EndIf
  If Len(PeekS(*szBuffer))
    If RegCreateKeyEx_(#HKEY_CLASSES_ROOT, "CLSID\{851aab5c-2008-4157-9c5d-a28dfa7b2660}", 0, 0, #REG_OPTION_NON_VOLATILE, #KEY_ALL_ACCESS, #Null, @hKey1, 0)<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS:EndIf
    RegSetValueEx_(hKey1, "", 0, #REG_SZ, "FastView.Image", 15)
    If hKey1:RegCloseKey_(hKey1):hKey1 = 0:EndIf
    If RegCreateKeyEx_(#HKEY_CLASSES_ROOT, "CLSID\{851aab5c-2008-4157-9c5d-a28dfa7b2660}\InProcServer32", 0, 0, #REG_OPTION_NON_VOLATILE, #KEY_ALL_ACCESS, #Null, @hKey1, 0)<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS:EndIf
    RegSetValueEx_(hKey1, "", 0, #REG_SZ, *szBuffer, Len(PeekS(*szBuffer))+1)
    RegSetValueEx_(hKey1, "ThreadingModel", 0, #REG_SZ, "Apartment", 10)
    If hKey1:RegCloseKey_(hKey1):hKey1 = 0:EndIf
  Else
    ProcedureReturn #SELFREG_E_CLASS
  EndIf
    If *szBuffer:FreeMemory(*szBuffer):EndIf
  ProcedureReturn #S_OK
EndProcedure

ProcedureDLL DllUnregisterServer()
  If RegDeleteKey_(#HKEY_CLASSES_ROOT, "*\shellex\ContextMenuHandlers\FastView.Image")<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS::EndIf
  If RegDeleteKey_(#HKEY_CLASSES_ROOT, "FastView.Image\shellex\ContextMenuHandlers")<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS::EndIf
  If RegDeleteKey_(#HKEY_CLASSES_ROOT, "FastView.Image\shellex")<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS::EndIf
  If RegDeleteKey_(#HKEY_CLASSES_ROOT, "FastView.Image")<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS::EndIf
  If RegOpenKeyEx_(#HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved", 0, #KEY_ALL_ACCESS, @hKey1)<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS:EndIf
  If RegDeleteValue_(hKey1, "{851aab5c-2008-4157-9c5d-a28dfa7b2660}")<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS::EndIf
  If hKey1:RegCloseKey_(hKey1):hKey1 = 0:EndIf
  If RegOpenKeyEx_(#HKEY_CLASSES_ROOT, "CLSID\{851aab5c-2008-4157-9c5d-a28dfa7b2660}", 0, #KEY_ALL_ACCESS, @hKey1)<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS:EndIf
  If RegDeleteKey_(hKey1, "InProcServer32")<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS::EndIf
  If hKey1:RegCloseKey_(hKey1):hKey1 = 0:EndIf
  If RegOpenKeyEx_(#HKEY_CLASSES_ROOT, "CLSID", 0, #KEY_ALL_ACCESS, @hKey1)<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS:EndIf
  If RegDeleteKey_(hKey1, "{851aab5c-2008-4157-9c5d-a28dfa7b2660}")<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS::EndIf
  If hKey1:RegCloseKey_(hKey1):hKey1 = 0:EndIf
  ProcedureReturn #S_OK
EndProcedure

ProcedureDLL AttachProcess(Instance)
  DisableThreadLibraryCalls_(Instance)
  hModule = Instance
  i_QCM = ?lpVT_IContextMenu
  i_QCM2 = ?lpVT_IContextMenu2
  i_QCM3 = ?lpVT_IContextMenu3
  i_SEI = ?lpVT_IShellExtInit
  i_Unk = ?lpVT_IUnknown
  *p_Unk = ?lpVT_IUnknown
  UseJPEGImageDecoder()
  UsePNGImageDecoder()
  UseTGAImageDecoder()
  UseTIFFImageDecoder()
;   UseEC_IFFImageDecoder()
;   UseEC_PBMImageDecoder()
;   UseEC_PGMImageDecoder()
;   UseEC_PPMImageDecoder()
;   UseEC_XPMImageDecoder()
;   UseEC_WBMPImageDecoder()
;   UseEC_XBMImageDecoder()
;   UseEC_OLEImageDecoder()
  ProcedureReturn #True
EndProcedure

ProcedureDLL DllGetClassObject(*rclsid.GUID, *riid.GUID, *ppv.LONG)
  If *ppv
    If CompareMemory(*rclsid, ?CLSID_ContextMenuHandler, SizeOf(GUID))
      If CompareMemory(*riid, ?IID_IClassFactory, SizeOf(GUID))
        *ppv\l = ?lpVT_IClassFactory
      Else
        *ppv\l = 0
        ProcedureReturn #CLASS_E_CLASSNOTAVAILABLE
      EndIf
    Else
      *ppv\l = 0
      ProcedureReturn #CLASS_E_CLASSNOTAVAILABLE
    EndIf
  Else
    *ppv\l = 0
    ProcedureReturn #CLASS_E_CLASSNOTAVAILABLE
  EndIf
  ProcedureReturn #S_OK
EndProcedure

ProcedureDLL DllCanUnloadNow()
  If *p_Unk\nRefCount<=0
    If mDC
      SelectObject_(mDC, mObj)
      DeleteDC_(mDC)
      mDC = 0
    EndIf
    ProcedureReturn #S_OK
  Else
    ProcedureReturn #S_FALSE
  EndIf
EndProcedure

Procedure VTable() ; This is NOT a real procedure: PureBasic ignores ASM commands in the DataSection, so I had to put the vtable here
!section '.data' Data readable writeable
  lpVT_IUnknown:
  !dd l_vt_iunknown
  !dd 0 ; *p_Unk\nRefCount
  !dd 0 ; *p_Unk\nLockCount
  VT_IUnknown:
  !dd l_queryinterface+5
  !dd l_addref+2
  !dd l_release+2
  lpVT_IClassFactory:
  !dd l_vt_iclassfactory
  VT_IClassFactory:
  !dd l_queryinterface+5
  !dd l_addref+2
  !dd l_release+2
  !dd l_createinstance+5
  !dd l_lockserver+2
  lpVT_IShellExtInit:
  !dd l_vt_ishellextinit
  VT_IShellExtInit:
  !dd l_queryinterface+5
  !dd l_addref+2
  !dd l_release+2
  !dd l_initialize+5
  lpVT_IContextMenu:
  lpVT_IContextMenu2:
  lpVT_IContextMenu3:
  !dd l_vt_icontextmenu
  VT_IContextMenu:
  VT_IContextMenu2:
  VT_IContextMenu3:
  !dd l_queryinterface+5
  !dd l_addref+2
  !dd l_release+2
  !dd l_querycontextmenu+5
  !dd l_invokecommand+5
  !dd l_getcommandstring+5
  !dd l_handlemenumsg+5
  !dd l_handlemenumsg2+5
EndProcedure

DataSection ;
CLSID_ContextMenuHandler: ; {851aab5c-2008-4157-9c5d-a28dfa7b2660}
Data.l $851aab5c
Data.w $2008, $4157
Data.b $9c, $5d, $a2, $8d, $fa, $7b, $26, $60
IID_IUnknown:
Data.l $00000000
Data.w $0000, $0000
Data.b $C0, $00, $00, $00, $00, $00, $00, $46
IID_IClassFactory:
Data.l $00000001
Data.w $0, $0
Data.b $C0, $0, $0, $0, $0, $0, $0, $46
IID_IShellExtInit:
Data.l $000214E8
Data.w 0, 0
Data.b $C0, 0, 0, 0, 0, 0, 0, $46
IID_IContextMenu:
Data.l $000214E4
Data.w 0, 0
Data.b $C0, 0, 0, 0, 0, 0, 0, $46
IID_IContextMenu2:
Data.l $000214F4
Data.w 0, 0
Data.b $C0, 0, 0, 0, 0, 0, 0, $46
IID_IContextMenu3:
Data.l $bcfce0a0
Data.w $ec17, $11d0
Data.b $8d, $10, 0, $a0, $c9, $0f, $27, $19
CommandString:
Data.s "Show image"
CommandHelpLine:
Data.s "Shows the image"
EndDataSection
For VTable use the new DataSection Syntax. It´s easy.

FF :wink:

P.S. Was fürn Englisch, Sorry
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Nach oben
alex2pb
Beiträge: 3
Registriert: 03.10.2007 18:22
Kontaktdaten:
Kontaktdaten von alex2pb

Beitrag von alex2pb »

Hi!

Danke, but I don't know COM programming :(. I have that samples here too but I don't understand how they actually work.
Inf0Byt3.
Nach oben
Benutzeravatar
mk-soft
Beiträge: 3855
Registriert: 24.11.2004 13:12
Wohnort: Germany

Beitrag von mk-soft »

the code not right. I testing the Object with CreateObject and the dll crashed by CoGetClassObject(...). Memory Invalid Access.

To learn COM-Objects at first step show Interfaces and use other object in PB.

Last step to learn programming self com-object. It´s not easy.
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Nach oben
alex2pb
Beiträge: 3
Registriert: 03.10.2007 18:22
Kontaktdaten:
Kontaktdaten von alex2pb

Beitrag von alex2pb »

Hi! I see what you mean. Thank you for all your time. I will keep searching until I will make this work. If I quit now all my work is useless.

Thanks again.
Inf0Byt3.
Nach oben
Antworten

Zurück zu „Anfänger“