Может ли CreateObject создавать объект по CLSID?

[tyomitch]

по мотивам http://bbs.vbstreets.ru/viewtopic.php?t=26313

[keks-n]

Может дизасмом его, а?

[GAGArin]

Срочно нужен третий вариант.

[ANDLL]

Пока что моя берет

[keks-n]

Вообще-то правильный вариант -"не должен" Потому как

ProgId
Required. String. The program ID of the object to create.

- в описании первого аргумента про Class GUID ничего нет.

[tyomitch]

Может дизасмом его, а?

Вот он, с подставленными символами:

Код: Выделить всё

6A9F8EDC                    rtcCreateObject2: ;; aka _rtcCreateObject2@8
6A9F8EDC 55                     push    ebp
6A9F8EDD 8BEC                   mov     ebp,esp
6A9F8EDF 83EC78                 sub     esp,78h
6A9F8EE2 8B450C                 mov     eax,[ebp+0Ch]
6A9F8EE5 53                     push    ebx
6A9F8EE6 56                     push    esi
6A9F8EE7 33F6                   xor     esi,esi
6A9F8EE9 3BC6                   cmp     eax,esi
6A9F8EEB 57                     push    edi
6A9F8EEC 0F84A5CB0100           je      loc_6AA15A97
6A9F8EF2 8B40FC                 mov     eax,[eax-4]
6A9F8EF5 D1E8                   shr     eax,1
6A9F8EF7 8945F8                 mov     [ebp-8],eax
6A9F8EFA 0F8497CB0100           je      loc_6AA15A97
6A9F8F00 8B7D10                 mov     edi,[ebp+10h]
6A9F8F03 3BFE                   cmp     edi,esi
6A9F8F05 0F8596CB0100           jne     loc_6AA15AA1
6A9F8F0B                    loc_6A9F8F0B:
6A9F8F0B 8D45D8                 lea     eax,[ebp-28h]
6A9F8F0E 50                     push    eax
6A9F8F0F FF750C                 push    dword ptr [ebp+0Ch]
6A9F8F12 FF15940DAE6A           call    dword ptr [g_pfnCLSIDFromProgidEx]
6A9F8F18 3BC6                   cmp     eax,esi
6A9F8F1A 0F8C7FCD0100           jl      loc_6AA15C9F
6A9F8F20 56                     push    esi
6A9F8F21 56                     push    esi
6A9F8F22 FF15001A9D6A           call    dword ptr [OLEAUT32.201]
6A9F8F28 8D45FC                 lea     eax,[ebp-4]
6A9F8F2B 50                     push    eax
6A9F8F2C 68C8A89E6A             push    offset _IID_IUnknown
6A9F8F31 6A05                   push    5
6A9F8F33 8D45D8                 lea     eax,[ebp-28h]
6A9F8F36 56                     push    esi
6A9F8F37 50                     push    eax
6A9F8F38 FF155C199D6A           call    dword ptr [CoCreateInstance]
6A9F8F3E 8BF8                   mov     edi,eax
6A9F8F40 3BFE                   cmp     edi,esi
6A9F8F42 0F8C36CD0100           jl      loc_6AA15C7E
6A9F8F48                    loc_6A9F8F48:
6A9F8F48 56                     push    esi
6A9F8F49 57                     push    edi
6A9F8F4A E8F44BFFFF             call    _HresultCheck@8
6A9F8F4F 8B45FC                 mov     eax,[ebp-4]
6A9F8F52 8D550C                 lea     edx,[ebp+0Ch]
6A9F8F55 52                     push    edx
6A9F8F56 68B0F29F6A             push    offset _IID_IPersistStreamInit
6A9F8F5B 8B08                   mov     ecx,[eax]
6A9F8F5D 50                     push    eax
6A9F8F5E FF11                   call    dword ptr [ecx]
6A9F8F60 85C0                   test    eax,eax
6A9F8F62 0F8DE4CC0100           jnl     loc_6AA15C4C
6A9F8F68 8B45FC                 mov     eax,[ebp-4]
6A9F8F6B 8D5510                 lea     edx,[ebp+10h]
6A9F8F6E 52                     push    edx
6A9F8F6F 68C0F29F6A             push    offset _IID_IPersistPropertyBag
6A9F8F74 8B08                   mov     ecx,[eax]
6A9F8F76 50                     push    eax
6A9F8F77 FF11                   call    dword ptr [ecx]
6A9F8F79 85C0                   test    eax,eax
6A9F8F7B 0F8DE4CC0100           jnl     loc_6AA15C65
6A9F8F81                    loc_6A9F8F81:
6A9F8F81 3BFE                   cmp     edi,esi
6A9F8F83 0F8CECCC0100           jl      loc_6AA15C75
6A9F8F89                    loc_6A9F8F89:
6A9F8F89 8B45FC                 mov     eax,[ebp-4]
6A9F8F8C 8D55F8                 lea     edx,[ebp-8]
6A9F8F8F 52                     push    edx
6A9F8F90 6800F39F6A             push    offset _IID_IDispatch
6A9F8F95 8B08                   mov     ecx,[eax]
6A9F8F97 50                     push    eax
6A9F8F98 FF11                   call    dword ptr [ecx]
6A9F8F9A 85C0                   test    eax,eax
6A9F8F9C 0F8C1BCD0100           jl      loc_6AA15CBD
6A9F8FA2 8B45FC                 mov     eax,[ebp-4]
6A9F8FA5 50                     push    eax
6A9F8FA6 8B08                   mov     ecx,[eax]
6A9F8FA8 FF5108                 call    dword ptr [ecx+8]
6A9F8FAB 8B45F8                 mov     eax,[ebp-8]
6A9F8FAE 66C745E80900           mov     word ptr [ebp-18h],9
6A9F8FB4                    loc_6A9F8FB4:
6A9F8FB4 8945F0                 mov     [ebp-10h],eax
6A9F8FB7 8B4508                 mov     eax,[ebp+8]
6A9F8FBA 8D75E8                 lea     esi,[ebp-18h]
6A9F8FBD 8BF8                   mov     edi,eax
6A9F8FBF A5                     movsd
6A9F8FC0 A5                     movsd
6A9F8FC1 A5                     movsd
6A9F8FC2 A5                     movsd
6A9F8FC3 5F                     pop     edi
6A9F8FC4 5E                     pop     esi
6A9F8FC5 5B                     pop     ebx
6A9F8FC6 C9                     leave
6A9F8FC7 C20C00                 ret     0Ch


