Results 1 to 25 of 25

Thread: [VB6] - Injection to another process.

  1. #1

    Thread Starter
    PowerPoster
    Join Date
    Feb 2015
    Posts
    2,671

    [VB6] - Injection to another process.


    Everyone knows the utility SPYXX. With it you can do a lot of interesting things. Among its features - View messages sent by the window, and the results of their treatment. I decided to do something like that just to VB6 (not as the creation of programs such as SPYXX, as well as a demonstration of the possibility of an injection of code from VB6, so that the functionality of a program is very small). As you know SPYXX does this by using a global hook, but I was interested in the idea of injection without DLL (DLL can be much easier to do, Richter describes how to inject several functions in a foreign process using DLL, and I put an example) and I decided to do a little differently. In my example code along with the window procedure directly copied into the address space of the desired process and it starts (only works with 32-bit applications). There I place the code that establishes a new procedure for processing messages for the window and sleeping thread. In the new procedure, I just superfluous to pass a parameter that someone else got the window, my window (frmSpy), hereinafter called the original window procedure. I have to say - the transfer is not the most efficient way, it was possible to make a much more effective working directly with "FileMapping", or asynchronously transmit 2 posts in a row. But I did not complicate the code over, because my ultimate goal is not effective. Cancel injection is performed awakening threads and completion of its natural way, then from its program I release resources. Work I checked in the debugger everything works as intended.
    When running in another process, the runtime is not used, although it is possible to download and use (about context initialization thread separately) its functions, arrays, strings, etc. Also, there is a problem working with variables, as global variables "does not exist", and, accordingly, any reference to such variables could be fatal to the whole process. To call the API I'm using splicing "pseudofunctions API", replace the call to an unconditional jump to the desired function. Working with variables is carried out in a dedicated area for this. To keep it, I use "SetProp", because from "WindowProc" I can identify something only through "hWnd". If you need to add any global variables, it is possible in this field to allocate space for the string, etc. (for example to call "LoadLibrary" with the required parameter). If in VB was to work directly with pointers (without VarPtr, GetMem functions, etc.), it was much easier. You can do once the assembly adapter and it is possible to learn the values of variables passed to the stream without "SetProp" and "CopyMemory", but it's the details, who wants to - he did.
    Everything works only in a compiled (native) form.

  2. #2

    Thread Starter
    PowerPoster
    Join Date
    Feb 2015
    Posts
    2,671

    Re: [VB6] - Injection to another process.

    module modInjection.mod:
    Code:
    Option Explicit
    
    ' © Кривоус Анатолий Анатольевич (The trick), 2014
     
    Private Type MessageInfo                    ' Эту структуру передаем в качестве параметра нашему окну
        Msg As Long
        wParam As Long
        lParam As Long
    End Type
    Private Type TrickThreadData
        SrcWnd As Long                          ' Хендл сабклассируемого окна
        DesthWnd As Long                        ' Хендл окна frmSpy
        EventHandle As Long                     ' Хендл события, отвечающего за завершение потока
        AddrWindowProc As Long                  ' Адрес функции WindowProc в чужом процессе
        AddrStructure As Long                   ' Адрес этой структуры
        Msg As MessageInfo                      ' Для передачи указателя COPYDATASTRUCT
    End Type
    Private Type COPYDATASTRUCT
        dwData As Long
        cbData As Long
        lpData As Long
    End Type
     
    Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare Function VirtualAllocEx Lib "kernel32.dll" (ByVal hProcess As Long, lpAddress As Any, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
    Private Declare Function VirtualFreeEx Lib "kernel32.dll" (ByVal hProcess As Long, lpAddress As Any, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long
    Private Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
    Private Declare Function CreateRemoteThread Lib "kernel32" (ByVal hProcess As Long, lpThreadAttributes As Any, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, lpParameter As Any, ByVal dwCreationFlags As Long, lpThreadId As Long) As Long
    Private Declare Function GetMem4 Lib "msvbvm60" (src As Any, dst As Any) As Long
    Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
    Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
    Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
    Private Declare Function CreateEvent Lib "kernel32" Alias "CreateEventA" (lpEventAttributes As Any, ByVal bManualReset As Long, ByVal bInitialState As Long, lpName As Any) As Long
    Private Declare Function PulseEvent Lib "kernel32" (ByVal hEvent As Long) As Long
    Private Declare Function DuplicateHandle Lib "kernel32" (ByVal hSourceProcessHandle As Long, ByVal hSourceHandle As Long, ByVal hTargetProcessHandle As Long, lpTargetHandle As Long, ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwOptions As Long) As Long
    Private Declare Function GetCurrentProcess Lib "kernel32" () 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 Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
    Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, lParam As Any) As Long
     
    Private Const WM_COPYDATA = &H4A
    Private Const GWL_WNDPROC = (-4)
    Private Const DUPLICATE_SAME_ACCESS = &H2
    Private Const PROCESS_ALL_ACCESS = &H1F0FFF
    Private Const MEM_COMMIT = &H1000&
    Private Const MEM_RESERVE = &H2000&
    Private Const MEM_RELEASE = &H8000&
    Private Const PAGE_EXECUTE_READWRITE = &H40&
    Private Const INFINITE = -1&
     
    Private Const Prop As String = "pInject"                    ' 7 символов + \0, итого 8 байт, вполне помещается в переменную типа Currency
    Private Const PropCur As Currency = 3276038452689.5472@     ' Строка Prop в виде Currecy числа
     
    Public hProcess As Long                                     ' Хендл процесса, в который внедряемся
    Public hThread As Long                                      ' Хендл потока, который мы создадим в чужом процессе
    Public TID As Long                                          ' Идентификатор этого потока
    Public lpProc As Long                                       ' Адрес функции InjectionProc
    Public Size As Long                                         ' Размер данных и кода, внедряемого в процесс
    Public hEvent As Long                                       ' Описатель события в нашем процессе
     
    Dim lpPrevWndProc As Long                                   ' Адрес оконной процедуры frmSpy (изначальный)
     
    ' Функция внедряет код в чужой процесс
    Public Function Hook(hwnd As Long) As Boolean
        Dim Buf() As Byte, ret As Long, PID As Long, DupHandle As Long, nearWndProc As Long, _
            FuncOf() As Long, FuncAddr() As Long, hMod As Long, lpFunc As Long, i As Long, lpData As Long
            
        If hProcess Then Clear                   ' Если перехват был, то убираем
        GetWindowThreadProcessId hwnd, PID
        
        ' Инициализация словаря
        If modListView.Dic Is Nothing Then modListView.DicInit
        
        If PID Then hProcess = OpenProcess(PROCESS_ALL_ACCESS, False, PID) Else Exit Function
     
        ' Создаем событие для управления потоком
        hEvent = CreateEvent(ByVal 0, 1, 0, ByVal 0)
     
        If hEvent = 0 Then Clear: Exit Function
        ' Создаем дубликат описателя события для процесса
        If DuplicateHandle(GetCurrentProcess(), hEvent, hProcess, DupHandle, 0, False, DUPLICATE_SAME_ACCESS) = 0 Then Clear: Exit Function
     
        ' Определяем размер для внедренного кода
        lpData = AddrOf(AddressOf AddrOf) - AddrOf(AddressOf InjectionProc)
        ' Определяем относительное смещение функции WindowProc от данных
        nearWndProc = AddrOf(AddressOf AddrOf) - AddrOf(AddressOf WindowProc)
        ' Определяем размер данных и кода
        Size = lpData + 32
     
        ' Выделяем память в чужом процессе
        lpProc = VirtualAllocEx(hProcess, ByVal 0, Size, MEM_COMMIT Or MEM_RESERVE, PAGE_EXECUTE_READWRITE)
        If lpProc = 0 Then MsgBox "Error allocate memory", vbCritical: Clear: Exit Function
     
        ' Определяем смещения для псевдофункций API относительно начала данных
        ReDim FuncOf(9)
        FuncOf(0) = AddrOf(AddressOf myCopyMemory) - AddrOf(AddressOf InjectionProc)
        FuncOf(1) = AddrOf(AddressOf myCopyMemory2) - AddrOf(AddressOf InjectionProc)
        FuncOf(2) = AddrOf(AddressOf myCloseHandle) - AddrOf(AddressOf InjectionProc)
        FuncOf(3) = AddrOf(AddressOf myWaitForSingleObject) - AddrOf(AddressOf InjectionProc)
        FuncOf(4) = AddrOf(AddressOf mySetProp) - AddrOf(AddressOf InjectionProc)
        FuncOf(5) = AddrOf(AddressOf myGetProp) - AddrOf(AddressOf InjectionProc)
        FuncOf(6) = AddrOf(AddressOf myRemoveProp) - AddrOf(AddressOf InjectionProc)
        FuncOf(7) = AddrOf(AddressOf mySetWindowLong) - AddrOf(AddressOf InjectionProc)
        FuncOf(8) = AddrOf(AddressOf mySendMessage) - AddrOf(AddressOf InjectionProc)
        FuncOf(9) = AddrOf(AddressOf myCallWindowProc) - AddrOf(AddressOf InjectionProc)
     
        ' Определяем адреса API функций, для системных библиотек их образы спроецированы по одному и томуже адресу что и у нас
        ReDim FuncAddr(9)
        hMod = GetModuleHandle("kernel32")
        FuncAddr(0) = GetProcAddress(hMod, "RtlMoveMemory")
        FuncAddr(1) = FuncAddr(0)
        FuncAddr(2) = GetProcAddress(hMod, "CloseHandle")
        FuncAddr(3) = GetProcAddress(hMod, "WaitForSingleObject")
        hMod = GetModuleHandle("user32")
        FuncAddr(4) = GetProcAddress(hMod, "SetPropA")
        FuncAddr(5) = GetProcAddress(hMod, "GetPropA")
        FuncAddr(6) = GetProcAddress(hMod, "RemovePropA")
        FuncAddr(7) = GetProcAddress(hMod, "SetWindowLongA")
        FuncAddr(8) = GetProcAddress(hMod, "SendMessageA")
        FuncAddr(9) = GetProcAddress(hMod, "CallWindowProcA")
     
        ' Копируем код
        ReDim Buf(Size - 1)
        CopyMemory Buf(0), ByVal AddrOf(AddressOf InjectionProc), lpData
     
        ' Модифицируем код для вызова API вместо наших пустышек
        For i = 0 To UBound(FuncOf)
            Buf(FuncOf(i)) = &HE9                                                   ' JMP
            GetMem4 (FuncAddr(i) - FuncOf(i) - lpProc) - 5, Buf(FuncOf(i) + 1)      ' near (относительный прыжок на API функцию)
        Next
     
        ' Копируем данные
        GetMem4 hwnd, Buf(lpData)                                                   ' Хендл сабклассируемого окна
        GetMem4 frmSpy.hwnd, Buf(lpData + 4)                                        ' Хендл окна-приемника
        GetMem4 DupHandle, Buf(lpData + 8)                                          ' Хендл события
        GetMem4 lpProc + lpData - nearWndProc, Buf(lpData + 12)                     ' Адрес WindowProc в чужом процессе
        GetMem4 lpProc + lpData, Buf(lpData + 16)                                   ' Адрес этой структуры в чужом процессе
        
        ' Делаем инъекцию
        If WriteProcessMemory(hProcess, lpProc, Buf(0), Size, ret) Then
            If ret <> Size Then MsgBox "Error write process", vbCritical: Clear: Exit Function
            ' Запускаем код инъекции
            hThread = CreateRemoteThread(hProcess, ByVal 0, 0, lpProc, ByVal lpProc + Size - 32, 0, TID)
            If hThread = 0 Then MsgBox "Error create thread", vbCritical: Clear: Exit Function
        End If
        
        lpPrevWndProc = SetWindowLong(frmSpy.hwnd, GWL_WNDPROC, AddressOf SpyWindowProc)     ' Сабклассим наше окно
        
        Hook = True
    End Function
     
    ' Удалить инъекцию
    Public Sub Clear()
        If lpPrevWndProc Then
            SetWindowLong frmSpy.hwnd, GWL_WNDPROC, lpPrevWndProc       ' Убираем сабклассинг
            lpPrevWndProc = 0
        End If
        If hThread Then
            PulseEvent hEvent                                           ' Запускаем завершение потока
            WaitForSingleObject hThread, INFINITE                       ' Ждем завершения потока (замораживаемся)
            CloseHandle hThread                                         ' Закрываем описатель потока
            hThread = 0
        End If
        If lpProc Then
            Call VirtualFreeEx(hProcess, ByVal lpProc, 0, MEM_RELEASE)  ' Освобождаем выделенную память
        End If
        If hProcess Then
            CloseHandle hProcess                                        ' Закрываем описатель процесса
            hProcess = 0
        End If
        If hEvent Then
            CloseHandle hEvent                                          ' Закрываем описатель события (объект тоже удалится)
            hEvent = 0
        End If
    End Sub
    ' Оконная процедура для отслеживания сообщений из нашего процесса
    Private Function SpyWindowProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
        Dim CDS As COPYDATASTRUCT, Info As MessageInfo
        
        If Msg = WM_COPYDATA Then
            ' Получили сообщение из того процесса!!!
            CopyMemory CDS, ByVal lParam, Len(CDS)
            CopyMemory Info, ByVal CDS.lpData, CDS.cbData
            ItemAdd modListView.GetMessageName(Info.Msg), Info.wParam, Info.lParam
        End If
        
        ' Обрабатываем как и раньше
        SpyWindowProc = CallWindowProc(lpPrevWndProc, hwnd, Msg, wParam, ByVal lParam)
    End Function
     
    ' Процедура, выполняемая в чужом процессе, передаем ей указатель на данные
    Private Sub InjectionProc(Dat As TrickThreadData)
        Dim lpOldProc As Long
        ' Мы в чужом процессе ))
        mySetProp Dat.SrcWnd, PropCur, Dat.AddrStructure                         ' Устанавливаем окну свойство с указателем на данные
        lpOldProc = mySetWindowLong(Dat.SrcWnd, GWL_WNDPROC, Dat.AddrWindowProc) ' Устанавливаем окну новый оконный обработчик
        ' Вместо нового адреса процедуры пишем старое
        Dat.AddrWindowProc = lpOldProc
        ' Замораживаем поток
        myWaitForSingleObject Dat.EventHandle, INFINITE
        ' Поток разморожен, значит надо возвращать все на место
        mySetWindowLong Dat.SrcWnd, GWL_WNDPROC, Dat.AddrWindowProc
        myRemoveProp Dat.SrcWnd, PropCur
        ' Закрываем описатель события
        myCloseHandle Dat.EventHandle
        ' Все поток закончен, теперь Clear разморозится и очистит занимаемую память
    End Sub
     
    ' Прцедуры вызова соответствующих API c помощью сплайсинга
    Private Function myCopyMemory(dst As TrickThreadData, ByVal src As Long, ByVal Length As Long) As Long
        myCopyMemory = -1
    End Function
    Private Function myCopyMemory2(ByVal dst As Long, src As TrickThreadData, ByVal Length As Long) As Long
        myCopyMemory2 = -2
    End Function
    Private Function mySetProp(ByVal hwnd As Long, ByRef Name As Currency, ByVal Value As Long) As Long
        mySetProp = -3
    End Function
    Private Function myGetProp(ByVal hwnd As Long, ByRef Name As Currency) As Long
        myGetProp = -4
    End Function
    Private Function myRemoveProp(ByVal hwnd As Long, ByRef Name As Currency) As Long
        myRemoveProp = -5
    End Function
    Private Function mySetWindowLong(ByVal hwnd As Long, ByVal Index As Long, ByVal Data As Long) As Long
        mySetWindowLong = -6
    End Function
    Private Function myWaitForSingleObject(ByVal hEvent As Long, ByVal Millisecond As Long) As Long
        myWaitForSingleObject = -7
    End Function
    Private Function mySendMessage(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, lParam As COPYDATASTRUCT) As Long
        mySendMessage = -8
    End Function
    Private Function myCallWindowProc(ByVal addr As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
        myCallWindowProc = -9
    End Function
    Private Function myCloseHandle(ByVal Handle As Long) As Long
        myCloseHandle = -10
    End Function
    ' Оконная функция, которая будет работать в чужом процессе
    Private Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
        Dim lpDat As Long, Dat As TrickThreadData, CDS As COPYDATASTRUCT
        
        lpDat = myGetProp(hwnd, PropCur)
     
        myCopyMemory Dat, lpDat, Len(Dat)                   ' Копируем параметры
        
        ' Устанавливаем параметры сообщения
        Dat.Msg.Msg = uMsg
        Dat.Msg.wParam = wParam
        Dat.Msg.lParam = lParam
        
        myCopyMemory2 lpDat, Dat, Len(Dat)                  ' Копируем параметры обратно
        
        CDS.cbData = Len(Dat.Msg)
        CDS.lpData = lpDat + 20                             ' Смещение структуры MessageInfo, относительно данных
        
        ' Отправляем нашему окну уведомление
        mySendMessage Dat.DesthWnd, WM_COPYDATA, hwnd, CDS
        
        ' Вызываем процедуру по умолчанию
        WindowProc = myCallWindowProc(Dat.AddrWindowProc, hwnd, uMsg, wParam, lParam)
    End Function
    
    ' Эта функция также служит маркером конца функции и в процесс не копируется
    Private Function AddrOf(Value As Long) As Long
        AddrOf = Value
    End Function
    Good luck!

    MessageLog.zip
    Last edited by The trick; Feb 13th, 2015 at 09:09 AM.

  3. #3
    Hyperactive Member
    Join Date
    Nov 2011
    Posts
    498

    Re: [VB6] - Injection to another process.

    hi. I am very interested in your code as i am looking for a way to monitor a button in an external app.
    If someone was to press this button, i would want my app to block the button press and to popup a msgbox

    I currently have a program that sits in the system tray that displays one of 3 icons.
    I use it in our office to show whether a user can close invoices / close certain invoices / or not close invoices.

    I know how to use the api to get text,press buttons in an external app, but i am now trying to find a
    way to stop a button in an external app being pressed ie Not let a user close an invoice.


    Would you know how to take this one step further to see that a button has been pressed and then stop the message
    being processed. i can then pop up a msgbox in my app to say closing of call not allowed at this time.

    hope you can help

  4. #4

  5. #5
    Hyperactive Member
    Join Date
    Apr 2015
    Posts
    356

    Re: [VB6] - Injection to another process.

    Dear Trick,

    I compiled your MessageLog project code to prjMessageLog.exe and executed it outside IDE.I clicked on drag on window button and tried to move mouse on different windows.I also tried by starting notepad.exe and dragging window on it..But nothing was displayed in the form.PLEASE CLARIFY WHY THE EXE IS NOT WORKING.hOW TO SEE THE MESSAGES IN THE FORM.

    regards,
    JSVenu

  6. #6

  7. #7
    Hyperactive Member
    Join Date
    Apr 2015
    Posts
    356

    Re: [VB6] - Injection to another process.

    Quote Originally Posted by The trick View Post
    Hi jsvenu.
    What the OS? What the errors? You should press the mouse on the button and move it to the needed window (it'll highlighted). Also you can move to the 32 bit applications only.
    Dear Trick,
    OS is windows 10.and and I get error message box as follows whwn I drag the button drag on window and move on notepad.exe window.But the caption of the main project form is changing.But no messages in the litview of the form.

    ---------------------------
    prjMessageLog
    ---------------------------
    Error create thread
    ---------------------------
    OK
    ---------------------------

    regards,
    JSVenu

  8. #8
    Hyperactive Member
    Join Date
    Apr 2015
    Posts
    356

    Re: [VB6] - Injection to another process.

    Quote Originally Posted by The trick View Post
    Hi jsvenu.
    What the OS? What the errors? You should press the mouse on the button and move it to the needed window (it'll highlighted). Also you can move to the 32 bit applications only.
    Dear Trick,
    OS is windows 10.and and I get error message box as follows whwn I drag the button drag on window and move on notepad.exe window.But the caption of the main project form is changing.But no messages in the rows of listview of the form.

    ---------------------------
    prjMessageLog
    ---------------------------
    Error create thread
    ---------------------------
    OK
    ---------------------------

    regards,
    JSVenu

  9. #9

  10. #10
    Hyperactive Member
    Join Date
    Apr 2015
    Posts
    356

    Re: [VB6] - Injection to another process.

    Quote Originally Posted by The trick View Post
    Seems you try to inject to the 64 bit process.
    Dear Trick,
    Same is the case when I try with vb6 IDE window which is 32 bit.
    Please clarify how to make this work .

    regards,
    JSVenu

  11. #11
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,541

    Re: [VB6] - Injection to another process.

    What he is trying to say is that a 32 bit process can only inject a DLL into another 32 bit process. For more information, read the comments regarding SetWindowsHookEx and DLL injection -- jump to the "Remarks" section
    https://docs.microsoft.com/en-us/win...windowshookexa
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  12. #12

  13. #13
    Hyperactive Member
    Join Date
    Apr 2015
    Posts
    356

    Re: [VB6] - Injection to another process.

    Dear Lavolpe and Trick,
    I have already seen that this works for 32-bit applications.But I am telling when we run vb6 ide, in the taskmanager it shows it as 32-bit process.When we drag to vb6 ide window it is not displaying anything in the main form window .

    regards,
    JSVenu

  14. #14
    Hyperactive Member
    Join Date
    Apr 2015
    Posts
    356

    Re: [VB6] - Injection to another process.

    Dear Lavolpe and Trick,
    I have already seen that this works for 32-bit applications.But I am telling when we run vb6 ide, in the taskmanager it shows it as 32-bit process.When we drag to vb6 ide window it is not displaying anything in the main form window .

    regards,
    JSVenu

  15. #15

  16. #16
    Hyperactive Member
    Join Date
    Apr 2015
    Posts
    356

    Re: [VB6] - Injection to another process.

    Quote Originally Posted by The trick View Post
    Do you have the permissions? Do you try to inject to IDE from the compiled EXE?
    Dear Trick,

    When I have run the injecting exe with run as admin it worked for vb ide.But it was not working for notepad.exe.Please tell me how make this work irrespective of 32 bit or 64-bit process. In particular how to make CreateRemoteThread , setthreadcontext ,GetThreadContext work for 32-bit or 64-bit process.

    regards,
    JSVenu

  17. #17

  18. #18
    Hyperactive Member
    Join Date
    Apr 2015
    Posts
    356

    Re: [VB6] - Injection to another process.

    Quote Originally Posted by The trick View Post
    Why do you need this? There is the documented approach which tells - create a separate 64 bit app which will interact with 64 bit app. You could to create a thread from a 32 bit app as well but this is quite complex and i don't see the reason to provide the code which can be used to write malicious app.
    Dear Trick,




    Thankyou for the reply.The injection succeeded for Notepad application also when I took the 32-bit notepad app from syswow64 directory.

    But When I try to inject a vb6 dll to 32-bit notepad application from my vb app using CreateRemoteThread it succeeds.Up here it is ok.
    In vb6 dll I kept inifinite loop in sub main so that the remote thread which injects into notepad exe continues to run.After that I suspended
    the remote thread and set the instruction pointer to to my function in my vb app and resumed the suspended remote thread.Here the application crashes.
    Please clarify how to make the code run without crash.My question is when both vb6 dll runtime is initialized thru notepad.exe and the vb6 exe runtime initialized by default why

    does code after resume remote thread fails to got to function set by context.eip and crashes.ie., how to make setthreadcontext work accross more than one exe(here vb exe and

    notepad.exe).

    Code for the injection in standard exe.

    Dim hRemote As Long '// Handle to remote thread
    Dim hDll As Long '// Handle to DLL
    Dim pThunRTMain As Long '// Pointer to ThunRTMain
    Dim pVBProject As Long '// Pointer to VB Process Structure
    Dim strRemotePlugin As Long '// Pointer that holds the plugin's DLL name in the remote process
    Dim hTargetInfo As Long '// Handle to the target process (Notepad) 32-bit
    Dim PID As Long '// PID of target process (Notepad)
    Dim strDLLInject As String '// DLL Name to inject
    Dim remotethreadid as Long
    ' // Run Notepad
    Shell "c:\windows\syswow64\notepad.exe", vbNormalFocus

    ' // Get it's PID
    GetWindowThreadProcessId FindWindow("Notepad", vbNullString), PID

    ' // Open it
    hTargetInfo = OpenProcess(PROCESS_ALL_ACCESS, 0, PID)

    ' // Set the DLL Name
    strDLLInject = "vbdll.dll"

    ' // Allocate memory for the DLL's Name
    strRemotePlugin = VirtualAllocEx(ByVal hTargetInfo, ByVal 0&, ByVal Len(strDLLInject), MEM_RESERVE Or MEM_COMMIT, PAGE_READWRITE)
    WriteProcessMemory hTargetInfo, ByVal strRemotePlugin, ByVal strDLLInject, Len(strDLLInject), 0

    ' // Load the Library in the remote Process
    hRemote = CreateRemoteThread(hTargetInfo, ByVal 0, 0, ByVal GetProcAddress(GetModuleHandleA("Kernel32"), "LoadLibraryA"), ByVal strRemotePlugin, 0, ByVal 0)

    ' // Load the Library
    hDll = LoadLibraryA(strDLLInject)

    ' // Get the VB Project Pointer
    RtlMoveMemory pVBProject, ByVal hDll + 78, 4




    ' // Load VB Runtime
    hDll = LoadLibrary("msvbvm60.dll")

    ' // Get Relative Pointer to ThunRTMain
    pThunRTMain = GetProcAddress(hDll, "ThunRTMain")

    ' // Free Library
    FreeLibrary hDll

    ' // Call Sub Main and Load Runtime
    hRemote = xCreateRemoteThread(hTargetInfo, ByVal 0, 0, ByVal pThunRTMain, ByVal pVBProject, 0, remotethreadid) ' works fine upto here

    'problematic code
    hThread = OpenThread(THREAD_ALL_ACCESS, 0, remotethreadid) 'get handle
    If hThread = 0 Then: Exit Function
    ChangeThreadCurrentPlace = True
    SuspendThread hThread 'suspend current thread
    nCONTEXT.ContexFlags = CONTEXT_FULL 'Set the flag to return all register values
    GetThreadContext hThread, nCONTEXT 'Get context, get register value
    nCONTEXT.Eip = GetAddr(myfunc) 'EIP
    SetThreadContext hThread, nCONTEXT 'make settings take effect
    ResumeThread hThread 'resume thread

    Code for GetAddr

    Function GetAddr(func as long) as long
    GetAddr= func
    End Function

    Code for myfunc

    Function myfunc( ) as long
    MsgBox "in vb exe"
    myfunc=1
    End Function


    Code of vb dll

    Sub main()
    MsgBox "in dll"
    Do
    Loop
    End Sub

    Since sending exes and dlls is not allowed I am sending the main required code.

    regards,
    JSVenu

  19. #19
    Hyperactive Member
    Join Date
    Apr 2015
    Posts
    356

    Re: [VB6] - Injection to another process.

    Quote Originally Posted by jsvenu View Post
    Dear Trick,




    Thankyou for the reply.The injection succeeded for Notepad application also when I took the 32-bit notepad app from syswow64 directory.

    But When I try to inject a vb6 dll to 32-bit notepad application from my vb app using CreateRemoteThread it succeeds.Up here it is ok.
    In vb6 dll I kept inifinite loop in sub main so that the remote thread which injects into notepad exe continues to run.After that I suspended
    the remote thread and set the instruction pointer to to my function in my vb app and resumed the suspended remote thread.Here the application crashes.
    Please clarify how to make the code run without crash.My question is when both vb6 dll runtime is initialized thru notepad.exe and the vb6 exe runtime initialized by default why

    does code after resume remote thread fails to got to function set by context.eip and crashes.ie., how to make setthreadcontext work accross more than one exe(here vb exe and

    notepad.exe).

    Code for the injection in standard exe.

    Dim hRemote As Long '// Handle to remote thread
    Dim hDll As Long '// Handle to DLL
    Dim pThunRTMain As Long '// Pointer to ThunRTMain
    Dim pVBProject As Long '// Pointer to VB Process Structure
    Dim strRemotePlugin As Long '// Pointer that holds the plugin's DLL name in the remote process
    Dim hTargetInfo As Long '// Handle to the target process (Notepad) 32-bit
    Dim PID As Long '// PID of target process (Notepad)
    Dim strDLLInject As String '// DLL Name to inject
    Dim remotethreadid as Long
    ' // Run Notepad
    Shell "c:\windows\syswow64\notepad.exe", vbNormalFocus

    ' // Get it's PID
    GetWindowThreadProcessId FindWindow("Notepad", vbNullString), PID

    ' // Open it
    hTargetInfo = OpenProcess(PROCESS_ALL_ACCESS, 0, PID)

    ' // Set the DLL Name
    strDLLInject = "vbdll.dll"

    ' // Allocate memory for the DLL's Name
    strRemotePlugin = VirtualAllocEx(ByVal hTargetInfo, ByVal 0&, ByVal Len(strDLLInject), MEM_RESERVE Or MEM_COMMIT, PAGE_READWRITE)
    WriteProcessMemory hTargetInfo, ByVal strRemotePlugin, ByVal strDLLInject, Len(strDLLInject), 0

    ' // Load the Library in the remote Process
    hRemote = CreateRemoteThread(hTargetInfo, ByVal 0, 0, ByVal GetProcAddress(GetModuleHandleA("Kernel32"), "LoadLibraryA"), ByVal strRemotePlugin, 0, ByVal 0)

    ' // Load the Library
    hDll = LoadLibraryA(strDLLInject)

    ' // Get the VB Project Pointer
    RtlMoveMemory pVBProject, ByVal hDll + 78, 4




    ' // Load VB Runtime
    hDll = LoadLibrary("msvbvm60.dll")

    ' // Get Relative Pointer to ThunRTMain
    pThunRTMain = GetProcAddress(hDll, "ThunRTMain")

    ' // Free Library
    FreeLibrary hDll

    ' // Call Sub Main and Load Runtime
    hRemote = xCreateRemoteThread(hTargetInfo, ByVal 0, 0, ByVal pThunRTMain, ByVal pVBProject, 0, remotethreadid) ' works fine upto here

    'problematic code
    hThread = OpenThread(THREAD_ALL_ACCESS, 0, remotethreadid) 'get handle
    If hThread = 0 Then: Exit Function
    ChangeThreadCurrentPlace = True
    SuspendThread hThread 'suspend current thread
    nCONTEXT.ContexFlags = CONTEXT_FULL 'Set the flag to return all register values
    GetThreadContext hThread, nCONTEXT 'Get context, get register value
    nCONTEXT.Eip = GetAddr(myfunc) 'EIP
    SetThreadContext hThread, nCONTEXT 'make settings take effect
    ResumeThread hThread 'resume thread

    Code for GetAddr

    Function GetAddr(func as long) as long
    GetAddr= func
    End Function

    Code for myfunc

    Function myfunc( ) as long
    MsgBox "in vb exe"
    myfunc=1
    End Function


    Code of vb dll

    Sub main()
    MsgBox "in dll"
    Do
    Loop
    End Sub

    Since sending exes and dlls is not allowed I am sending the main required code.

    regards,
    JSVenu
    Dear Trick,

    When CreateRemoteThread api internally uses SetThreadContext api for its implementation there should be some way to switch back from remote thread created in remote process(here 32-bit notepad app) to current thread in our vb application process address space.Please clarify how to make
    the above code work without crash across different processes by one process injecting dll into the other as above.

    regards,
    JSVenu

  20. #20
    Hyperactive Member
    Join Date
    Dec 2008
    Location
    Argentina
    Posts
    439

    Re: [VB6] - Injection to another process.

    Hi, I suppose that it was never possible to inject a process of 32 to one of 64? , I wanted to call the SetWindowDisplayAffinity api in another process, it works for me with the 32 but there are few applications with 32 :/
    leandroascierto.com Visual Basic 6 projects

  21. #21
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,625

    Re: [VB6] - Injection to another process.

    You'd need to update the types, pointer sizes, and offsets but no reason you couldn't compile this for 64bit with twinBASIC.

  22. #22
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,742

    Re: [VB6] - Injection to another process.

    You can design a 64-bit standard DLL agent program, injected into it, and then by the 32-bit EXE for specific operations, read memory, modify memory, or send data, receive data. Because we are more proficient in 32-bit program development.
    Just like network packet capture, we want to know what the web page posted or what the wss websocket sent. We don't need to write the packet capture software, we just need to receive the data and process the data from the packet capture tool or script.

  23. #23

  24. #24
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,742

    Re: [VB6] - Injection to another process.

    I am testing, using VB6 to develop standard DLL apis, injecting into c++, or freebasic written software.
    How to handle loading and unloading DLLS, and executing API functions inside.
    It used to be that unloading DLLS would cause the injected process to crash, or not be able to re-inject a second or third time.
    If the remote creation thread executes in the DLL, reading the return value may be fine, but the value in the parameter also changes, so how to call this will not be.

    Mainly or test VB6 write DLL, whether it is really perfect to achieve VC++ created DLL the same effect.

    VB6 DLL (test.dll) API run on notepad32.exe:
    Code:
    function add(byval a as long,byref b as long) as long
    add=a+b
    b=b*2
    end function
    how to remote call this api?
    need get value about :add, and changed value with b

    Code:
    dim a as long ,b as long ,c as long
    a=11
    b=22
    c=remotecall(dllpath,"Add",a,varptr(b))
    msgbox "c=" & c
    msgbox "b=" & b
    maybe can't use varptr(b),need make Memory ADDRESS From notepad32.exe,AND PUT THIS ADDRESS,NOT BYval
    Last edited by xiaoyao; May 14th, 2023 at 09:10 AM.

  25. #25
    Hyperactive Member
    Join Date
    Dec 2008
    Location
    Argentina
    Posts
    439

    Re: [VB6] - Injection to another process.

    Quote Originally Posted by The trick View Post
    You can inject a code from 32 bit app to a 64 bit application and run it.
    I died trying, I can't go to CreateRemoteThread, I couldn't do it, I also tried to move to twinbasic but I couldn't even on x32
    If you ever have some spare time and can show how to make in vb6 it work for x64 applications, I'd appreciate it.
    leandroascierto.com Visual Basic 6 projects

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width