flat assembler
Message board for the users of flat assembler.

Index > Windows > 1st COM server in assembler is created. 24.06.19 23:55 GMT+3

Author
Thread Post new topic Reply to topic
ProMiNick



Joined: 24 Mar 2012
Posts: 804
Location: Russian Federation, Sochi
ProMiNick 05 Jun 2019, 12:31
First of all what macros from official fasm package don`t fit COM server needs:

Code:
macro interface name,[proc] ; In case of COM client - all OK, COM Object is never defined in design time, in case of COM server things are different
 { common
    struc name \{
    match , @struct \\{ define field@struct .,name, \\}
    match no, @struct \\{ . dd ?
    virtual at 0
   forward
    .#proc dd ?
   common
    .\#\\.com.object = name#.com.interface
    end virtual \\} \}
    virtual at 0
   forward
     name#.#proc dd ?
   common
     name#.com.interface = $ shr 2
    end virtual }    

So I have to patch:
Code:
macro interface name,[proc]
 { common
    struc name value:?\{
    match , @struct \\{ define field@struct .,name,value \\}
    match no, @struct \\{ . dd value
    virtual at 0
   forward
    .#proc dd ?
   common
    .\#\\.com.object = name#.com.interface
    end virtual \\} \}
    virtual at 0
   forward
     name#.#proc dd ?
   common
     name#.com.interface = $ shr 2
    end virtual }    

patch dosn`t change behavior & syntax expected by fasm official examples but additionaly fits COM server needs.

In example I used esp as frame pointer (It is only my preferences - I included MYESPPROCSYNTAX.INC for support that):
syntax:
Code:
DllEntryPoint: procedure(hinstDLL,fdwReason,lpvReserved)    

but you could replace my syntax with standard
Code:
proc DllEntryPoint,hinstDLL,fdwReason,lpvReserved    

without needance in any changes in procedure body

I have to patch proc32.inc (not because COM requires it, I used one trick that requires such patch):
Code:
macro invoke proc,[arg]                 ; indirectly call STDCALL procedure
 { common
    if ~ arg eq
   reverse
     pushd arg
   common
    end if
    call dword [proc] };I only add word "dword" here for ability to invoke [eax],... syntax    


Code:
; Component Object Model usage demonstration

format PE GUI 4.0 dll
entry DllEntryPoint

include 'win32a.inc'

include 'generic/macro/guid.inc'
include 'os specific/windows/interfaces/base.inc'
include 'os specific/windows/interfaces/shell.inc'
;include 'os specific/windows/equates/com.inc'

include 'myESPprocSyntax.inc'


CMF_EXPLORE                     = 4
GCS_HELPTEXT                    = $00000001
CF_HDROP                        = 15
DVASPECT_CONTENT                = 1
TYMED_HGLOBAL                   = 1
;COM errors
E_NOINTERFACE                   = $80004002
E_POINTER                       = $80004003
E_FAIL                          = $80004005
CLASS_E_NOAGGREGATION           = $80040110
CLASS_E_CLASSNOTAVAILABLE       = $80040111
SELFREG_E_CLASS                 = $80040201
E_INVALIDARG                    = $80070057

macro precmpGUID {
        push    esi
        push    edi }

macro postcmpGUID {
        pop     edi
        pop     esi }

macro cmpGUID A, B {
        mov     esi, A
        mov     edi, B
        mov     ecx, 4
        repe    cmpsd }

macro prepare dummy,[arg]
 { common
        if ~ arg eq
   reverse
                pushd arg
   common
        end if }

macro unstack dummy,[arg]
 { common local counter
        if ~ arg eq
                counter = 0
   forward
                counter = counter + 1
   common
                add     esp, counter*4
        end if }

struct CMINVOKECOMMANDINFO
        cbSize          dd ?
        fMask           dd ?
        hwnd            dd ?
        lpVerb          dd ?
        lpParameters    dd ?
        lpDirectory     dd ?
        nShow           dd ?
        dwHotKey        dd ?
        hIcon           dd ?
ends

struct FORMATETC
        union
                cfFormat        dw ?
                                dd ?
        ends
        ptd                     dd ?
        dwAspect                dd ?
        lindex                  dd ?
        tymed                   dd ?
ends

struct STGMEDIUM
        tymed                           dd ?
        union
                struct
                        hBitmap         dd ?
                        unkForRelease   dd ?
                ends
                hMetaFilePict           dd ?
                hEnhMetaFile            dd ?
                hGlobal                 dd ?
                lpszFileName            dd ?
                stm                     dd ?
                stg                     dd ?
        ends
ends

section '.text' code readable executable

DllEntryPoint: procedure(hinstDLL,fdwReason,lpvReserved)
        mov     eax, [fdwReason+espFixer]
        cmp     eax, 1
        jne     .retTRUE
        mov     eax, [hinstDLL+espFixer]
        mov     [hInstance],eax
        invoke  DisableThreadLibraryCalls, eax
      .retTRUE:
        mov     eax,TRUE
        ret
endp

DllGetClassObject: procedure(rclsid,riid,ppv) ; returned requested ClassFactory!!! not COMobject itself
        push    ebx
        mov     ebx, [ppv+espFixer]
        test    ebx, ebx
        jz      .ret_E_POINTER
        xor     eax, eax
        mov     [ebx], eax

        precmpGUID                            ; search ClassFactory corresponded to rclsid
        cld
        cmpGUID [rclsid+espFixer],CLSID_QuickRegister
        postcmpGUID

        jnz     .ret_CLASS_E_CLASSNOTAVAILABLE
        cominvk QRClassFactory_COMobject,QueryInterface,[riid+espFixer],ebx
        jmp     .locret
      .ret_E_POINTER:
        mov     eax, E_POINTER
        jmp     .locret
      .ret_CLASS_E_CLASSNOTAVAILABLE:
        mov     eax, CLASS_E_CLASSNOTAVAILABLE
      .locret:
        pop     ebx
        ret
endp

DllCanUnloadNow: procedure()
        xor     eax,eax
        cmp     eax,[ServerLockCount]
        jz      .locret
        inc     eax
      .locret:
        ret
endp

__RegCreateKeyWithValue: procedure(lpSubKey,lpValueName,lpData)
        push    edi

        ; calc length of Pchar(edi) to ecx
        cld
        mov     edi, [lpData+espFixer]
        mov     ecx, -1
        xor     eax, eax
        repne   scasb
        not     ecx
        sub     edi, ecx

        prepare RegSetValueEx, eax, [lpValueName+espFixer], eax, REG_SZ, edi, ecx
        invoke  RegCreateKeyEx, [RootKey], [lpSubKey+espFixer], eax, eax, REG_OPTION_NON_VOLATILE, KEY_READ or KEY_WRITE, eax, [esp+4], eax
        test    eax, eax
        jnz     .unstack

        invoke  RegSetValueEx; stack prepared with prepare
        mov     edi, eax
        sub     esp, 24       ; again stack is ready
        invoke  RegCloseKey
        mov     eax,edi
        add     esp, 20
        jmp     .locret
      .unstack:
        unstack RegSetValueEx,hKey,lpValueName,Reserved,dwType,lpData,cbData
      .locret:
        pop     edi
        ret
endp

DllRegisterServer: procedure()
        mov     [RootKey], HKEY_CLASSES_ROOT
        stdcall __RegCreateKeyWithValue, CLSIDStr, NullStr, CLSIDDescription
        test    eax, eax
        jnz     .unregister
        invoke  GetModuleFileName, [hInstance], REGFileName, 261
        test    eax, eax
        jz      .unregister
        stdcall __RegCreateKeyWithValue, CLSIDInprocServer, NullStr, REGFileName
        test    eax, eax
        jnz     .unregister
        stdcall __RegCreateKeyWithValue, CLSIDInprocServer, ThreadingModelStr, ApartmentStr
        test    eax, eax
        jnz     .unregister
        stdcall __RegCreateKeyWithValue, dllfile_shellex_Str, NullStr, NullStr
        test    eax, eax
        jnz     .unregister
        stdcall __RegCreateKeyWithValue, dllfile_shellex_CMH_Str, NullStr, NullStr
        test    eax, eax
        jnz     .unregister
        stdcall __RegCreateKeyWithValue, dllfile_shellex_CMH_QR_Str, NullStr, CLSIDString_QuickRegister
        test    eax, eax
        jnz     .unregister
        mov     [RootKey], HKEY_LOCAL_MACHINE
        stdcall __RegCreateKeyWithValue, cur_vers_shellex_Str, NullStr, NullStr
        test    eax, eax
        jnz     .ret_S_FALSE
        stdcall __RegCreateKeyWithValue, cur_vers_shellex_approv_Str, CLSIDString_QuickRegister, CLSIDDescription
        jmp     .locret
      .ret_S_FALSE:
        xor     eax, eax
        inc     eax
        jmp     .locret
      .unregister:
        stdcall DllUnregisterServer
        invoke  MessageBox, 0, Error_updating_registry, REGFileName, MB_ICONERROR or MB_OK
        mov     eax, SELFREG_E_CLASS
      .locret:
        ret
endp

DllUnregisterServer: procedure()
        mov     [RootKey], HKEY_CLASSES_ROOT
        invoke  RegDeleteKey, [RootKey], dllfile_shellex_CMH_QR_Str
        invoke  RegDeleteKey, [RootKey], dllfile_shellex_CMH_Str
        invoke  RegDeleteKey, [RootKey], dllfile_shellex_Str
        invoke  RegDeleteKey, [RootKey], CLSIDInprocServer
        invoke  RegDeleteKey, [RootKey], CLSIDStr
        ret
endp

QRClassFactory@QueryInterface: procedure(Self,riid,ppvObject)
        push    ebx
        mov     ebx, [ppvObject+espFixer]
        test    ebx, ebx
        jz      .ret_E_POINTER
        xor     eax, eax
        mov     [ebx], eax

        precmpGUID
        cld
        cmpGUID [riid+espFixer],IID_IUnknown
        je      .cmp_done
        cmpGUID [riid+espFixer],IID_IClassFactory
      .cmp_done:
        postcmpGUID

        jnz     .ret_E_NOINTERFACE
        mov     eax, [Self+espFixer]
        mov     [ebx], eax
        comcall eax, IClassFactory, AddRef
        xor     eax, eax
        jmp     .locret
      .ret_E_POINTER:
        mov     eax, E_POINTER
        jmp     .locret
      .ret_E_NOINTERFACE:
        mov     eax, E_NOINTERFACE
      .locret:
        pop     ebx
        ret
endp

QRClassFactory@AddRef: procedure(Self)
        invoke  InterlockedIncrement, ServerLockCount
        mov     eax, 2
        ret
endp

QRClassFactory@Release: procedure(Self)
        invoke  InterlockedDecrement, ServerLockCount
        xor     eax, eax
        inc     eax
        ret
endp

QRClassFactory@CreateInstance: procedure(Self,pUnkOuter,riid,ppvObject)
        push    ebx
        mov     ebx, [ppvObject+espFixer]
        test    ebx, ebx
        jz      .ret_E_POINTER
        xor     eax, eax
        mov     [ebx], eax

        mov     eax, [pUnkOuter+espFixer]
        test    eax, eax
        jnz     .ret_CLASS_E_NOAGGREGATION
