Context Menu Item Shell Extension example (Windows)

Share your advanced PureBasic knowledge/code with the community.
Post Reply
User avatar
kenmo
Addict
Addict
Posts: 2033
Joined: Tue Dec 23, 2003 3:54 am

Post by kenmo »

Bump!

Like troy asked, could someone update this for PB4? I tried, but I don't really know what I'm doing with a lot of the assembler sections...
Top
Trond
Always Here
Always Here
Posts: 7446
Joined: Mon Sep 22, 2003 6:45 pm
Location: Norway

Post by Trond »

Updated for PB 4:

Code: Select all

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 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 

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 

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

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

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 

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

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

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 

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 

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 

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 

DataSection 
  lpVT_IUnknown: 
    Data.l ?VT_IUnknown, 0, 0 
  VT_IUnknown: 
    Data.l @IUnknown_QueryInterface(), @IUnknown_AddRef(), @IUnknown_Release() 
  lpVT_IClassFactory: 
    Data.l ?VT_IClassFactory 
  VT_IClassFactory: 
    Data.l @IUnknown_QueryInterface(), @IUnknown_AddRef(), @IUnknown_Release() 
    Data.l @IClassFactory_CreateInstance(), @IClassFactory_LockServer() 
  lpVT_IShellExtInit: 
    Data.l ?VT_IShellExtInit 
  VT_IShellExtInit: 
    Data.l @IUnknown_QueryInterface(), @IUnknown_AddRef(), @IUnknown_Release() 
    Data.l @IShellExtInit_Initialize() 
  lpVT_IContextMenu: 
    Data.l ?VT_IContextMenu 
  VT_IContextMenu: 
    Data.l @IUnknown_QueryInterface(), @IUnknown_AddRef(), @IUnknown_Release() 
    Data.l @IContextMenu_QueryContextMenu() 
    Data.l @IContextMenu_InvokeCommand() 
    Data.l @IContextMenu_GetCommandString() 
EndDataSection 

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
Top
ROUMANET
User
User
Posts: 12
Joined: Thu Aug 26, 2004 9:18 pm
Location: Isere (France)

Post by ROUMANET »

Hi !

I would to do a folder icon changer with Explorer context menu but... your code works only for files and not folder. Could you help me ?

By the way, in place of RequestMessage, could I call a standard form ? How should I pass the path of the folder ? global variable ?

Thanks for any help.