[ANDLL]

И че с сиим делать?

[keks-n]

А может перед вызовом СLSIDFromProgidEx поставить на него перехватчик а потом убрать? Всего делов-то...

[keks-n]

Примерно так:

Код: Выделить всё

Option Explicit
Declare Function GetCurrentProcess Lib "kernel32" () As Long
Public Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Public Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long

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

Public Function CreateObjectFromCLSID(CLSID As GUID) As Object
Dim backup As Double, address As Long
address = GetProcAddress(GetModuleHandle("ole32.dll"), "ÑLSIDFromProgidEx")
CurGUID = CLSID
ReplaceFunc address, AddressOf Intercepted, backup
Set CreateObjectFromCLSID = CreateObject("Ïîôèã ÷òî òóò :)")
RestoreFunc address, backup
End Function

Private Sub ReplaceFunc(ByVal Deinst As Long, ByVal Source As Long, backup As Double)
Dim buffer(5) As Byte, written As Long
Call ReadProcessMemory(GetCurrentProcess, ByVal Deinst, backup, 6, written)
buffer(0) = &H68
CopyMemory buffer(1), Source, 4
buffer(5) = &HC3
WriteProcessMemory GetCurrentProcess, ByVal Deinst, buffer(0), 6, written
End Sub
Private Sub RestoreFunc(ByVal Deinst As Long, ByVal backup As Double)
Dim written As Long, buffer(5) As Byte
CopyMemory buffer(0), backup, 6
WriteProcessMemory GetCurrentProcess, ByVal Deinst, buffer(0), 6, written
End Sub


Private Sub Intercepted(ByVal lpString As Long, CLSID As GUID)
CLSID = CurGUID
End Sub


Сейчас проверю...

[keks-n]

Урра! Работает!

Код: Выделить всё