; for single instance object
; we don`t need to allocate memory for every Instance
; we don`t need to check if allocation is out of memory and resulting E_OUTOFMEMORY
; we don`t need to initialize COM object in runtime
; we don`t need to check success of QueryInterface and to free object occuped memory in bad cases
        cominvk QuickRegister_COMobject.CM,QueryInterface,[riid+espFixer],ebx
        cmp     eax,0
        jl      .ret_E_FAIL
        invoke  InterlockedIncrement, ServerLockCount
        jmp     .locret

      .ret_E_POINTER:
        mov     eax, E_POINTER
        jmp     .locret
      .ret_CLASS_E_NOAGGREGATION:
        mov     eax, CLASS_E_NOAGGREGATION
        jmp     .locret
      .ret_E_FAIL:
        mov     eax, E_FAIL
      .locret:
        pop     ebx
        ret
endp

QRClassFactory@LockServer: procedure(Self,fLock)
        mov     eax,[fLock+espFixer]
        lea     eax,[.interlocked+eax*4]
        invoke  eax, ServerLockCount
        xor     eax, eax
        ret
      .interlocked:
        dd      InterlockedDecrement
        dd      InterlockedIncrement
endp

ContextMenu@QueryInterface: procedure(Self,riid,ppvObject)
        push    ebx
        mov     ebx, [ppvObject+espFixer]
        test    ebx, ebx
        jz      .ret_E_POINTER
        mov     dword [ebx], QuickRegister_COMobject.CM
        precmpGUID
        cld
        cmpGUID [riid+espFixer],IID_IUnknown
        je      .cmp_done
        cmpGUID [riid+espFixer],IID_IContextMenu
        je      .cmp_done
        cmpGUID [riid+espFixer],IID_IShellExtInit
        jne     .cmp_done
        mov     dword [ebx], QuickRegister_COMobject.SE
      .cmp_done:
        postcmpGUID

        jnz     .ret_E_NOINTERFACE
        comcall [ebx], IUnknown, AddRef
        xor     eax, eax
        jmp     .locret
      .ret_E_POINTER:
        mov     eax, E_POINTER
        jmp     .locret
      .ret_E_NOINTERFACE:
        mov     [ebx], eax ; cmpGUID already set eax as zero
        mov     eax, E_NOINTERFACE
      .locret:
        pop     ebx
        ret
endp

ContextMenu@AddRef: procedure(Self)
        mov     eax, [Self+espFixer]
        add     eax, current_COMobject.RefCount
        invoke  InterlockedIncrement, eax
        ret
endp

ContextMenu@Release: procedure(Self)
        mov     eax, [Self+espFixer]
        add     eax, current_COMobject.RefCount
        invoke  InterlockedDecrement, eax
        test    eax, eax
        jnz     .locret
; for single instance object
; we don`t need to free object occuped memory
        invoke  InterlockedDecrement, ServerLockCount
      .locret:
        ret
endp

ContextMenu@QueryContextMenu: procedure(Self,Menu,indexMenu,idCmdFirst,idCmdLast,uFlags)
        mov     eax, [uFlags+espFixer]
        and     eax, $F
        jz      .handle
        test    eax, CMF_EXPLORE
        jnz     .ret_S_OK
      .handle:
        mov     ecx, [indexMenu+espFixer]
        mov     edx, [idCmdFirst+espFixer]
        invoke  InsertMenu,[Menu+espFixer],ecx,MF_SEPARATOR or MF_BYPOSITION, 0, 0
        inc     ecx
        invoke  InsertMenu,[Menu+espFixer],ecx,MF_STRING or MF_BYPOSITION, edx, registerStr
        inc     ecx
        inc     edx
        invoke  InsertMenu,[Menu+espFixer],ecx,MF_STRING or MF_BYPOSITION, edx, unregisterStr
        inc     ecx
        invoke  InsertMenu,[Menu+espFixer],ecx,MF_SEPARATOR or MF_BYPOSITION, 0, 0
        mov     eax, 2
        jmp     .locret
      .ret_S_OK:
        xor     eax, eax
      .locret:
        ret
endp

RegisterCOMServer: procedure(dll_proc,hwnd,dll_file)
        invoke  LoadLibrary, [dll_file+espFixer]
        test    eax, eax
        jz      .ret_S_FALSE
        push    eax
        invoke  GetProcAddress, eax, [dll_proc+espFixer]
        test    eax, eax
        jnz     .call
      .ret_S_FALSE_n_FREE:
        invoke  FreeLibrary
        xor     eax, eax
        jmp     .ret_S_FALSE
      .call:
        call    eax
        cmp     eax, 0
        jl      .ret_S_FALSE_n_FREE
        invoke  FreeLibrary
        xor     eax, eax
        jmp     .locret
      .ret_S_FALSE:
        inc     eax
      .locret:
        ret 0
endp

MessagingInvokeCommand: procedure(fmt,fError,ProcName,hwnd,Filename)
        cinvoke wsprintf, Buffer, [fmt+espFixer], [ProcName+espFixer], [Filename+espFixer]
        mov     eax, [fError+espFixer]
        invoke  MessageBox,[hwnd+espFixer],Buffer,[QRCases+eax*4],[MBCases+eax*4]
        mov     eax, [fError+espFixer]
        ret
endp

ContextMenu@InvokeCommand: procedure(Self,lpici)
        mov     eax, [Self+espFixer]
        push    [eax+current_COMobject.lpFileName]

        mov     eax, [lpici+espFixer]
        push    [eax+CMINVOKECOMMANDINFO.hwnd]
        mov     eax, [eax+CMINVOKECOMMANDINFO.lpVerb]
        cmp     eax, 1
        ja      .ret_E_INVALIDARG
        push    [ProcNames+eax*4]
        call    RegisterCOMServer
        push    eax
        push    [FmtCases+eax*4]

        call    MessagingInvokeCommand
        test    eax, eax
        jz      .locret
        mov     eax, E_FAIL
        jmp     .locret
      .ret_E_INVALIDARG:
        pop     eax
        pop     eax
        mov     eax, E_INVALIDARG
      .locret:
        ret
endp

ContextMenu@GetCommandString: procedure(Self,idCmd,uType,pwReserved,pszName,cchMax)
        mov     eax, [uType+espFixer]
        cmp     eax, GCS_HELPTEXT
        jne     .ret_S_OK
        mov     eax, [idCmd+espFixer]
        cmp     eax, 1
        ja      .ret_E_INVALIDARG

        ;stdcall StrCopy, [pszName], [HintCases+eax*4]
        push    esi
        push    edi
        cld
        mov     edi, [HintCases+eax*4]
        mov     ecx, -1
        xor     eax, eax
        repne   scasb
        not     ecx
        sub     edi, ecx
        mov     esi, edi
        mov     edi, [pszName+espFixer]
        mov     eax, ecx
        shr     ecx, 2
        rep     movsd
        mov     ecx, eax
        and     ecx, 3
        rep     movsb
        pop     edi
        pop     esi

      .ret_S_OK:
        xor     eax, eax
        jmp     .locret
      .ret_E_INVALIDARG:
        mov     eax, E_INVALIDARG
      .locret:
        ret
endp

ShellExtInit@QueryInterface: procedure(Self,riid,ppvObject)
        mov     eax, [Self+espFixer]
        comcall [eax-current_COMobject.SE], IUnknown, QueryInterface, [riid+espFixer], [ppvObject+espFixer]
        ret
endp

ShellExtInit@AddRef: procedure(Self)
        mov     eax, [Self+espFixer]
        comcall [eax-current_COMobject.SE], IUnknown, AddRef
        ret
endp

ShellExtInit@Release: procedure(Self)
        mov     eax, [Self+espFixer]
        comcall [eax-current_COMobject.SE], IUnknown, Release
        ret
endp

ShellExtInit@Initialize: procedure(Self, pidlFolder, lpdobj, hKeyProgID)
        mov     eax, [lpdobj+espFixer]
        test    eax, eax
        jz      .ret_E_INVALIDARG
        comcall eax, IDataObject, GetData, FormatETC, StgMedium
        cmp     eax, 0
        jl      .ret_E_FAIL
        xor     eax, eax
        mov     [FileName_COMfield], al
        invoke  DragQueryFile, StgMedium.hGlobal, -1, 0, 0
        cmp     eax, 1
        jne     .ret_E_FAIL
        invoke  DragQueryFile, StgMedium.hGlobal, 0, FileName_COMfield, 261
        invoke  ReleaseStgMedium, StgMedium
        xor     eax, eax
        jmp     .locret
      .ret_E_FAIL:
        mov     eax, E_FAIL
        jmp     .locret
      .ret_E_INVALIDARG:
        mov     eax, E_INVALIDARG
      .locret:
        ret
endp

section '.data' data readable writeable

 CLSID_QuickRegister GUID 40E69241-5D1A-11D1-81CB-0020AF3E97A9
 IID_IUnknown        GUID 00000000-0000-0000-C000-000000000046
 IID_IClassFactory   GUID 00000001-0000-0000-C000-000000000046
 IID_IContextMenu    GUID 000214E4-0000-0000-C000-000000000046
 IID_IShellExtInit   GUID 000214E8-0000-0000-C000-000000000046

 struct current_COMobject
   CM IContextMenu
   SE IShellExtInit
   RefCount dd ?
   lpFileName dd ?
 ends


 QuickRegister_ClassFactory:
 QRClassFactory_QueryInterface  dd QRClassFactory@QueryInterface
 QRClassFactory_AddRef          dd QRClassFactory@AddRef
 QRClassFactory_Release         dd QRClassFactory@Release
 QRClassFactory_CreateInstance  dd QRClassFactory@CreateInstance
 QRClassFactory_LockServer      dd QRClassFactory@LockServer

 ContextMenu:
 ContextMenu_QueryInterface     dd ContextMenu@QueryInterface
 ContextMenu_AddRef             dd ContextMenu@AddRef
 ContextMenu_Release            dd ContextMenu@Release
 ContextMenu_QueryContextMenu   dd ContextMenu@QueryContextMenu
 ContextMenu_InvokeCommand      dd ContextMenu@InvokeCommand
 ContextMenu_GetCommandString   dd ContextMenu@GetCommandString
 ShellExtInit:
 ShellExtInit_QueryInterface    dd ShellExtInit@QueryInterface
 ShellExtInit_AddRef            dd ShellExtInit@AddRef
 ShellExtInit_Release           dd ShellExtInit@Release
 ShellExtInit_Initialize        dd ShellExtInit@Initialize

 QRClassFactory_COMobject       IClassFactory QuickRegister_ClassFactory
 ServerLockCount                dd 0
 hInstance                      dd 0

 QuickRegister_COMobject        current_COMobject ContextMenu,ShellExtInit,0,FileName_COMfield

 FormatETC                      FORMATETC CF_HDROP, 0, DVASPECT_CONTENT, -1, TYMED_HGLOBAL
 StgMedium                      STGMEDIUM
 ProcNames                      dd registerServerStr, unregisterServerStr
 FmtCases                       dd fmtStr, fmtErrStr
 MBCases                        dd MB_ICONINFORMATION or MB_OK,MB_ICONERROR or MB_OK
 QRCases                        dd Quick_Register,Quick_Register_Error
 HintCases                      dd registerHintStr,unregisterHintStr
 RootKey                        dd ?

 CLSIDStr                       db 'CLSID\'
 CLSIDString_QuickRegister      db '{40E69241-5D1A-11D1-81CB-0020AF3E97A9}',0
 CLSIDDescription               db 'Quick Register Context Menu Shell Extension',0
 CLSIDInprocServer              db 'CLSID\{40E69241-5D1A-11D1-81CB-0020AF3E97A9}\InprocServer32',0
 ThreadingModelStr              db 'ThreadingModel',0
 ApartmentStr                   db 'Apartment',0
 dllfile_shellex_Str            db 'dllfile\shellex',0
 dllfile_shellex_CMH_Str        db 'dllfile\shellex\ContextMenuHandlers',0
 dllfile_shellex_CMH_QR_Str     db 'dllfile\shellex\ContextMenuHandlers\QuickRegister',0
 cur_vers_shellex_Str           db 'SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions',0
 cur_vers_shellex_approv_Str    db 'SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved',0
 Error_updating_registry        db 'Error updating registry',0
 registerStr                    db 'register',0
 unregisterStr                  db 'unregister',0
 registerServerStr              db 'DllRegisterServer',0
 unregisterServerStr            db 'DllUnregisterServer',0
 fmtStr                         db '%s in %s succeeded.',0
 fmtErrStr                      db '%s in %s failed.',0
 Quick_Register                 db 'Quick Register',0
 Quick_Register_Error           db 'Quick Register - Error',0
 registerHintStr                db 'Register this COM/ActiveX server.',0
 unregisterHintStr              db 'Unregister this COM/ActiveX server.',0
 NullStr  db 0
 REGFileName db 261 dup ?
 FileName_COMfield db 261 dup ?
 Buffer db 300 dup ?

section '.idata' import data readable

  library kernel32,'KERNEL32.DLL',\
          user32,'USER32.DLL',\
          shell32,'SHELL32.DLL',\
          advapi32,'ADVAPI32.DLL',\
          ole32,'OLE32.DLL'

  import kernel32,\
         DisableThreadLibraryCalls,'DisableThreadLibraryCalls',\
         FreeLibrary,'FreeLibrary',\
         GetModuleFileName,'GetModuleFileNameA',\
         GetProcAddress,'GetProcAddress',\
         InterlockedDecrement,'InterlockedDecrement',\
         InterlockedIncrement,'InterlockedIncrement',\
         LoadLibrary,'LoadLibraryA'

  import user32,\
         InsertMenu,'InsertMenuA',\
         MessageBox,'MessageBoxA',\
         wsprintf,'wsprintfA'

  import shell32,\
         DragQueryFile,'DragQueryFileA'

  import advapi32,\
         RegCloseKey,'RegCloseKey',\
         RegCreateKeyEx,'RegCreateKeyExA',\
         RegDeleteKey,'RegDeleteKeyA',\
         RegSetValueEx,'RegSetValueExA'

  import ole32,\
         ReleaseStgMedium,'ReleaseStgMedium'

section '.edata' export data readable

  export 'COMSERVEXAMPLE.DLL',\
         DllGetClassObject,'DllGetClassObject',\
         DllCanUnloadNow,'DllCanUnloadNow',\
         DllRegisterServer,'DllRegisterServer',\
         DllUnregisterServer,'DllUnregisterServer'

section '.reloc' fixups data readable discardable
    


fasmpack part 1
fasmpack part 2
[attachment in 1st post renamed & updated/ attachment to same package in following posts removed]

_________________
I don`t like to refer by "you" to one person.
My soul requires acronim "thou" instead.


