EnableExplicit

Macro qu 
  "
EndMacro

Macro CLSID_Build(p1, p2, p3, p4, p5, CLSID_Const = CLSID$, CLSID__Label = CLSID_m1)
  
  #CLSID_Const = "{"+qu#p1#qu+"-"+qu#p2#qu+"-"+qu#p3#qu+"-"+qu#p4#qu+"-"+qu#p5#qu+"}"
  
  DataSection
    CLSID__Label#:
    Data.l $p1
    Data.w $p2, $p3
    Data.a $p4>>8&255, $p4&255
    Data.a $p5>>40&255, $p5>>32&255, $p5>>24&255, $p5>>16&255, $p5>>8&255, $p5&255
  EndDataSection
  
EndMacro

CLSID_Build(851aab5c, 2008, 4157, 9c5d, a28dfa7b2660, CLSID_ID, CLSID_ContextMenuHandler)

#PlugName$ = "FastView.Image"
#CommandString = "Show file name" 
#CommandHelpLine = "Shows the file name" 

Procedure Error(message$) 
  Protected wError = GetLastError_()
  Protected *ErrorBuffer 
  
  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 
  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$
Global GLINDEX_9.l
Global Dim GLINDEX_S.s(100)
Global g_Instance

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

Procedure IUnknown_QueryInterface(*ti_unk.IUnknown, *riid.GUID, *ppvObject.Integer) 
  If *ppvObject 
    If CompareMemory(*riid, ?IID_IUnknown, SizeOf(GUID))
      *ppvObject\i = i_Unk 
    ElseIf CompareMemory(*riid, ?IID_IShellExtInit, SizeOf(GUID)) 
      *ppvObject\i = i_SEI 
    ElseIf CompareMemory(*riid, ?IID_IContextMenu, SizeOf(GUID)) 
      *ppvObject\i = 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) 
  Protected hr
  
  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) 
  Protected fe.FORMATETC\cfFormat = #CF_HDROP
  Protected medium.STGMEDIUM, uCount, dd, *m_szFile
  
  If m_pDataObj 
    m_pDataObj\Release() 
  EndIf 
  If *pdtobj 
    m_pDataObj = *pdtobj 
    *pdtobj\AddRef() 
    fe\ptd = #Null 
    fe\dwAspect = #DVASPECT_CONTENT 
    fe\lindex = -1 
    fe\tymed = #TYMED_HGLOBAL 
    If *pdtobj\GetData(@fe, @medium)=#S_OK 
      uCount = DragQueryFile_(medium\hGlobal, -1, #Null, 0) 
      GLINDEX_9=uCount
      If uCount>=1
        For dd=0 To uCount-1
        *m_szFile = AllocateMemory(#MAX_PATH) 
        DragQueryFile_(medium\hGlobal, dd, *m_szFile, #MAX_PATH) 
        If Len(PeekS(*m_szFile))=0 
          uCount = 0 
        Else 
          GLINDEX_S(dd) = PeekS(*m_szFile) 
        EndIf 
        FreeMemory(*m_szFile) 
        Next
      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) 
  Static s.s=#CommandString
  If #CMF_DEFAULTONLY&uFlags:ProcedureReturn 0:EndIf 
  cmd = indexMenu 
  Protected mii.MENUITEMINFO 
  mii\cbSize = SizeOf(MENUITEMINFO) 
  mii\fMask = #MIIM_STRING|#MIIM_ID 
  mii\fType = #MFT_STRING 
  mii\wID = idCmdFirst 
  mii\dwTypeData = @s
  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. 
        PokeS(*pszName, #CommandHelpLine, -1, #PB_Ascii)
      Case #GCS_HELPTEXTW ; Sets pszName To a Unicode string containing the Help text For the command. 
        PokeS(*pszName, #CommandHelpLine)
      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, #CommandString, -1, #PB_Ascii)
      Case #GCS_VERBW ; Sets pszName To a Unicode string containing the language-independent command name For the menu item. 
        PokeS(*pszName, #CommandString)
      Default 
        ProcedureReturn #S_FALSE 
    EndSelect 
  Else 
    ProcedureReturn #S_FALSE 
  EndIf 
  ProcedureReturn #S_OK 
EndProcedure 

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

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

#SEE_MASK_UNICODE = $4000 
#CMIC_MASK_UNICODE = #SEE_MASK_UNICODE 

Procedure IContextMenu_InvokeCommand(*ti_icm.IContextMenu, *pici.CMINVOKECOMMANDINFOEX) 
  Protected dd, inputstring.s
  
  If *pici\cbSize=SizeOf(CMINVOKECOMMANDINFOEX) 
    If *pici\fMask&#CMIC_MASK_UNICODE 
      If (*pici\lpVerbW&$ffff)=cmd 
        For dd=0 To GLINDEX_9-1
          inputstring = inputstring + GLINDEX_S(dd) + Chr(10)
        Next 
        MessageRequester(Str(dd),inputstring.s)
        ProcedureReturn #NOERROR 
      EndIf 
    EndIf 
  ElseIf *pici\cbSize=SizeOf(CMINVOKECOMMANDINFO) 
    If (*pici\lpVerb&$ffff)=cmd 
      For dd=0 To GLINDEX_9-1
        inputstring.s = inputstring.s + GLINDEX_S(dd) + Chr(10)
       Next 
        MessageRequester(Str(dd),inputstring.s)
      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() 
  Protected hKey1, *szBuffer, str.s
  
  If RegCreateKeyEx_(#HKEY_CLASSES_ROOT, "*\shellex\ContextMenuHandlers\"+#PlugName$, 0, 0, #REG_OPTION_NON_VOLATILE, #KEY_ALL_ACCESS, #Null, @hKey1, 0)<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS:EndIf 
  RegSetValueEx_(hKey1, "", 0, #REG_SZ, #CLSID_ID, StringByteLength(#CLSID_ID)) 
  If hKey1:RegCloseKey_(hKey1):hKey1 = 0:EndIf 
  If RegCreateKeyEx_(#HKEY_CLASSES_ROOT, #PlugName$+"\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, #CLSID_ID, StringByteLength(#CLSID_ID)) 
  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, #CLSID_ID, 0, #REG_SZ, #PlugName$, StringByteLength(#PlugName$)) 
  If hKey1:RegCloseKey_(hKey1):hKey1 = 0:EndIf 
  *szBuffer = AllocateMemory(#MAX_PATH) 
  If *szBuffer And GetModuleFileName_(g_Instance, *szBuffer, #MAX_PATH) 
  If RegCreateKeyEx_(#HKEY_CLASSES_ROOT, "CLSID\"+#CLSID_ID, 0, 0, #REG_OPTION_NON_VOLATILE, #KEY_ALL_ACCESS, #Null, @hKey1, 0)<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS:EndIf 
    RegSetValueEx_(hKey1, "", 0, #REG_SZ, #PlugName$, StringByteLength(#PlugName$)) 
    If hKey1:RegCloseKey_(hKey1):hKey1 = 0:EndIf 
    If RegCreateKeyEx_(#HKEY_CLASSES_ROOT, "CLSID\"+#CLSID_ID+"\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, StringByteLength(PeekS(*szBuffer))+SizeOf(Character)) 
    str="Apartment"
    RegSetValueEx_(hKey1, "ThreadingModel", 0, #REG_SZ, str, StringByteLength(str)) 
    If hKey1:RegCloseKey_(hKey1):hKey1 = 0:EndIf 
  Else 
    ProcedureReturn #SELFREG_E_CLASS 
  EndIf 
  FreeMemory(*szBuffer) 
  ProcedureReturn #S_OK 
EndProcedure 

ProcedureDLL DllUnregisterServer() 
  Protected hKey1
  If RegDeleteKey_(#HKEY_CLASSES_ROOT, "*\shellex\ContextMenuHandlers\"+#PlugName$)<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS:EndIf 
  If RegDeleteKey_(#HKEY_CLASSES_ROOT, #PlugName$+"\shellex\ContextMenuHandlers")<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS:EndIf 
  If RegDeleteKey_(#HKEY_CLASSES_ROOT, #PlugName$+"\shellex")<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS:EndIf 
  If RegDeleteKey_(#HKEY_CLASSES_ROOT, #PlugName$)<>#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, #CLSID_ID)<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS:EndIf 
  If hKey1:RegCloseKey_(hKey1):hKey1 = 0:EndIf 
  If RegOpenKeyEx_(#HKEY_CLASSES_ROOT, "CLSID\"+#CLSID_ID, 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, #CLSID_ID)<>#ERROR_SUCCESS:ProcedureReturn #SELFREG_E_CLASS:EndIf 
  If hKey1:RegCloseKey_(hKey1):hKey1 = 0:EndIf 
  ProcedureReturn #S_OK 
EndProcedure 

ProcedureDLL AttachProcess(Instance)
  g_Instance = 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.Integer) 
  If *ppv 
    If CompareMemory(*rclsid, ?CLSID_ContextMenuHandler, SizeOf(GUID)) 
      If CompareMemory(*riid, ?IID_IClassFactory, SizeOf(GUID)) 
        *ppv\i = ?lpVT_IClassFactory 
      Else 
        *ppv\i = 0 
        ProcedureReturn #CLASS_E_CLASSNOTAVAILABLE 
      EndIf 
    Else 
      *ppv\i = 0 
      ProcedureReturn #CLASS_E_CLASSNOTAVAILABLE 
    EndIf 
  Else 
    *ppv\i = 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.i ?VT_IUnknown, 0, 0 
  VT_IUnknown: 
    Data.i @IUnknown_QueryInterface(), @IUnknown_AddRef(), @IUnknown_Release() 
  lpVT_IClassFactory: 
    Data.i ?VT_IClassFactory 
  VT_IClassFactory: 
    Data.i @IUnknown_QueryInterface(), @IUnknown_AddRef(), @IUnknown_Release() 
    Data.i @IClassFactory_CreateInstance(), @IClassFactory_LockServer() 
  lpVT_IShellExtInit: 
    Data.i ?VT_IShellExtInit 
  VT_IShellExtInit: 
    Data.i @IUnknown_QueryInterface(), @IUnknown_AddRef(), @IUnknown_Release() 
    Data.i @IShellExtInit_Initialize() 
  lpVT_IContextMenu: 
    Data.i ?VT_IContextMenu 
  VT_IContextMenu: 
    Data.i @IUnknown_QueryInterface(), @IUnknown_AddRef(), @IUnknown_Release() 
    Data.i @IContextMenu_QueryContextMenu() 
    Data.i @IContextMenu_InvokeCommand() 
    Data.i @IContextMenu_GetCommandString() 
EndDataSection 

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

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

Procedure NewMenuIcon(id,color) 
  CreateImage(id, 16, 16) 
  
  StartDrawing(ImageOutput(id)) 
  Box(0,0,16,16,color) 
  StopDrawing() 
  
  ProcedureReturn ImageID(id) 
EndProcedure 

SetMenuItemBitmaps_(hmenu, mii\wID, #MF_BYCOMMAND, NewMenuIcon(0,$FF0000), 0)

Procedure debug_ohibka(s$)
Protected *Bufer
*Bufer=AllocateMemory(200)
FormatMessage_(#FORMAT_MESSAGE_FROM_SYSTEM,0, GetLastError_(), #LANG_NEUTRAL, *Bufer, 200,0)
MessageRequester("Событие "+s$,Str(GetLastError_())+" "+PeekS(*Bufer,-1,#PB_Unicode))
FreeMemory(*Bufer)
EndProcedure


#DONT_RESOLVE_DLL_REFERENCES=$00000001
#LOAD_IGNORE_CODE_AUTHZ_LEVEL=$00000010
#LOAD_LIBRARY_AS_DATAFILE=$00000002
#LOAD_LIBRARY_AS_DATAFILE_EXCLUSIVE=$00000040
#LOAD_LIBRARY_SEARCH_SYSTEM32=$00000800
#LOAD_WITH_ALTERED_SEARCH_PATH=$00000008
;| #LOAD_WITH_ALTERED_SEARCH_PATH



;deskriptor.i = LoadLibraryEx_("C:\Windows\System32\PortableDeviceApi.dll",0,#LOAD_IGNORE_CODE_AUTHZ_LEVEL | #LOAD_LIBRARY_SEARCH_SYSTEM32 )
debug_ohibka("LoadLibraryEx_OK")
If deskriptor=0
  debug_ohibka("LoadLibraryEx_OF")
 End
EndIf
OpenLibrary(0,"C:\Windows\System32\PortableDeviceApi.dll")
 ; If CoInitialize_(0)=#iS_OK
 ;   debug_ohibka("CoInitialize_OK")
 ;  Else
 ;    debug_ohibka("CoInitialize_OF")
 ;    End
 ; EndIf
  debug_ohibka("LoadLibraryEx_OF")


;CoUninitialize_()
CloseLibrary(0)
 ;FreeLibrary_(deskriptor)
debug_ohibka("FreeLibrary_")