Option Explicit
Declare Function GetCurrentProcess Lib "kernel32" () As Long
Public Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Public Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function CLSIDFromProgID Lib "ole32.dll" (ByVal prid As String, CLSID As CLSID) As Long
Private Type CLSID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4 As Integer
    Data5(5) As Byte
End Type
Dim CurGUID As CLSID

Public Function CreateObjectFromCLSID(CLSID As CLSID) As Object
Dim backup As Double, address As Long
address = GetProcAddress(GetModuleHandle("ole32.dll"), "CLSIDFromProgIDEx")

CurGUID = CLSID
ReplaceFunc address, AddressOf Intercepted, backup
Set CreateObjectFromCLSID = CreateObject("aa")
RestoreFunc address, backup
End Function

Private Sub ReplaceFunc(ByVal Deinst As Long, ByVal Source As Long, backup As Double)
Dim buffer(5) As Byte, written As Long
Call ReadProcessMemory(GetCurrentProcess, ByVal Deinst, backup, 6, written)
buffer(0) = &H68
CopyMemory buffer(1), Source, 4
buffer(5) = &HC3
WriteProcessMemory GetCurrentProcess, ByVal Deinst, buffer(0), 6, written
End Sub
Private Sub RestoreFunc(ByVal Deinst As Long, ByVal backup As Double)
Dim written As Long, buffer(5) As Byte
CopyMemory buffer(0), backup, 6
WriteProcessMemory GetCurrentProcess, ByVal Deinst, buffer(0), 6, written
End Sub

Private Function Intercepted(ByVal lpString As Long, CLSID As CLSID) As Long
CLSID = CurGUID
Intercepted = 0
End Function
Sub main()

Dim wa As Object, WordCLSID As CLSID
WordCLSID.Data1 = 133631
WordCLSID.Data4 = 192
WordCLSID.Data5(5) = 70
Set wa = CreateObjectFromCLSID(WordCLSID)
wa.Visible = True
End Sub


[tyomitch]

OMG. А что работает-то?

[keks-n]

Обрати своё внимание на код, а именно на Sub Main.

Word.Application создался по CLSID... Правда этот CLSID ему подсунули не совсем стандартным способом.

Как видно из кода CreateObject получает строку "aa"(с тем же успехом он может получить любую), а создакёт тот объект, CLSID которого передан в CreateObjectFromCLSID. Так что ответ опроса-"не хотел, но заставили"

[tyomitch]

Ну... Не могу сказать, что это проще, чем CoCreateInstance...

Ещё не согласен, что в твоём коде вызывается именно CreateObject, а не мутант с подменёнными кишками...

И уж тем более не думаю, что Хакер со товарищи использовали этот код, а потом его забыли.

В общем, так нечестно

[keks-n]

tyomitch
Это проще подсовывания объектной переменной CoCreateInstance и проведения тех хитрых вызовов которые делает CreateObject...

[GSerg]

keks-n
Никогда не поверю, что это проще однострочного вызова CoCreateInstance.

[tyomitch]

Хорошо, давай сосчитаем строки.

Код: Выделить всё

Option Explicit
Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4 As Integer
    Data5(5) As Byte
End Type
Private Declare Sub CoCreateInstance Lib "ole32" (rclsid As GUID, ByVal pUnkOuter As IUnknown, ByVal dwClsContext As Long, riid As GUID, ppv As Object)

Public Function CreateObjectFromCLSID(CLSID As GUID) As IUnknown
Dim IID_Unknown As GUID
IID_Unknown.Data4 = 192
IID_Unknown.Data5(5) = 70
CoCreateInstance CLSID, Nothing, 5, IID_Unknown, CreateObjectFromCLSID
End Function

Sub main()
Dim wa As Object, WordCLSID As GUID
WordCLSID.Data1 = 133631
WordCLSID.Data4 = 192
WordCLSID.Data5(5) = 70
Set wa = CreateObjectFromCLSID(WordCLSID)
wa.Visible = True
End Sub


Ну? у кого длиннее?

[keks-n]

Молчу... Меня смутили строки кода в CreateObject, которые после CoCreateInstance. Кстати, нафиг они нужны, если всё работает и без них?

[Хакер]

Хм... а я вспомнил как я делал

[tyomitch]

ну?

[Хакер]

Так смеяться будите

[GSerg]

Всенепременно будим.
Давай.