Last edited by ProMiNick on 08 Dec 2020, 19:33; edited 7 times in total
Post 05 Jun 2019, 12:31
View user's profile Send private message Send e-mail Reply with quote
ProMiNick



Joined: 24 Mar 2012
Posts: 804
Location: Russian Federation, Sochi
ProMiNick 07 Jun 2019, 10:10
I wish to thanks unknown author of ShellExt demonstration in Delphi 7 (from far 2001), thour work was a basepoint for me and finaly inspired me to go from abstract ideas to working COM dll.
Code:
// This COM server is an example of how to accomplish COM functionality
// without using any object oriented Pascal constructs.  Object Pascal
// classes are not used and so neither are Object Pascal Interfaces.  All
// interface pointers are true pointers.  This was done as a study in
// contrasts.  Compare this code to that found in the ContMenu project.

// Note: Although this project uses units wherein Object Pascal classes and
// interfaces are defined, none of those classes or interfaces are used in
// the code.

library QRegister;

uses
  Windows,
  PureContextMenu in 'PureContextMenu.pas';

exports
  DllGetClassObject,
  DllCanUnloadNow,
  DllRegisterServer,
  DllUnregisterServer;

begin
end.    

Code:
unit PureContextMenu;

interface

uses
  ActiveX;

function DllGetClassObject(const CLSID: TCLSID; const IID: TIID;
  var Obj: Pointer): HResult; stdcall;
function DllCanUnloadNow: HResult; stdcall;
function DllRegisterServer: HResult; stdcall;
function DllUnregisterServer: HResult; stdcall;

implementation

uses
  SmallWindows, SysUtils, ShellAPI, ShlObj;

const
  IID_IUnknown: TIID = '{00000000-0000-0000-C000-000000000046}';

type
  IUnknown    = ^PIUnknownMT;
  PIUnknownMT = ^TIUnknownMT;
  TIUnknownMT = packed record  { IUnknown method table }
    QueryInterface: function (const Self: IUnknown; const IID: TIID; var Obj: Pointer): HResult; stdcall;
    AddRef:         function (const Self: IUnknown): Integer; stdcall;
    Release:        function (const Self: IUnknown): Integer; stdcall;
  end;


const
  IID_IClassFactory: TIID = '{00000001-0000-0000-C000-000000000046}';

type
  IClassFactory    = ^PIClassFactoryMT;
  PIClassFactoryMT = ^TIClassFactoryMT;
  TIClassFactoryMT = packed record  { IClassFactory method table }
    case Integer of
      0: (
        { IUnknown methods }
        QueryInterface: function (const Self: IClassFactory;
          const IID: TIID; var Obj: Pointer): HResult; stdcall;
        AddRef:         function (const Self: IClassFactory): Integer; stdcall;
        Release:        function (const Self: IClassFactory): Integer; stdcall;
        { IClassFactory methods }
        CreateInstance: function (const Self: IClassFactory;
          const UnkOuter: IUnknown; const IID: TIID;
          var Obj: Pointer): HResult; stdcall;
        LockServer:     function (const Self: IClassFactory;
          fLock: Bool): HResult; stdcall;);

      1: (IUnknownMT: TIUnknownMT);
  end;


type
  IDataObject    = ^PIDataObjectMT;
  PIDataObjectMT = ^TIDataObjectMT;
  TIDataObjectMT = packed record  { IDataObject method table }
    case Integer of
      0: (
        { IUnknown methods }
        QueryInterface: function (const Self: IClassFactory;
          const IID: TIID; var Obj: Pointer): HResult; stdcall;
        AddRef:         function (const Self: IClassFactory): Integer; stdcall;
        Release:        function (const Self: IClassFactory): Integer; stdcall;
        { IDataObject methods }
        GetData: function (const Self: IDataObject; const formatetcIn: TFormatEtc;
          var medium: TStgMedium): HResult; stdcall;
        // This is cheating here, a bit.  The remaining methods in IDataObject
        // are unused, so some work can be saved by defining only what is used.
        // And that's O.K. since the method table is identical to this point.
        {!!!--------------------------------------------------------------------
        GetDataHere: function (const Self: IDataObject;
          const formatetc: TFormatEtc; var medium: TStgMedium): HResult; stdcall;
        QueryGetData: function (const Self: IDataObject;
          const formatetc: TFormatEtc): HResult; stdcall;
        GetCanonicalFormatEtc: function (const Self: IDataObject;
          const formatetc: TFormatEtc; var formatetcOut: TFormatEtc): HResult;
          stdcall;
        SetData: function (const Self: IDataObject; const formatetc: TFormatEtc;
          var medium: TStgMedium; fRelease: BOOL): HResult; stdcall;
        EnumFormatEtc: function (const Self: IDataObject; dwDirection: Longint;
          var enumFormatEtc: IEnumFormatEtc): HResult; stdcall;
        DAdvise: function (const Self: IDataObject; const formatetc: TFormatEtc;
          advf: Longint; const advSink: IAdviseSink; var dwConnection: Longint):
          HResult; stdcall;
        DUnadvise: function (const Self: IDataObject; dwConnection: Longint):
          HResult; stdcall;
        EnumDAdvise: function (const Self: IDataObject;
          var enumAdvise: IEnumStatData): HResult; stdcall;
        --------------------------------------------------------------------!!!}
        );

      1: (IUnknownMT: TIUnknownMT);
  end;


const
  IID_IShellExtInit: TIID = '{000214E8-0000-0000-C000-000000000046}';

type
  IShellExtInit    = ^PIShellExtInitMT;
  PIShellExtInitMT = ^TIShellExtInitMT;
  TIShellExtInitMT = packed record   { IShellExtInit method table }
    case Integer of
      0: (
        { IUnknown methods }
        QueryInterface: function (const Self: IShellExtInit;
          const IID: TIID; var Obj: Pointer): HResult; stdcall;
        AddRef:         function (const Self: IShellExtInit): Integer; stdcall;
        Release:        function (const Self: IShellExtInit): Integer; stdcall;
        { IShellExtInit methods }
        Initialize: function (const Self: IShellExtInit;
          pidlFolder: PItemIDList; lpdobj: IDataObject; hKeyProgID: HKEY):
          HResult; stdcall;);

      1: (IUnknownMT: TIUnknownMT);
  end;


const
  IID_IContextMenu: TIID = '{000214E4-0000-0000-C000-000000000046}';

type
  IContextMenu    = ^PIContextMenuMT;
  PIContextMenuMT = ^TIContextMenuMT;
  TIContextMenuMT = packed record  { IContextMenu method table }
    case Integer of
      0: (
        { IUnknown methods }
        QueryInterface: function (const Self: IContextMenu;
          const IID: TIID; var Obj: Pointer): HResult; stdcall;
        AddRef:         function (const Self: IContextMenu): Integer; stdcall;
        Release:        function (const Self: IContextMenu): Integer; stdcall;
        { IContextMenu methods }
        QueryContextMenu: function (const Self: IContextMenu; Menu: HMENU;
          indexMenu, idCmdFirst, idCmdLast, uFlags: UINT): HResult; stdcall;
        InvokeCommand:    function (const Self: IContextMenu;
          var lpici: TCMInvokeCommandInfo): HResult; stdcall;
        GetCommandString: function (const Self: IContextMenu;
          idCmd, uType: UINT; pwReserved: PUINT; pszName: LPSTR;
          cchMax: UINT): HResult; stdcall;);

      1: (IUnknownMT: TIUnknownMT);
  end;


const
  CLSIDString_QuickRegister = '{40E69241-5D1A-11D1-81CB-0020AF3E97A9}';
  CLSIDStr                  = 'CLSID\' + CLSIDString_QuickRegister;

  CLSID_QuickRegister: TCLSID = CLSIDString_QuickRegister;


type
  PClassFactory = ^TClassFactory;
  TClassFactory = PIClassFactoryMT;

  PContextMenu = ^TContextMenu;
  TContextMenu = record
    CMMTAddr:  PIContextMenuMT;
    SEIMTAddr: PIShellExtInitMT;
    RefCount:  Integer;
    FileName:  String;
  end;

var
  ClassFactoryMT: TIClassFactoryMT;
  ContextMenuMT:  TIContextMenuMT;
  ShellExtInitMT: TIShellExtInitMT;

  ClassFactory: TClassFactory;

  ServerLockCount: Integer = 0;

{ COM Runtime support }

function IsEqual_IID(const iid1, iid2: TIID): Boolean;
asm
        PUSH    EDI
        PUSH    ESI
        MOV     ESI,EAX
        MOV     EDI,EDX
        MOV     ECX,4
        XOR     EAX,EAX
        REPE    CMPSD
        JNZ     @@1
        INC     EAX
@@1:    POP     ESI
        POP     EDI
end;

function DllGetClassObject(const CLSID: TCLSID; const IID: TIID;
  var Obj: Pointer): HResult; stdcall;
