DLL Injection Via VB

[Don Cullen]

I developed code to inject DLLs via VB. And I'm not sure if the code works- it executes without an error, so could someone be so kind as to test this code to confirm it is indeed working, that DLLs are indeed being injected?

Module.bas:

Code Select Expand

Private Declare Function CreateRemoteThread Lib "kernel32" (ByVal hProcess As Long, lpThreadAttributes As Long, ByVal dwStackSize As Long, lpStartAddress As Long, lpParameter As Any, ByVal dwCreationFlags As Long, lpThreadId As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal DesiredAccess As Long, ByVal bInheritHandle As Long, ByVal ProcessId As Long) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function LoadLibraryA Lib "kernel32" (ByVal lpLibFileName As String) As Long
Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Function VirtualAllocEx Lib "kernel32" (ByVal hProcess As Long, ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Private Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Function VirtualProtectEx Lib "kernel32" (ByVal hProcess As Long, lpAddress As Any, ByVal dwSize As Long, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long

Private lpWnd, lpId, lpHandle As Long
Private bGameActive As Boolean

Private Const PROCESS_ALL_ACCESS As Long = &H1F0FFF
Private Const PAGE_EXECUTE_READWRITE = &H40&
Private Const PAGE_READONLY = &H2&
Private Const PAGE_READWRITE = &H4&
'

Private Sub InjectDLL(ProcessId As Long, DLLName As String)
    Dim Proc As Long
    Proc = OpenProcess(PROCESS_ALL_ACCESS, 0, ProcessId)
    MsgBox Proc
    If Proc = False Then
        MsgBox "DLL Load Failure!"
        Exit Sub
    End If
   
    LoadLibAddy = GetProcAddress(GetModuleHandle("kernel32.dll"), "LoadLibraryA")

    RemoteString = VirtualAllocEx(Proc, 0, Len(DLLName), MEM_RESERVE Or MEM_COMMIT, PAGE_READWRITE)
    WriteProcessMemory Proc, RemoteString, DLLName, Len(DLLName), 0
    CreateRemoteThread Proc, 0, 0, LoadLibAddy, RemoteString, 0, 0
   
    CloseHandle (Proc)
End Sub

Public Sub Initialize()

    Dim iResult As Integer
    lpWnd = FindWindow("SWarClass", "Brood War")
   
    If (lpWnd <> 0) Then
        bGameActive = True
        GetWindowThreadProcessId lpWnd, lpId
        lpHandle = OpenProcess(PROCESS_ALL_ACCESS, False, lpId)
    Else
        bGameActive = False
        iResult = MsgBox("Starcraft is not running! Please turn it on now, then hit Ok.", vbOKCancel + vbCritical, "Error!")
        If (iResult = vbOK) Then
            Call Initialize
        End If
    End If
    InjectDLL lpHandle, "exampledll"
   
End Sub

Public Sub CleanUp()
    If (bGameActive = False) Then
        Exit Sub
    Else
        CloseHandle lpHandle
        bGameActive = False
    End If
End Sub