If it works, I will give my program as freeware (it's a tool for project manager with few icon status).
Top
Inf0Byt3
PureBasic Fanatic
PureBasic Fanatic
Posts: 2236
Joined: Fri Dec 09, 2005 12:15 pm
Location: Elbonia

Post by Inf0Byt3 »

Try this:

Context.bmp
Image

Code: Select all

 Enumeration
  #GCS_VERBA
  #GCS_HELPTEXTA
  #GCS_VALIDATEA
  #GCS_VERBW
  #GCS_HELPTEXTW
  #GCS_VALIDATEW
 EndEnumeration

 #CF_HDROP = $0f
 #DVASPECT_CONTENT = 1
 #TYMED_HGLOBAL = 1
 #TYMED_FILE = 2
 
 #MIIM_ID = 2
 #MIIM_STRING = $40
 #MF_STRING = 0
 #MFT_STRING = #MF_STRING
 #CMF_DEFAULTONLY = 1

 #GCS_UNICODE = 4
 #GCS_VERB = #GCS_VERBA
 #GCS_HELPTEXT = #GCS_HELPTEXTA
 #GCS_VALIDATE = #GCS_VALIDATEA
 
 #SEE_MASK_UNICODE = $4000
 #CMIC_MASK_UNICODE = #SEE_MASK_UNICODE
 #SELFREG_E_FIRST = $80009E40
 #SELFREG_E_CLASS = #SELFREG_E_FIRST+1
 #GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS = 4

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

 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
 
 Global m_pDataObj.IDataObject, cmd, hModule
 Global i_Unk.IUnknown, i_SEI.IShellExtInit, i_QCM.IContextMenu
 Global *p_Unk.ClassFactoryObject
 Global File$

 Global NewList FileList.s()

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

 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

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

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

 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

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

 Procedure IShellExtInit_Initialize(*ti_sei.IShellExtInit, *pidlFolder.ITEMIDLIST, *pdtobj.IDataObject, hkeyProgID)
  If *pidlFolder
    *m_szFile = AllocateMemory(#MAX_PATH*2)
    SHGetPathFromIDList_(*pidlFolder, *m_szFile)
    Path$ = PeekS(*m_szFile)
    FreeMemory(*m_szFile)
  EndIf
  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, $FFFFFFFF, #Null, 0)
      *m_szFile = AllocateMemory(#MAX_PATH)
      For i=1 To uCount
        DragQueryFile_(medium\hGlobal, i-1, *m_szFile, #MAX_PATH)
        AddElement(FileList())
        FileList() = PeekS(*m_szFile)
      Next i
      FreeMemory(*m_szFile)
      ReleaseStgMedium_(@medium)
      ProcedureReturn #S_OK
    EndIf
  EndIf
  ProcedureReturn #S_FALSE 
 EndProcedure

 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
  Imga = CatchImage(0,?Img)
  SetMenuItemBitmaps_(hmenu,indexMenu,#MF_BYPOSITION,Imga,Imga)
  ProcedureReturn 1
 EndProcedure

 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

 Procedure IContextMenu_InvokeCommand(*ti_icm.IContextMenu, *pici.CMINVOKECOMMANDINFOEX)
  If *pici\cbSize=SizeOf(CMINVOKECOMMANDINFOEX)
    If *pici\fMask&#CMIC_MASK_UNICODE
      If (*pici\lpVerbW&$ffff)=cmd
        Show$ = Path$
        ForEach FileList()
          Show$+Chr(10)+FileList()
        Next
        MessageRequester("", Show$) 
        ClearList(FileList())
        ProcedureReturn #NOERROR
      EndIf
    EndIf
  ElseIf *pici\cbSize=SizeOf(CMINVOKECOMMANDINFO)
    If (*pici\lpVerb&$ffff)=cmd
        Show$ = Path$
        ForEach FileList()
          Show$+Chr(10)+FileList()
        Next
        ClearList(FileList())
        MessageRequester("", Show$) 
      ProcedureReturn #NOERROR
    EndIf
  Else
    ProcedureReturn #S_FALSE
  EndIf
 EndProcedure

 ProcedureDLL DllRegisterServer()
  InDLL:
  If RegCreateKeyEx_(#HKEY_CLASSES_ROOT, "*\shellex\ContextMenuHandlers\OMG.ContextScan", 0, 0, #REG_OPTION_NON_VOLATILE, #KEY_ALL_ACCESS, #Null, @hKey1, 0)<>#ERROR_SUCCESS
   ProcedureReturn #SELFREG_E_CLASS
  EndIf
  RegSetValueEx_(hKey1, "", 0, #REG_SZ, "{3e989b94-06db-4dca-8656-0c03bd832136}", 38)
  If hKey1:RegCloseKey_(hKey1):hKey1 = 0:EndIf
  If RegCreateKeyEx_(#HKEY_CLASSES_ROOT, "OMG.ContextScan\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, "{3e989b94-06db-4dca-8656-0c03bd832136}", 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, "{3e989b94-06db-4dca-8656-0c03bd832136}", 0, #REG_SZ, "OMG.ContextScan", 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\{3e989b94-06db-4dca-8656-0c03bd832136}", 0, 0, #REG_OPTION_NON_VOLATILE, #KEY_ALL_ACCESS, #Null, @hKey1, 0)<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS:EndIf
    RegSetValueEx_(hKey1, "", 0, #REG_SZ, "OMG.ContextScan", 15)
    If hKey1:RegCloseKey_(hKey1):hKey1 = 0:EndIf
    If RegCreateKeyEx_(#HKEY_CLASSES_ROOT, "CLSID\{3e989b94-06db-4dca-8656-0c03bd832136}\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
    If RegCreateKey_(#HKEY_CLASSES_ROOT, "Directory\shellex\ContextMenuHandlers\OMG",@"")<>#ERROR_SUCCESS
     ProcedureReturn #SELFREG_E_CLASS
    EndIf
    RegSetValue_(#HKEY_CLASSES_ROOT, "Directory\shellex\ContextMenuHandlers\OMG", #REG_SZ, @"{3e989b94-06db-4dca-8656-0c03bd832136}", 39)
  Else
    ProcedureReturn #SELFREG_E_CLASS
  EndIf
  FreeMemory(*szBuffer)
  ProcedureReturn #S_OK
 EndProcedure

 ProcedureDLL DllUnregisterServer()
  If RegDeleteKey_(#HKEY_CLASSES_ROOT, "*\shellex\ContextMenuHandlers\OMG.ContextScan")<>#ERROR_SUCCESS
   ProcedureReturn #SELFREG_E_CLASS
  EndIf
  If RegDeleteKey_(#HKEY_CLASSES_ROOT, "OMG.ContextScan\shellex\ContextMenuHandlers")<>#ERROR_SUCCESS
   ProcedureReturn #SELFREG_E_CLASS
  EndIf
  If RegDeleteKey_(#HKEY_CLASSES_ROOT, "OMG.ContextScan\shellex")<>#ERROR_SUCCESS
   ProcedureReturn #SELFREG_E_CLASS
  EndIf
  If RegDeleteKey_(#HKEY_CLASSES_ROOT, "OMG.ContextScan")<>#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, "{3e989b94-06db-4dca-8656-0c03bd832136}")<>#ERROR_SUCCESS
   ProcedureReturn #SELFREG_E_CLASS
  EndIf
  If hKey1
   RegCloseKey_(hKey1)
   hKey1 = 0
  EndIf
  If RegOpenKeyEx_(#HKEY_CLASSES_ROOT, "CLSID\{3e989b94-06db-4dca-8656-0c03bd832136}", 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, "{3e989b94-06db-4dca-8656-0c03bd832136}")<>#ERROR_SUCCESS
   ProcedureReturn #SELFREG_E_CLASS
  EndIf
  If hKey1
   RegCloseKey_(hKey1)
   hKey1 = 0
  EndIf
  If RegDeleteKey_(hKey1, "Directory\shellex\ContextMenuHandlers\OMG")<>#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

 DataSection
  lpVT_IUnknown:
    Data.l ?VT_IUnknown, 0, 0
  VT_IUnknown:
    Data.l @IUnknown_QueryInterface(), @IUnknown_AddRef(), @IUnknown_Release()
  lpVT_IClassFactory:
    Data.l ?VT_IClassFactory
  VT_IClassFactory:
    Data.l @IUnknown_QueryInterface(), @IUnknown_AddRef(), @IUnknown_Release()
    Data.l @IClassFactory_CreateInstance(), @IClassFactory_LockServer()
  lpVT_IShellExtInit:
    Data.l ?VT_IShellExtInit
  VT_IShellExtInit:
    Data.l @IUnknown_QueryInterface(), @IUnknown_AddRef(), @IUnknown_Release()
    Data.l @IShellExtInit_Initialize()
  lpVT_IContextMenu:
    Data.l ?VT_IContextMenu
  VT_IContextMenu:
    Data.l @IUnknown_QueryInterface(), @IUnknown_AddRef(), @IUnknown_Release()
    Data.l @IContextMenu_QueryContextMenu()
    Data.l @IContextMenu_InvokeCommand()
    Data.l @IContextMenu_GetCommandString()
 EndDataSection
  
 DataSection ;
  CLSID_ContextMenuHandler: ; {3e989b94-06db-4dca-8656-0c03bd832136}
    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 "Open a file"
  CommandHelpLine:
    Data.s "Opens A File"
  Img:
    IncludeBinary "context.bmp"
 EndDataSection
None are more hopelessly enslaved than those who falsely believe they are free. (Goethe)
Top
ROUMANET
User
User
Posts: 12
Joined: Thu Aug 26, 2004 9:18 pm
Location: Isere (France)

Post by ROUMANET »

*oups* the last code give me nothing (even on files or folders).
No compilation error (PB 4, option dll shared) and dll registration is OK...

Sorry I'm Purebasic (and programmer) beginer :oops:
Top
ROUMANET
User
User
Posts: 12
Joined: Thu Aug 26, 2004 9:18 pm
Location: Isere (France)

Post by ROUMANET »

An other way to launch a program with selected file (or folder) parameter

Open the Windows Registry editor.
Open the key HKEY_CLASSES_ROOT\Folder\shell
Create a sub-key named Function_name
Create a sub-key beneath that named command
Change the default value to path+program_name "%1"

Your program should accept parameter, ie. use SelectedFile$ = ProgramParameter()

A little more easy for 80% of major use :roll:
Top
Peyman
Enthusiast
Enthusiast
Posts: 203
Joined: Mon Dec 24, 2007 4:15 pm
Location: Iran

Re: Context Menu Item Shell Extension example (Windows)

Post by Peyman »

this code not work somebody have a worked code or can fix this.
Thanks.
Sorry for my bad english.
Top
Post Reply

Return to “Tricks 'n' Tips”