begin
  // Validate the output address.
  if @Obj = nil then begin
    Result := E_POINTER;
    Exit
  end;

  // Assume failure.
  Obj := nil;
  Result := CLASS_E_CLASSNOTAVAILABLE;

  if IsEqual_IID(CLSID, CLSID_QuickRegister) then //if IsEqualCLSID(CLSID, CLSID_QuickRegister) then
    Result := ClassFactory^.QueryInterface(@ClassFactory, IID, Obj)
end;

function DllCanUnloadNow: HResult; stdcall;
begin
  if (ServerLockCount <> 0) then
    Result := S_FALSE
  else
    Result := S_OK
end;

function DllRegisterServer: HResult; stdcall;
var
  FileName: array [0..MAX_PATH] of Char;
  RootKey: HKey;

  procedure CreateKey(const Key, ValueName, Value: string);
  var
    Handle: HKey;
    Res,
    Disposition: Integer;
  begin
    Res := RegCreateKeyEx(RootKey, PChar(Key), 0, '',
      REG_OPTION_NON_VOLATILE, KEY_READ or KEY_WRITE, nil, Handle, @Disposition);
    if Res = 0 then begin
      Res := RegSetValueEx(Handle, PChar(ValueName), 0,
        REG_SZ, PChar(Value), Length(Value) + 1);
      RegCloseKey(Handle)
    end;
    if Res <> 0 then
      raise Exception.Create('Error updating registry')
  end;

begin
  try
    RootKey := HKEY_CLASSES_ROOT;
    CreateKey(CLSIDStr, '', 'Quick Register Context Menu Shell Extension');

    GetModuleFileName(HInstance, FileName, SizeOf(FileName));
    CreateKey(CLSIDStr + '\InprocServer32', '', FileName);
    CreateKey(CLSIDStr + '\InprocServer32', 'ThreadingModel', 'Apartment');

    CreateKey('dllfile\shellex', '', '');
    CreateKey('dllfile\shellex\ContextMenuHandlers', '', '');
    CreateKey('dllfile\shellex\ContextMenuHandlers\QuickRegister', '',
      CLSIDString_QuickRegister);

    RootKey := HKEY_LOCAL_MACHINE;
    CreateKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions', '', '');
    CreateKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved',
      CLSIDString_QuickRegister, 'Quick Register Context Menu Shell Extension');
    Result := S_OK
  except
    DllUnregisterServer;
    Result := SELFREG_E_CLASS
  end
end;

function DllUnregisterServer: HResult; stdcall;

  procedure DeleteKey(const Key: string);
  begin
    RegDeleteKey(HKEY_CLASSES_ROOT, PChar(Key))
  end;

begin
  DeleteKey('dllfile\shellex\ContextMenuHandlers\QuickRegister');
  DeleteKey('dllfile\shellex\ContextMenuHandlers');
  DeleteKey('dllfile\shellex');
  DeleteKey(CLSIDStr + '\InprocServer32');
  DeleteKey(CLSIDStr);
  Result := S_OK
end;


{ IClassFactory - IUnknown methods}

function ClassFactory_QueryInterface(const Self: IUnknown; const IID: TIID;
  var Obj: Pointer): HResult; stdcall;
begin
  // Validate the output address.
  if @Obj = nil then begin
    Result := E_POINTER;
    Exit
  end;

  // Assume failure.
  Obj := nil;
  Result := E_NOINTERFACE;

  // Check for supported interfaces.
  if IsEqual_IID(IID, IID_IUnknown) or //IsEqualIID(IID, IID_IUnknown) or
     IsEqual_IID(IID, IID_IClassFactory) then begin //IsEqualIID(IID, IID_IClassFactory) then begin
    // Return the requested interface and AddRef.
    Obj := Self;
    IUnknown(Obj)^^.AddRef(Obj);
    Result := S_OK
  end
end;

function ClassFactory_AddRef(const Self: IUnknown): Integer; stdcall;
begin
  InterlockedIncrement(ServerLockCount);
  Result := 2
end;

function ClassFactory_Release(const Self: IUnknown): Integer; stdcall;
begin
  InterlockedDecrement(ServerLockCount);
  Result := 1
end;

{ IClassFactory - IClassFactory methods}

function ClassFactory_CreateInstance(const Self: IClassFactory;
  const UnkOuter: IUnknown; const IID: TIID;
  var Obj: Pointer): HResult; stdcall;
var
  pcm: PContextMenu;
begin
  // Validate the output address.
  if @Obj = nil then begin
    Result := E_POINTER;
    Exit
  end;

  // Assume failure.
  Obj := nil;

  // This object does not support aggregation.
  if Assigned(UnkOuter) then begin
    Result := CLASS_E_NOAGGREGATION;
    Exit
  end;

  pcm := nil;
  try
    // Construct a ContextMenu object.
    New(pcm);
    FillChar(pcm^, SizeOf(pcm^), 0);
    with pcm^do begin
      CMMTAddr  := @ContextMenuMT;
      SEIMTAddr := @ShellExtInitMT;
      Result := CMMTAddr^.QueryInterface(@CMMTAddr, IID, Obj);
      if Succeeded(Result) then
        InterlockedIncrement(ServerLockCount)
      else
        Dispose(pcm)
    end
  except
    on E: EOutOfMemory do
      Result := E_OUTOFMEMORY
    else begin
      if Assigned(pcm) then
        Dispose(pcm);
      Result := E_FAIL
    end
  end
end;

function ClassFactory_LockServer(const Self: IClassFactory; fLock: Bool): HResult;
  stdcall;
begin
  if fLock then
    InterlockedIncrement(ServerLockCount)
  else
    InterlockedDecrement(ServerLockCount);
  Result := S_OK
end;


{ IContextMenu - IUnknown methods}

function ContextMenu_QueryInterface(const Self: IUnknown; const IID: TIID;
  var Obj: Pointer): HResult; stdcall;
begin
  // Validate the output address.
  if @Obj = nil then begin
    Result := E_POINTER;
    Exit
  end;

  // Assume failure.
  Obj := nil;
  Result := E_NOINTERFACE;

  // Check for supported interfaces.
  if IsEqual_IID(IID, IID_IUnknown) or //IsEqualIID(IID, IID_IUnknown) or
     IsEqual_IID(IID, IID_IContextMenu) or //IsEqualIID(IID, IID_IContextMenu) or
     IsEqual_IID(IID, IID_IShellExtInit) then //IsEqualIID(IID, IID_IShellExtInit) then
    // Return the requested interface and AddRef.
    with PContextMenu(Self)^ do begin
      if IsEqual_IID(IID, IID_IShellExtInit) then //IsEqualIID(IID, IID_IShellExtInit) then
        Obj := @SEIMTAddr
      else
        Obj := @CMMTAddr;

      IUnknown(Obj)^^.AddRef(Obj);
      Result := S_OK
    end
end;

function ContextMenu_AddRef(const Self: IUnknown): Integer; stdcall;
begin
  with PContextMenu(Self)^ do
    Result := InterlockedIncrement(RefCount)
end;

function ContextMenu_Release(const Self: IUnknown): Integer; stdcall;
begin
  with PContextMenu(Self)^ do begin
    Result := InterlockedDecrement(RefCount);
    if (Result = 0) then begin
      Dispose(PContextMenu(Self));
      InterlockedDecrement(ServerLockCount)
    end
  end
end;

{ IContextMenu - IContextMenu methods}

function ContextMenu_QueryContextMenu(const Self: IContextMenu; Menu: HMENU;
  indexMenu, idCmdFirst, idCmdLast, uFlags: UINT): HResult; stdcall;
begin
  Result := MakeResult(SEVERITY_SUCCESS, FACILITY_NULL, 0);
  if ((uFlags and $0000000F) = CMF_NORMAL) or
     ((uFlags and CMF_EXPLORE) <> 0) then begin

    InsertMenu(Menu, indexMenu, MF_SEPARATOR or MF_BYPOSITION, 0, nil);
    InsertMenu(Menu, indexMenu + 1, MF_STRING or MF_BYPOSITION, idCmdFirst,
      'Register');
    InsertMenu(Menu, indexMenu + 2, MF_STRING or MF_BYPOSITION, idCmdFirst + 1,
      'Unregister');
    InsertMenu(Menu, indexMenu + 3, MF_SEPARATOR or MF_BYPOSITION, 0, nil);

    Result := MakeResult(SEVERITY_SUCCESS, FACILITY_NULL, 2)
  end
end;

function ContextMenu_InvokeCommand(const Self: IContextMenu;
  var lpici: TCMInvokeCommandInfo): HResult; stdcall;
const
  ProcNames: array [0..1] of PChar =
    ('DllRegisterServer', 'DllUnregisterServer');
var
  pcm: PContextMenu absolute Self;
  Cmd: Word;

  procedure RegisterCOMServer;
  var
    Handle:  THandle;
    RegProc: function: HResult; stdcall;
    hr:      HResult;
  begin
    Handle := LoadLibrary(PChar(pcm^.FileName));
    if Handle = 0 then
      raise Exception.CreateFmt('%s: %s',
        [SysErrorMessage(GetLastError), pcm^.FileName]);
    try
      RegProc := GetProcAddress(Handle, ProcNames[Cmd]);
      if Assigned(RegProc) then begin
        hr := RegProc;
        if Failed(hr) then
          raise Exception.Create(
            ProcNames[Cmd] + ' in ' + pcm^.FileName + ' failed.')
      end
      else
        RaiseLastWin32Error
    finally
      FreeLibrary(Handle)
    end
  end;

begin
  Result := E_INVALIDARG;
  Cmd := LoWord(Integer(lpici.lpVerb));
  if (HiWord(Integer(lpici.lpVerb)) <> 0) or (not Cmd in [0..1]) then
    Exit;

  Result := E_FAIL;
  try
    RegisterCOMServer;
    MessageBox(lpici.hwnd,
      PChar(ProcNames[Cmd] + ' in ' + pcm^.FileName + ' succeeded!!'),
      'Quick Register', MB_ICONINFORMATION or MB_OK);
    Result := S_OK
  except
    on E: Exception do
      MessageBox(lpici.hWnd, PChar(E.Message), 'Quick Register - Error',
        MB_ICONERROR or MB_OK);
  end
end;

function ContextMenu_GetCommandString(const Self: IContextMenu;
  idCmd, uType: UINT; pwReserved: PUINT; pszName: LPSTR;
          cchMax: UINT): HResult; stdcall;
const
  RegStr: PChar = 'Register this COM/ActiveX server.';
  UnRegStr: PChar = 'Unregister this COM/ActiveX server.';
begin
  Result := S_OK;
  if uType = GCS_HELPTEXT then
    case idCmd of
      0: StrCopy(pszName, RegStr);
      1: StrCopy(pszName, UnRegStr)
      else
        Result := E_INVALIDARG
    end
end;


{ IShellExtInit - IUnknown methods }

function ShellExtInit_QueryInterface(const Self: IUnknown; const IID: TIID;
  var Obj: Pointer): HResult; stdcall;
var
  TrueSelf: IContextMenu;
begin
  // Fix up the pointer to the IContextMenu interface.
  TrueSelf := IContextMenu(Self);
  Dec(TrueSelf);

  // Delegate.
  Result := TrueSelf^^.QueryInterface(TrueSelf, IID, Obj)
end;

function ShellExtInit_AddRef(const Self: IUnknown): Integer; stdcall;
var
  TrueSelf: IContextMenu;
begin
  // Fix up the pointer to the IContextMenu interface.
  TrueSelf := IContextMenu(Self);
  Dec(TrueSelf);

  // Delegate.
  Result := TrueSelf^^.AddRef(TrueSelf)
end;

function ShellExtInit_Release(const Self: IUnknown): Integer; stdcall;
var
  TrueSelf: IContextMenu;
begin
  // Fix up the pointer to the IContextMenu interface.
  TrueSelf := IContextMenu(Self);
  Dec(TrueSelf);

  // Delegate.
  Result := TrueSelf^^.Release(TrueSelf)
end;


{ IShellExtInit - IShellExtInit.Initialize}

function ShellExtInit_Initialize(const Self: IShellExtInit;
  pidlFolder: PItemIDList; lpdobj: IDataObject; hKeyProgID: HKEY): HResult;
  stdcall;
var
  pcm:         PContextMenu;
  ContextMenu: IContextMenu absolute pcm;
  FormatETC:   TFormatEtc;
  StgMedium:   TStgMedium;
  szFile:      array [0..MAX_PATH] of Char;
begin
  if not Assigned(lpdobj) then begin
    Result := E_INVALIDARG;
    Exit
  end;

  // Fix up the pointer to the actual ContextMenu "object".
  ContextMenu := IContextMenu(Self);
  Dec(ContextMenu);

  with FormatETC do begin
    cfFormat := CF_HDROP;
    ptd      := nil;
    dwAspect := DVASPECT_CONTENT;
    lindex   := -1;
    tymed    := TYMED_HGLOBAL
  end;
  Result := E_FAIL;
  if Succeeded(lpdobj^^.GetData(lpdobj, FormatETC, StgMedium)) and
     (DragQueryFile(StgMedium.hGlobal, $FFFFFFFF, nil, 0) = 1) then begin
    DragQueryFile(StgMedium.hGlobal, 0, szFile, SizeOf(szFile));
    pcm^.FileName := szFile;
    ReleaseStgMedium(StgMedium);
    Result := S_OK
  end
end;


initialization
  // Setup the method table for each interface that is implemented.
  with ClassFactoryMT, IUnknownMT do begin
    QueryInterface := ClassFactory_QueryInterface;
    AddRef         := ClassFactory_AddRef;
    Release        := ClassFactory_Release;

    CreateInstance := ClassFactory_CreateInstance;
    LockServer     := ClassFactory_LockServer
  end;

  with ContextMenuMT, IUnknownMT do begin
    QueryInterface := ContextMenu_QueryInterface;
    AddRef         := ContextMenu_AddRef;
    Release        := ContextMenu_Release;

    QueryContextMenu := ContextMenu_QueryContextMenu;
    InvokeCommand    := ContextMenu_InvokeCommand;
    GetCommandString := ContextMenu_GetCommandString
  end;

  with ShellExtInitMT, IUnknownMT do begin
    QueryInterface := ShellExtInit_QueryInterface;
    AddRef         := ShellExtInit_AddRef;
    Release        := ShellExtInit_Release;

    Initialize     := ShellExtInit_Initialize
  end;

  // "Instantiate" the classfactory.
  ClassFactory := @ClassFactoryMT;

  DisableThreadLibraryCalls(hInstance)
end.
    

_________________
I don`t like to refer by "you" to one person.
My soul requires acronim "thou" instead.


Last edited by ProMiNick on 08 Jun 2019, 01:19; edited 2 times in total
Post 07 Jun 2019, 10:10
View user's profile Send private message Send e-mail Reply with quote
ProMiNick



Joined: 24 Mar 2012
Posts: 804
Location: Russian Federation, Sochi
ProMiNick 07 Jun 2019, 23:58
Sorry all who dramaticaly tests previos versions of that COM server.
Sorry for your registry.

This one should work. COM server version from 8/06/2019 4:00.

Ever first call to __RegCreateKeyWithValue (in DllRegisterServer) returns ERROR_BADKEY 1010 (0x3F2)
Post 07 Jun 2019, 23:58
View user's profile Send private message Send e-mail Reply with quote
ProMiNick



Joined: 24 Mar 2012
Posts: 804
Location: Russian Federation, Sochi
ProMiNick 09 Jun 2019, 12:23
Atlast I teach program to write to registry
Code:
__RegCreateKeyWithValue: procedure(lpSubKey,lpValueName,lpData)

        ; calc length of Pchar(edi) to ecx
        cld
        mov     edi, [lpData+espFixer]
        mov     ecx, -1
        xor     eax, eax
        repne   scasb
        not     ecx
        sub     edi, ecx

        prepare RegSetValueEx, eax, [lpValueName+espFixer], eax, REG_SZ, edi, ecx
        ;invoke  RegCreateKey, [RootKey], [lpSubKey+espFixer], esp ; working on XP and below version used instead of next two lines; need testing for win10
        mov     edi, esp
        invoke  RegCreateKeyEx, [RootKey], [lpSubKey+espFixer], eax, eax, REG_OPTION_NON_VOLATILE, KEY_READ or KEY_WRITE, eax, edi, eax
        test    eax, eax
        jnz     .unstack
        invoke  RegSetValueEx; stack prepared with prepare
        if espFixer
                espFixer=espFixer-$18
        end if
        mov     edi, eax
        sub     esp, 24       ; again stack is ready
        invoke  RegCloseKey
        mov     eax,edi
        add     esp, 20
        jmp     .locret
      .unstack:
        unstack RegSetValueEx,hKey,lpValueName,Reserved,dwType,lpData,cbData
      .locret:
        ret
endp

DllRegisterServer: procedure()
        push    edi
        mov     [RootKey], HKEY_CLASSES_ROOT
        stdcall __RegCreateKeyWithValue, CLSIDStr, NullStr, CLSIDDescription
        test    eax, eax
        jnz     .unregister1
        invoke  GetModuleFileName, [hInstance], REGFileName, 261
        test    eax, eax
        jz      .unregister
        stdcall __RegCreateKeyWithValue, CLSIDInprocServer, NullStr, REGFileName
        test    eax, eax
        jnz     .unregister
        stdcall __RegCreateKeyWithValue, CLSIDInprocServer, ThreadingModelStr, ApartmentStr
        test    eax, eax
        jnz     .unregister
        stdcall __RegCreateKeyWithValue, dllfile_shellex_Str, NullStr, NullStr
        test    eax, eax
        jnz     .unregister
        stdcall __RegCreateKeyWithValue, dllfile_shellex_CMH_Str, NullStr, NullStr
        test    eax, eax
        jnz     .unregister
        stdcall __RegCreateKeyWithValue, dllfile_shellex_CMH_QR_Str, NullStr, CLSIDString_QuickRegister
        test    eax, eax
        jnz     .unregister
        mov     [RootKey], HKEY_LOCAL_MACHINE
        stdcall __RegCreateKeyWithValue, cur_vers_shellex_Str, NullStr, NullStr
        test    eax, eax
        jnz     .ret_S_FALSE
        stdcall __RegCreateKeyWithValue, cur_vers_shellex_approv_Str, CLSIDString_QuickRegister, CLSIDDescription
        jmp     .locret
      .ret_S_FALSE:
        xor     eax, eax
        inc     eax
        jmp     .locret
      .unregister1:
        cinvoke wsprintf, REGFileName, fmtInt, eax ; catch what error,
      .unregister:
        stdcall DllUnregisterServer
        invoke  MessageBox, 0, Error_updating_registry, REGFileName, MB_ICONERROR or MB_OK
        mov     eax, SELFREG_E_CLASS
      .locret:
        pop     edi
        ret
endp     


changes are:
fix param [esp+4] with addr esp+4, I stored it in edi
improvement preserving of edi from each call of __RegCreateKeyWithValue to once to outer DllRegisterServer.

So registration & unregistration for now works correct. (for 32 bit systems) (from WoW32 on 64 still don`t work)
Menu lines still not appeared.

Attachment in 1st post updated according to bugfixies.
Post 09 Jun 2019, 12:23
View user's profile Send private message Send e-mail Reply with quote
ProMiNick



Joined: 24 Mar 2012
Posts: 804
Location: Russian Federation, Sochi
ProMiNick 13 Jun 2019, 21:40
While I still can`t find what is wrong with fasmed COM server - I back to analize, recompiling & reversing donor.
I found that InsertMenu trashes ecx & edx - so I used other preserved registers esi & edi in ContextMenu@QueryContextMenu.

attachment in 1st post updated - but not much changes (few bugfixies in ContextMenu@QueryInterface & in ContextMenu@QueryContextMenu but all still don`t work - crash at trying to cast context menu over any dll).


Description: I remove almoust all dependencyes from donor sources.
they shrinked from 47kb down to 45 kb. I`m on a way to cut off dependency from largest unit SysUtils. HLL code partialy replaced by assembler one.

Download
Filename: without exeptions & strings.zip
Filesize: 66.71 KB
Downloaded: 640 Time(s)


_________________
I don`t like to refer by "you" to one person.
My soul requires acronim "thou" instead.
Post 13 Jun 2019, 21:40
View user's profile Send private message Send e-mail Reply with quote
ProMiNick



Joined: 24 Mar 2012
Posts: 804
Location: Russian Federation, Sochi
ProMiNick 14 Jun 2019, 05:42
Atlast I completely remove SysUtils dependencyes: so size of resultive donor dll is more shrinked down to 20kb. (much closed to pure assembly)

allocation procs that are used based on borland memory manager, so If replace them with heapalloc,heaprealloc,heapfree - size should shrink ever more.

But that is thing I not completely understand(how to create my own mem manager based on pure winapi - that not in all cases allocation needed, simetime previous allocs allocated more than enought so in this case should be returned pointer on free already allocated space, and space accessible for such needs should be shrinked by amount of pseudo allocated).


Description:
Download
Filename: without SysUtils.zip
Filesize: 52.96 KB
Downloaded: 676 Time(s)


_________________
I don`t like to refer by "you" to one person.
My soul requires acronim "thou" instead.
Post 14 Jun 2019, 05:42
View user's profile Send private message Send e-mail Reply with quote
revolution
When all else fails, read the source


Joined: 24 Aug 2004
Posts: 20445
Location: In your JS exploiting you and your system
revolution 14 Jun 2019, 06:25
ProMiNick wrote:
But that is thing I not completely understand(how to create my own mem manager based on pure winap ...
Windows API has GlobalAlloc and LocalAlloc (which are the same thing from what I understand), and the associated *ReAlloc and *Free

Plus there are the Heap* APIs.

All are found in kernel32.dll
Post 14 Jun 2019, 06:25
View user's profile Send private message Visit poster's website Reply with quote
ProMiNick



Joined: 24 Mar 2012
Posts: 804
Location: Russian Federation, Sochi
ProMiNick 14 Jun 2019, 10:05
Thanks, revolution. (I forgot that there is no needance in mem manager - it is demonstration - so no needance in memory economy of allocated blocks: for every couple of bytes block separate 4kb space).
Donor code now is all based on winapi.
I`ll continue playing with it (zeroing code rudiments of HLL & noping unsufficient calls of initialization state.


Description:
Download
Filename: without SysUtils.zip
Filesize: 24.95 KB
Downloaded: 651 Time(s)


_________________
I don`t like to refer by "you" to one person.
My soul requires acronim "thou" instead.
Post 14 Jun 2019, 10:05
View user's profile Send private message Send e-mail Reply with quote
ProMiNick



Joined: 24 Mar 2012
Posts: 804
Location: Russian Federation, Sochi
ProMiNick 16 Jun 2019, 01:10
sources are same but patched - skipped all HLL initialization.

Code:
                 add     esp,-$3C    

replaced with
Code:
                 push    esi
                 jmp     short loc_40491D    


and patch is pic (so no needance to patch relocations):
Code:
CODE:00404908 ; BOOL __stdcall DllEntryPoint(HINSTANCE hinstDLL, DWORD fdwReason, LPVOID lpReserved)
CODE:00404908                 public DllEntryPoint
CODE:00404908 DllEntryPoint   proc near               ; DATA XREF: HEADER:00400128o
CODE:00404908
CODE:00404908 hinstDLL        = dword ptr  8
CODE:00404908 fdwReason       = dword ptr  0Ch
CODE:00404908
CODE:00404908                 push    ebp
CODE:00404909                 mov     ebp, esp
CODE:0040490B                 push    esi
CODE:0040490C                 jmp     short loc_40491D
CODE:0040490E ; ---------------------------------------------------------------------------
CODE:0040490E                 mov     eax, offset InitTable
CODE:00404913                 call    @Sysinit@@InitLib$qqrv ; Sysinit::__linkproc__ InitLib(void)
CODE:00404918                 call    @System@@Halt0$qqrv ; System::__linkproc__ Halt0(void)
CODE:0040491D
CODE:0040491D loc_40491D:                             ; CODE XREF: DllEntryPoint+4j
CODE:0040491D                 cmp     [ebp+fdwReason], 1
CODE:00404921                 jnz     short loc_40494C
CODE:00404923                 call    $+5
CODE:00404928                 pop     esi
CODE:00404929                 mov     ecx, [ebp+hinstDLL]
CODE:0040492C                 mov     ds:(HInstance - 404928h)[esi], ecx
CODE:00404932                 push    ecx             ; hLibModule
CODE:00404933                 call    DisableThreadLibraryCalls
CODE:00404938                 push    0               ; dwMaximumSize
CODE:0040493A                 push    1000h           ; dwInitialSize
CODE:0040493F                 push    1               ; flOptions
CODE:00404941                 call    HeapCreate
CODE:00404946                 mov     ds:(hHeap - 404928h)[esi], eax
CODE:0040494C
CODE:0040494C loc_40494C:                             ; CODE XREF: DllEntryPoint+19j
CODE:0040494C                 pop     esi
CODE:0040494D                 xor     eax, eax
CODE:0040494F                 inc     eax
CODE:00404950                 pop     ebp
CODE:00404951                 retn    0Ch
CODE:00404951 DllEntryPoint   endp    


and virtual size of code section increased from $3920 to $3960.

As result dll is workable - so is left to represent same code in new addresses so way that it fit 6 kb - what is initialy expected.


Description: HLL stuff skipped - only pure winapi (no source) - that is patch of previous sources.
Download
Filename: COMSERVEXAMPLE - hll.zip
Filesize: 11.01 KB
Downloaded: 632 Time(s)


_________________
I don`t like to refer by "you" to one person.
My soul requires acronim "thou" instead.
Post 16 Jun 2019, 01:10
View user's profile Send private message Send e-mail Reply with quote
ProMiNick



Joined: 24 Mar 2012
Posts: 804
Location: Russian Federation, Sochi
ProMiNick 16 Jun 2019, 21:26
once Delphi compiled qregister2, than fasm clears all unneeded & patched initialization (In previous version ContextMenu_InvokeCommand used HLL - now is not!)
fasm:
Code:
format binary as 'dll'
use32

label hInstance at $406650

file 'qregister2.dll':0,$4EC
db $2CA4-$4EC dup (0)
file 'qregister2.dll':$2CA4,$2CBB-$2CA4
db $2CF4-$2CBB dup (0)
file 'qregister2.dll':$2CF4,$39D1-$2CF4

org $4045D1
DllEntryChunk:
        mov     [hInstance], eax

file 'qregister2.dll':$39D6,$3A7C-$39D6

        dd      ..nop_jump
DllEntryPoint:
        label   .hinstDLL       at esp+4
        label   .fdwReason      at esp+8
        label   .lpReserved     at esp+$C
        cmp     dword[.fdwReason], 1;ATTACH PROC
        jmp     dword[DllEntryPoint-4] ; address is relocationed - sop nop as indirect jump to next instruction is perfect
..nop_jump:
        jnz     .ret_TRUE
        mov     eax, dword[.hinstDLL]
        call    DllEntryChunk
      .ret_TRUE:
        xor     eax, eax
        inc     eax
        ret     $0C
file 'qregister2.dll':$3A9C,$4E00-$3A9C      


In output still fully working COM.

I so many times comparing disassembled HLL code of 24 functions - only they left & valid with my 23 functions - looks same. And it is sad(

I suppose that if regsvr32 messaging about successful registration & unregistration & corresponding values moved to and out of registry - than DLL is valid COMServer and its registration functions works.

Explorer with that registered COM crashed at right click on any file or group of files - so ShellExtInit@Initialize - is filtering what objects operate & what don`t. (In case where error would be in ContextMenu methods - explorer would crash only on right clicking single dll - ContextMenu@QueryContextMen, if menu would displayed and crash would be at menu hovering -ContextMenu@GetCommandString, if crash would be after clicking menu - ContextMenu@InvokeCommand.

So not many places where error could be... - but I still can`t found it.

May be error even earlier in QRClassFactory@CreateInstance - but it code fully identical with only one difference esp framing vs ebp.

I even rewrite Fasm version to deal with heap object instead of data direct coded one:
Code:
; Component Object Model usage demonstration

format PE GUI 4.0 dll
entry DllEntryPoint

include 'win32a.inc'

include 'generic/macro/guid.inc'
include 'os specific/windows/interfaces/base.inc'
include 'os specific/windows/interfaces/shell.inc'
;include 'os specific/windows/equates/com.inc'

include 'myESPprocSyntax.inc'


CMF_EXPLORE                     = 4
GCS_HELPTEXT                    = $00000001
CF_HDROP                        = 15
DVASPECT_CONTENT                = 1
TYMED_HGLOBAL                   = 1
;COM errors
E_NOINTERFACE                   = $80004002
E_POINTER                       = $80004003
E_FAIL                          = $80004005
CLASS_E_NOAGGREGATION           = $80040110
CLASS_E_CLASSNOTAVAILABLE       = $80040111
SELFREG_E_CLASS                 = $80040201
E_OUTOFMEMORY                   = $8007000E
E_INVALIDARG                    = $80070057
HEAP_NO_SERIALIZE               = 1

macro precmpGUID {
        push    esi
        push    edi }

macro postcmpGUID {
        pop     edi
        pop     esi }

macro cmpGUID A, B {
        mov     esi, A
        mov     edi, B
        mov     ecx, 4
        repe    cmpsd }

macro prepare dummy,[arg]
 { common
        if ~ arg eq
   reverse
                pushd arg
   common
        end if }

macro unstack dummy,[arg]
 { common local counter
        if ~ arg eq
                counter = 0
   forward
                counter = counter + 1
   common
                add     esp, counter*4
        end if }

struct CMINVOKECOMMANDINFO
        cbSize          dd ?
        fMask           dd ?
        hwnd            dd ?
        lpVerb          dd ?
        lpParameters    dd ?
        lpDirectory     dd ?
        nShow           dd ?
        dwHotKey        dd ?
        hIcon           dd ?
ends

struct FORMATETC
        union
                cfFormat        dw ?
                                dd ?
        ends
        ptd                     dd ?
        dwAspect                dd ?
        lindex                  dd ?
        tymed                   dd ?
ends

struct STGMEDIUM
        tymed                           dd ?
        union
                struct
                        hBitmap         dd ?
                        unkForRelease   dd ?
                ends
                hMetaFilePict           dd ?
                hEnhMetaFile            dd ?
                hGlobal                 dd ?
                lpszFileName            dd ?
                stm                     dd ?
                stg                     dd ?
        ends
ends

section '.text' code readable executable

DllEntryPoint: procedure(hinstDLL,fdwReason,lpvReserved) ;verified
        mov     eax, [fdwReason+espFixer]
        cmp     eax, 1
        jne     .retTRUE
        mov     eax, [hinstDLL+espFixer]
        mov     [hInstance],eax
        invoke  DisableThreadLibraryCalls, eax
        invoke  HeapCreate,HEAP_NO_SERIALIZE,$1000,0
        mov     [pHeap],eax
      .retTRUE:
        xor     eax, eax
        inc     eax
        ret
endp

DllGetClassObject: procedure(rclsid,riid,ppv) ;verified; returned requested ClassFactory!!! not COMobject itself
        push    ebx
        mov     ebx, [ppv+espFixer]
        test    ebx, ebx
        jz      .ret_E_POINTER
        xor     eax, eax
        mov     [ebx], eax

        precmpGUID                            ; search ClassFactory corresponded to rclsid
        cld
        cmpGUID [rclsid+espFixer],CLSID_QuickRegister
        postcmpGUID

        jnz     .ret_CLASS_E_CLASSNOTAVAILABLE
        cominvk QRClassFactory_COMobject,QueryInterface,[riid+espFixer],ebx
        jmp     .locret
      .ret_E_POINTER:
        mov     eax, E_POINTER
        jmp     .locret
      .ret_CLASS_E_CLASSNOTAVAILABLE:
        mov     eax, CLASS_E_CLASSNOTAVAILABLE
      .locret:
        pop     ebx
        ret
endp

DllCanUnloadNow: procedure() ;verified
        xor     eax,eax
        cmp     eax,[ServerLockCount]
        jz      .locret
        inc     eax
      .locret:
        ret
endp

__RegCreateKeyWithValue: procedure(lpSubKey,lpValueName,lpData) ;verified

        ; calc length of Pchar(edi) to ecx
        cld
        mov     edi, [lpData+espFixer]
        mov     ecx, -1
        xor     eax, eax
        repne   scasb
        not     ecx
        sub     edi, ecx

        prepare RegSetValueEx, eax, [lpValueName+espFixer], eax, REG_SZ, edi, ecx
        ;invoke  RegCreateKey, [RootKey], [lpSubKey+espFixer], esp ; working on XP and below version used instead of next two lines; need testing for win10
        mov     edi, esp
        invoke  RegCreateKeyEx, [RootKey], [lpSubKey+espFixer], eax, eax, REG_OPTION_NON_VOLATILE, KEY_READ or KEY_WRITE, eax, edi, eax
        test    eax, eax
        jnz     .unstack
        invoke  RegSetValueEx; stack prepared with prepare
        if espFixer
                espFixer=espFixer-$18
        end if
        mov     edi, eax
        sub     esp, 24       ; again stack is ready
        invoke  RegCloseKey
        mov     eax,edi
        add     esp, 20
        jmp     .locret
      .unstack:
        unstack RegSetValueEx,hKey,lpValueName,Reserved,dwType,lpData,cbData
      .locret:
        ret
endp

DllRegisterServer: procedure() ;verified
        push    edi
        mov     [RootKey], HKEY_CLASSES_ROOT
        stdcall __RegCreateKeyWithValue, CLSIDStr, NullStr, CLSIDDescription
        test    eax, eax
        jnz     .unregister1
        invoke  GetModuleFileName, [hInstance], REGFileName, 261
        test    eax, eax
        jz      .unregister
        stdcall __RegCreateKeyWithValue, CLSIDInprocServer, NullStr, REGFileName
        test    eax, eax
        jnz     .unregister
        stdcall __RegCreateKeyWithValue, CLSIDInprocServer, ThreadingModelStr, ApartmentStr
        test    eax, eax
        jnz     .unregister
        stdcall __RegCreateKeyWithValue, dllfile_shellex_Str, NullStr, NullStr
        test    eax, eax
        jnz     .unregister
        stdcall __RegCreateKeyWithValue, dllfile_shellex_CMH_Str, NullStr, NullStr
        test    eax, eax
        jnz     .unregister
        stdcall __RegCreateKeyWithValue, dllfile_shellex_CMH_QR_Str, NullStr, CLSIDString_QuickRegister
        test    eax, eax
        jnz     .unregister
        mov     [RootKey], HKEY_LOCAL_MACHINE
        stdcall __RegCreateKeyWithValue, cur_vers_shellex_Str, NullStr, NullStr
        test    eax, eax
        jnz     .ret_S_FALSE
        stdcall __RegCreateKeyWithValue, cur_vers_shellex_approv_Str, CLSIDString_QuickRegister, CLSIDDescription
        jmp     .locret
      .ret_S_FALSE:
        xor     eax, eax
        inc     eax
        jmp     .locret
      .unregister1:
        cinvoke wsprintf, REGFileName, fmtInt, eax ; catch what error,
      .unregister:
        stdcall DllUnregisterServer
        invoke  MessageBox, 0, Error_updating_registry, REGFileName, MB_ICONERROR or MB_OK
        mov     eax, SELFREG_E_CLASS
      .locret:
        pop     edi
        ret
endp

DllUnregisterServer: procedure() ;verified
        mov     [RootKey], HKEY_CLASSES_ROOT
        invoke  RegDeleteKey, [RootKey], dllfile_shellex_CMH_QR_Str
        invoke  RegDeleteKey, [RootKey], dllfile_shellex_CMH_Str
        invoke  RegDeleteKey, [RootKey], dllfile_shellex_Str
        invoke  RegDeleteKey, [RootKey], CLSIDInprocServer
        invoke  RegDeleteKey, [RootKey], CLSIDStr
        ret
endp

QRClassFactory@QueryInterface: procedure(Self,riid,ppvObject) ;verified
        push    ebx
        mov     ebx, [ppvObject+espFixer]
        test    ebx, ebx
        jz      .ret_E_POINTER
        xor     eax, eax
        mov     [ebx], eax

        precmpGUID
        cld
        cmpGUID [riid+espFixer],IID_IUnknown
        je      .cmp_done
        cmpGUID [riid+espFixer],IID_IClassFactory
      .cmp_done:
        postcmpGUID

        jnz     .ret_E_NOINTERFACE
        mov     eax, [Self+espFixer]
        mov     [ebx], eax
        comcall eax, IClassFactory, AddRef
        xor     eax, eax
        jmp     .locret
      .ret_E_POINTER:
        mov     eax, E_POINTER
        jmp     .locret
      .ret_E_NOINTERFACE:
        mov     eax, E_NOINTERFACE
      .locret:
        pop     ebx
        ret
endp

QRClassFactory@AddRef: procedure(Self) ;verified
        invoke  InterlockedIncrement, ServerLockCount
        mov     eax, 2
        ret
endp

QRClassFactory@Release: procedure(Self) ;verified
        invoke  InterlockedDecrement, ServerLockCount
        xor     eax, eax
        inc     eax
        ret
endp

QRClassFactory@CreateInstance: procedure(Self,pUnkOuter,riid,ppvObject) ;verified
        push    ebx
        mov     ebx, [ppvObject+espFixer]
        test    ebx, ebx
        jz      .ret_E_POINTER
        xor     eax, eax
        mov     [ebx], eax

        mov     eax, [pUnkOuter+espFixer]
        test    eax, eax
        jnz     .ret_CLASS_E_NOAGGREGATION

        invoke  HeapAlloc,[pHeap], 0, sizeof.current_COMobject
        test    eax, eax
        jz      .ret_E_OUTOFMEMORY
        push    eax
        mov     [eax+current_COMobject.CM], ContextMenu
        mov     [eax+current_COMobject.SE], ShellExtInit
        mov     [eax+current_COMobject.RefCount], 0
        invoke  HeapAlloc, [pHeap], 0, 261
        push    eax
        test    eax, eax
        jnz     .continue_init
        push    [pHeap]
        call    [HeapFree]
        jmp     .ret_E_OUTOFMEMORY
        espFixer = espFixer - 4
      .continue_init:
        mov     edx, [esp+4]
        mov     [edx+current_COMobject.lpFileName], eax
        mov     dword[eax], 0 ; ensure that heap zeroinit 1st char
        comcall [edx+current_COMobject.CM],IUnknown,QueryInterface,[riid+espFixer],ebx
        cmp     eax, 0
        jae     .continue_init2
        push    0
        push    [pHeap]
        call    [HeapFree]
        push    0
        push    [pHeap]
        call    [HeapFree]
        jmp     .ret_E_FAIL
        espFixer = espFixer - 16
      .continue_init2:
        add     esp, 8
        invoke  InterlockedIncrement, ServerLockCount
        jmp     .locret
      .ret_E_POINTER:
        mov     eax, E_POINTER
        jmp     .locret
      .ret_CLASS_E_NOAGGREGATION:
        mov     eax, CLASS_E_NOAGGREGATION
        jmp     .locret
      .ret_E_OUTOFMEMORY:
        mov     eax, E_OUTOFMEMORY
        jmp     .locret
      .ret_E_FAIL:
        mov     eax, E_FAIL
      .locret:
        pop     ebx
        ret
endp
; for single instance object
; we don`t need to allocate memory for every Instance
; we don`t need to check if allocation is out of memory and resulting E_OUTOFMEMORY
; we don`t need to initialize COM object in runtime
; we don`t need to check success of QueryInterface and to free object occuped memory in bad cases
;        cominvk QuickRegister_COMobject.CM,QueryInterface,[riid+espFixer],ebx
;        cmp     eax,0
;        jl      .ret_E_FAIL
;        invoke  InterlockedIncrement, ServerLockCount
;        jmp     .locret
;
;      .ret_E_POINTER:
;        mov     eax, E_POINTER
;        jmp     .locret
;      .ret_CLASS_E_NOAGGREGATION:
;        mov     eax, CLASS_E_NOAGGREGATION
;        jmp     .locret
;      .ret_E_FAIL:
;        mov     eax, E_FAIL
;      .locret:
;        pop     ebx
;        ret
;endp

QRClassFactory@LockServer: procedure(Self,fLock) ;verified
        mov     eax,[fLock+espFixer]
        lea     eax,[.interlocked+eax*4]
        invoke  eax, ServerLockCount
        xor     eax, eax
        ret
      .interlocked:
        dd      InterlockedDecrement
        dd      InterlockedIncrement
endp

ContextMenu@QueryInterface: procedure(Self,riid,ppvObject) ;verified
        push    ebx
        mov     ebx, [ppvObject+espFixer]
        test    ebx, ebx
        jz      .ret_E_POINTER
        xor     eax, eax
        mov     [ebx], eax
        mov     eax, [Self+espFixer]
        precmpGUID
        cld
        cmpGUID [riid+espFixer],IID_IUnknown
        je      .cmp_done
        cmpGUID [riid+espFixer],IID_IContextMenu
        je      .cmp_done
        cmpGUID [riid+espFixer],IID_IShellExtInit
        jne     .cmp_done
        lea     eax, [eax+4]
      .cmp_done:
        postcmpGUID

        jnz     .ret_E_NOINTERFACE
        mov     [ebx], eax
        comcall eax, IUnknown, AddRef
        xor     eax, eax
        jmp     .locret
      .ret_E_POINTER:
        mov     eax, E_POINTER
        jmp     .locret
      .ret_E_NOINTERFACE:
        mov     eax, E_NOINTERFACE
      .locret:
        pop     ebx
        ret
endp

ContextMenu@AddRef: procedure(Self) ;verified
        mov     eax, [Self+espFixer]
        add     eax, current_COMobject.RefCount
        invoke  InterlockedIncrement, eax
        ret
endp

ContextMenu@Release: procedure(Self) ;verified
        mov     eax, [Self+espFixer]
        add     eax, current_COMobject.RefCount
        invoke  InterlockedDecrement, eax
        test    eax, eax
        jnz     .locret
        mov     eax, [Self+espFixer]
        push    eax
        invoke  HeapFree, [pHeap], 0, [eax+current_COMobject.lpFileName]
        push    0
        call    [HeapFree]
        invoke  InterlockedDecrement, ServerLockCount
        xor     eax, eax
      .locret:
        ret
endp

ContextMenu@QueryContextMenu: procedure(Self,Menu,indexMenu,idCmdFirst,idCmdLast,uFlags) ;verified
        mov     eax, [uFlags+espFixer]
        and     eax, $F
        jz      .handle
        test    eax, CMF_EXPLORE
        jnz     .ret_S_OK
      .handle:
        push    ebx
        push    esi
        push    edi
        mov     ebx, [Menu+espFixer]
        mov     esi, [indexMenu+espFixer]
        mov     edi, [idCmdFirst+espFixer]
        invoke  InsertMenu, ebx, esi, MF_SEPARATOR or MF_BYPOSITION, 0, 0
        inc     esi
        invoke  InsertMenu, ebx, esi, MF_STRING or MF_BYPOSITION, edi, registerStr
        inc     esi
        inc     edi
        invoke  InsertMenu, ebx, esi, MF_STRING or MF_BYPOSITION, edi, unregisterStr
        inc     esi
        invoke  InsertMenu, ebx, esi, MF_SEPARATOR or MF_BYPOSITION, 0, 0
        mov     eax, 2
        pop     edi
        pop     esi
        pop     ebx
        jmp     .locret
      .ret_S_OK:
        xor     eax, eax
      .locret:
        ret
endp

RegisterCOMServer: procedure(dll_proc,hwnd,dll_file) ;verified - value inversed from original
        invoke  LoadLibrary, [dll_file+espFixer]
        test    eax, eax
        jz      .ret_S_FALSE
        push    eax
        invoke  GetProcAddress, eax, [dll_proc+espFixer]
        test    eax, eax
        jnz     .call
      .ret_S_FALSE_n_FREE:
        invoke  FreeLibrary
        xor     eax, eax
        jmp     .ret_S_FALSE
      .call:
        call    eax
        cmp     eax, 0
        jl      .ret_S_FALSE_n_FREE
        invoke  FreeLibrary
        xor     eax, eax
        jmp     .locret
      .ret_S_FALSE:
        inc     eax
      .locret:
        ret 0
endp

MessagingInvokeCommand: procedure(fmt,fError,ProcName,hwnd,Filename) ;verified
        cinvoke wsprintf, Buffer, [fmt+espFixer], [ProcName+espFixer], [Filename+espFixer]
        mov     eax, [fError+espFixer]
        invoke  MessageBox,[hwnd+espFixer],Buffer,[QRCases+eax*4],[MBCases+eax*4]
        mov     eax, [fError+espFixer]
        ret
endp

ContextMenu@InvokeCommand: procedure(Self,lpici) ; looks verified
        mov     eax, [Self+espFixer]
        push    [eax+current_COMobject.lpFileName]

        mov     eax, [lpici+espFixer]
        push    [eax+CMINVOKECOMMANDINFO.hwnd]
        mov     eax, [eax+CMINVOKECOMMANDINFO.lpVerb]
        cmp     eax, 1
        ja      .ret_E_INVALIDARG
        push    [ProcNames+eax*4]
        call    RegisterCOMServer
        push    eax
        push    [FmtCases+eax*4]

        call    MessagingInvokeCommand
        test    eax, eax
        jz      .locret
        mov     eax, E_FAIL
        jmp     .locret
      .ret_E_INVALIDARG:
        pop     eax
        pop     eax
        mov     eax, E_INVALIDARG
      .locret:
        ret
endp

ContextMenu@GetCommandString: procedure(Self,idCmd,uType,pwReserved,pszName,cchMax)
        mov     eax, [uType+espFixer]
        cmp     eax, GCS_HELPTEXT
        jne     .ret_S_OK
        mov     eax, [idCmd+espFixer]
        cmp     eax, 1
        ja      .ret_E_INVALIDARG

        ;stdcall StrCopy, [pszName], [HintCases+eax*4]
        push    esi
        push    edi
        cld
        mov     edi, [HintCases+eax*4]
        mov     ecx, -1
        xor     eax, eax
        repne   scasb
        not     ecx
        sub     edi, ecx
        mov     esi, edi
        mov     edi, [pszName+espFixer]
        mov     eax, ecx
        shr     ecx, 2
        rep     movsd
        mov     ecx, eax
        and     ecx, 3
        rep     movsb
        pop     edi
        pop     esi

      .ret_S_OK:
        xor     eax, eax
        jmp     .locret
      .ret_E_INVALIDARG:
        mov     eax, E_INVALIDARG
      .locret:
        ret
endp

ShellExtInit@QueryInterface: procedure(Self,riid,ppvObject) ;verified - in original preserved & not used ecx
        mov     eax, [Self+espFixer]
        push   ecx
        comcall [eax-current_COMobject.SE], IUnknown, QueryInterface, [riid+espFixer], [ppvObject+espFixer]
        pop    ecx
        ret
endp

ShellExtInit@AddRef: procedure(Self) ;verified
        mov     eax, [Self+espFixer]
        comcall [eax-current_COMobject.SE], IUnknown, AddRef
        ret
endp

ShellExtInit@Release: procedure(Self) ;verified
        mov     eax, [Self+espFixer]
        comcall [eax-current_COMobject.SE], IUnknown, Release
        ret
endp

ShellExtInit@Initialize: procedure(Self, pidlFolder, lpdobj, hKeyProgID) ;verified
        mov     eax, [lpdobj+espFixer]
        test    eax, eax
        jz      .ret_E_INVALIDARG
        comcall eax, IDataObject, GetData, FormatETC, StgMedium
        cmp     eax, 0
        jl      .ret_E_FAIL
        xor     eax, eax
        ;mov     [FileName_COMfield], al
        invoke  DragQueryFile, StgMedium.hGlobal, -1, 0, 0
        cmp     eax, 1
        jne     .ret_E_FAIL
        mov     eax, [Self+espFixer]
        invoke  DragQueryFile, StgMedium.hGlobal, 0, [eax-current_COMobject.SE+current_COMobject.lpFileName], 261
        invoke  ReleaseStgMedium, StgMedium
        xor     eax, eax
        jmp     .locret
      .ret_E_FAIL:
        mov     eax, E_FAIL
        jmp     .locret
      .ret_E_INVALIDARG:
        mov     eax, E_INVALIDARG
      .locret:
        ret
endp



section '.data' data readable writeable

 CLSID_QuickRegister GUID 40E69241-5D1A-11D1-81CB-0020AF3E97A9
 IID_IUnknown        GUID 00000000-0000-0000-C000-000000000046
 IID_IClassFactory   GUID 00000001-0000-0000-C000-000000000046
 IID_IContextMenu    GUID 000214E4-0000-0000-C000-000000000046
 IID_IShellExtInit   GUID 000214E8-0000-0000-C000-000000000046

 struct current_COMobject
   CM IContextMenu
   SE IShellExtInit
   RefCount dd ?
   lpFileName dd ?
 ends


 QuickRegister_ClassFactory:
 QRClassFactory_QueryInterface  dd QRClassFactory@QueryInterface
 QRClassFactory_AddRef          dd QRClassFactory@AddRef
 QRClassFactory_Release         dd QRClassFactory@Release
 QRClassFactory_CreateInstance  dd QRClassFactory@CreateInstance
 QRClassFactory_LockServer      dd QRClassFactory@LockServer

 ContextMenu:
 ContextMenu_QueryInterface     dd ContextMenu@QueryInterface
 ContextMenu_AddRef             dd ContextMenu@AddRef
 ContextMenu_Release            dd ContextMenu@Release
 ContextMenu_QueryContextMenu   dd ContextMenu@QueryContextMenu
 ContextMenu_InvokeCommand      dd ContextMenu@InvokeCommand
 ContextMenu_GetCommandString   dd ContextMenu@GetCommandString
 ShellExtInit:
 ShellExtInit_QueryInterface    dd ShellExtInit@QueryInterface
 ShellExtInit_AddRef            dd ShellExtInit@AddRef
 ShellExtInit_Release           dd ShellExtInit@Release
 ShellExtInit_Initialize        dd ShellExtInit@Initialize

 QRClassFactory_COMobject       IClassFactory QuickRegister_ClassFactory
 ServerLockCount                dd 0
 hInstance                      dd 0

 QuickRegister_COMobject        current_COMobject ContextMenu,ShellExtInit,0,FileName_COMfield

 FormatETC                      FORMATETC CF_HDROP, 0, DVASPECT_CONTENT, -1, TYMED_HGLOBAL
 StgMedium                      STGMEDIUM

 ProcNames                      dd registerServerStr, unregisterServerStr
 FmtCases                       dd fmtStr, fmtErrStr
 MBCases                        dd MB_ICONINFORMATION or MB_OK,MB_ICONERROR or MB_OK
 QRCases                        dd Quick_Register,Quick_Register_Error
 HintCases                      dd registerHintStr,unregisterHintStr
 RootKey                        dd ?
 pHeap                          dd ?

 CLSIDStr                       db 'CLSID\'
 CLSIDString_QuickRegister      db '{40E69241-5D1A-11D1-81CB-0020AF3E97A9}',0
 CLSIDDescription               db 'Quick Register Context Menu Shell Extension',0
 CLSIDInprocServer              db 'CLSID\{40E69241-5D1A-11D1-81CB-0020AF3E97A9}\InprocServer32',0
 ThreadingModelStr              db 'ThreadingModel',0
 ApartmentStr                   db 'Apartment',0
 dllfile_shellex_Str            db 'dllfile\shellex',0
 dllfile_shellex_CMH_Str        db 'dllfile\shellex\ContextMenuHandlers',0
 dllfile_shellex_CMH_QR_Str     db 'dllfile\shellex\ContextMenuHandlers\QuickRegister',0
 cur_vers_shellex_Str           db 'SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions',0
 cur_vers_shellex_approv_Str    db 'SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved',0
 Error_updating_registry        db 'Error updating registry',0
 registerStr                    db 'register',0
 unregisterStr                  db 'unregister',0
 registerServerStr              db 'DllRegisterServer',0
 unregisterServerStr            db 'DllUnregisterServer',0
 fmtStr                         db '%s in %s succeeded.',0
 fmtErrStr                      db '%s in %s failed.',0
 Quick_Register                 db 'Quick Register',0
 Quick_Register_Error           db 'Quick Register - Error',0
 registerHintStr                db 'Register this COM/ActiveX server.',0
 unregisterHintStr              db 'Unregister this COM/ActiveX server.',0
 fmtInt                         db '%08X',0
 NullStr  db 0
 REGFileName db 261 dup ?
 FileName_COMfield db 261 dup ?
 Buffer db 300 dup ?

section '.idata' import data readable

  library kernel32,'KERNEL32.DLL',\
          user32,'USER32.DLL',\
          shell32,'SHELL32.DLL',\
          advapi32,'ADVAPI32.DLL',\
          ole32,'OLE32.DLL'

  import kernel32,\
         DisableThreadLibraryCalls,'DisableThreadLibraryCalls',\
         FreeLibrary,'FreeLibrary',\
         GetModuleFileName,'GetModuleFileNameA',\
         GetProcAddress,'GetProcAddress',\
         InterlockedDecrement,'InterlockedDecrement',\
         InterlockedIncrement,'InterlockedIncrement',\
         HeapAlloc,'HeapAlloc',\
         HeapCreate,'HeapCreate',\
         HeapFree,'HeapFree',\
         LoadLibrary,'LoadLibraryA'

  import user32,\
         InsertMenu,'InsertMenuA',\
         MessageBox,'MessageBoxA',\
         wsprintf,'wsprintfA'

  import shell32,\
         DragQueryFile,'DragQueryFileA'

  import advapi32,\
         RegCloseKey,'RegCloseKey',\
         RegCreateKey,'RegCreateKeyA',\
         RegCreateKeyEx,'RegCreateKeyExA',\
         RegDeleteKey,'RegDeleteKeyA',\
         RegSetValueEx,'RegSetValueExA'

  import ole32,\
         ReleaseStgMedium,'ReleaseStgMedium'

section '.edata' export data readable

  export 'COMSERVEXAMPLE.DLL',\
         DllGetClassObject,'DllGetClassObject',\
         DllCanUnloadNow,'DllCanUnloadNow',\
         DllRegisterServer,'DllRegisterServer',\
         DllUnregisterServer,'DllUnregisterServer'

section '.reloc' fixups data readable discardable
    


Description: 2 binaryies in - one after delphi, secod after fasm patch. full sources.
Download
Filename: without SysUtils.zip
Filesize: 29.88 KB
Downloaded: 598 Time(s)

Post 16 Jun 2019, 21:26
View user's profile Send private message Send e-mail Reply with quote
ProMiNick



Joined: 24 Mar 2012
Posts: 804
Location: Russian Federation, Sochi
ProMiNick 23 Jun 2019, 23:34
Interface IShellExtInit now completely working!!!
explorer stop crashing on every file, and even on group of files.
It is mean that filtration named ShellExtInit@Initialize was successfull (creating COM object was succesfull, and ShellExtInit base IUnknown methods realized via ContentMenu ones - it is mean they are valid too.
But bug still somewhere... may be not one...
Than number of bugs decreased they became hard to detect.


Description: more functions realised as inline assembly than previously
Download
Filename: without SysUtils.zip
Filesize: 26.79 KB
Downloaded: 607 Time(s)

Description: Help appreciated: If someone find differences in behavior of contained pairs of procedures. Not full (absent 2 methods of ContextMenu & all methods of ShellExtInit).

The most possible place of error now is ContextMenu_QueryContextMenu

Download
Filename: Diagrams.pdf
Filesize: 375.65 KB
Downloaded: 681 Time(s)


_________________
I don`t like to refer by "you" to one person.
My soul requires acronim "thou" instead.


Last edited by ProMiNick on 08 Dec 2020, 16:47; edited 1 time in total
Post 23 Jun 2019, 23:34
View user's profile Send private message Send e-mail Reply with quote
ProMiNick



Joined: 24 Mar 2012
Posts: 804
Location: Russian Federation, Sochi
ProMiNick 24 Jun 2019, 21:26
I feel me like Emett Brown from "Back to future" when he screaming "it is working!!!! It is working!!!"

Atlast 1st COM server in assembly is working.
Work on pdf helped me found last 2 bugs:
First one in interface IShellExtInit realization in on of inherited from IUnknown functions stayed rudiment "pop ecx" - function dosn`t returns stack correctly.
Second one is use offset to handles instead of values of handles in IShellExtInit realization in initialize function.

I will left untouched previous post for history.


Description: I finished pdf (last bug was in last procedure)
You can find these bugs in previous post attachments

Download
Filename: Diagrams.pdf
Filesize: 406.87 KB
Downloaded: 624 Time(s)


_________________
I don`t like to refer by "you" to one person.
My soul requires acronim "thou" instead.
Post 24 Jun 2019, 21:26
View user's profile Send private message Send e-mail Reply with quote
Display posts from previous:
Post new topic Reply to topic

Jump to:  


< Last Thread | Next Thread >
Forum Rules:
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum
You cannot attach files in this forum
You can download files in this forum


Copyright © 1999-2025, Tomasz Grysztar. Also on GitHub, YouTube.

Website powered by rwasa.