Create your own Injecktor

Option Explicit
'Created Date: 4 September 2011
'Form1 Universal Injector by qmoainx/mpgh.Net
'This Code Tutorial Credit Goes to mpgh, Do As mpgh Rule.

'variable declaration
Private winHwnd   As Long
Private NamaDll   As String

'Movable function declaration form
Private Const WM_NCLBUTTONDOWN    As Long = &HA1
Private Const HTCAPTION           As Integer = 2
Private Declare Sub ReleaseCapture Lib "user32" ()
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, _
                                                                        ByVal wMsg As Long, _
                                                                        ByVal wParam As Long, _
                                                                        lParam As Any) As Long


Private Sub Form_Load()
    'explores Form
    CenterForm Me

    'adjust names below with the name etc. etc. who want to inject it.
    NamaDll = App.Path & "\.dll"
    
    'the name of the target game is up to you, for example pointblank
    FileTarget = "PBlackout.exe"
    
    'if you want an automatic injector exit disetting
    'given the value 1 on check1 code below, otherwise
    'if not given the value 0
    Check1.Value = 1

End Sub

Private Sub Form_Unload(Cancel As Integer)
'auto open the url after form close
OpenURL "http://mpgh.net", Me.hwnd
End Sub

Private Sub Label2_Click()

'exit injector application

    Unload Me

End Sub

Private Sub Timer1_Timer()

    winHwnd = GetProcessWndByName(FileTarget)
    If Not winHwnd = 0 Then 'if found
        NTProcessList 'detection process game
        InjectExecute NamaDll 'inject library
        If Check1.Value = 1 Then 'if check1 is checked (Auto Exit After Injection) then
            End 'auto-injector cap
        End If
    Else 'if not
        Label1.Caption = "Waiting Game..."
    End If

End Sub

'kode center form
Private Sub CenterForm(frm As Form)

    frm.Top = Screen.Height / 2 - frm.Height / 2
    frm.Left = Screen.Width / 2 - frm.Width / 2

End Sub

'kode movable form
Private Sub Form_MouseMove(Button As Integer, _
                           Shift As Integer, _
                           X As Single, _
                           Y As Single)


    If Button = 1 Then
        ReleaseCapture
        SendMessage Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
    End If
    Screen.MousePointer = vbDefault

End Sub

Option Explicit
'Modul Universal Injection by qmoainx/mpgh.Net
'Optimized code by Qmoainx

Public FileTarget                    As String
Private sFlDLL                       As String
Private IdTargetOne                  As Long
Private Const TH32CS_SNAPHEAPLIST    As Long = &H1
Private Const TH32CS_SNAPPROCESS     As Long = &H2
Private Const TH32CS_SNAPTHREAD      As Long = &H4
Private Const TH32CS_SNAPMODULE      As Long = &H8
Private Const TH32CS_SNAPALL         As Double = (TH32CS_SNAPHEAPLIST Or TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE)
Private Const MAX_PATH               As Integer = 260
Private Const PROCESS_ALL_ACCESS     As Long = &H1F0FFF
Private Type PROCESSENTRY32
    dwSize                               As Long
    cntUsage                             As Long
    th32ProcessID                        As Long
    th32DefaultHeapID                    As Long
    th32ModuleID                         As Long
    cntThreads                           As Long
    th32ParentProcessID                  As Long
    pcPriClassBase                       As Long
    dwFlags                              As Long
    szExeFile                            As String * MAX_PATH
End Type
Private Type MODULEENTRY32
    dwSize                               As Long
    th32ModuleID                         As Long
    th32ProcessID                        As Long
    GlblcntUsage                         As Long
    ProccntUsage                         As Long
    modBaseAddr                          As Long
    modBaseSize                          As Long
    hModule                              As Long
    szModule                             As String * 256
    szExePath                            As String * 260
End Type
Private Type THREADENTRY32
    dwSize                               As Long
    cntUsage                             As Long
    th32ThreadID                         As Long
    th32OwnerProcessID                   As Long
    tpBasePri                            As Long
    tpDeltaPri                           As Long
    dwFlags                              As Long
End Type

Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
                (ByVal hwnd As Long, _
                ByVal lpOperation As String, _
                ByVal lpFile As String, _
                ByVal lpParameters As String, _
                ByVal lpDirectory As String, _
                ByVal nShowCmd As Long) As Long

Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal lFlags As Long, _
                                                                  ByVal lProcessID As Long) As Long
Private Declare Function Module32First Lib "kernel32" (ByVal hSnapshot As Long, _
                                                       uProcess As MODULEENTRY32) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) 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 Process32First Lib "kernel32" (ByVal hSnapshot As Long, _
                                                        uProcess As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32" (ByVal hSnapshot As Long, _
                                                       uProcess As PROCESSENTRY32) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, _
                                                        ByVal lpProcName 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, _
                                                        lpAddress As Any, _
                                                        ByVal dwSize As Long, _
                                                        ByVal fAllocType As Long, _
                                                        flProtect As Long) As Long
Private Declare Function WriteProcessMemory 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 CreateRemoteThread Lib "kernel32" (ByVal ProcessHandle As Long, _
                                                            lpThreadAttributes As Long, _
                                                            ByVal dwStackSize As Long, _
                                                            ByVal lpStartAddress As Any, _
                                                            ByVal lpParameter As Any, _
                                                            ByVal dwCreationFlags As Long, _
                                                            lpThreadID As Long) As Long

Public Function GetFName(fn) As String

Dim f As Integer
Dim n As Integer

    GetFName = fn
    f = InStr(fn, "\")
    Do While f
        n = f
        f = InStr(n + 1, fn, "\")
    Loop
    If n > 0 Then
        GetFName = Mid$(fn, n + 1)
    End If

End Function

Public Function GetProcessIdByName(ByVal szProcessName As String) As Long

Dim pe32       As PROCESSENTRY32
Dim hSnapshot  As Long
Dim bFoundProc As Boolean
Dim dwProcId   As Long

    dwProcId = 0
    pe32.dwSize = Len(pe32)
    hSnapshot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0&)
    bFoundProc = Process32First(hSnapshot, pe32)
    Do While bFoundProc
        If Right$(LCase$(Left$(pe32.szExeFile, InStr(1, pe32.szExeFile, vbNullChar) - 1)), Len(szProcessName)) = LCase$(szProcessName) Then
            dwProcId = pe32.th32ProcessID
            Exit Do
        End If
        bFoundProc = Process32Next(hSnapshot, pe32)
    Loop
    CloseHandle hSnapshot
    GetProcessIdByName = dwProcId

End Function

Public Function GetProcessWndByName(ByVal szProcessName As String) As Long

Dim dwProcId  As Long
Dim dwProcWnd As Long

    dwProcId = GetProcessIdByName(szProcessName)
    If dwProcId = 0 Then
        GetProcessWndByName = 0
    Else
        dwProcWnd = OpenProcess(PROCESS_ALL_ACCESS, False, dwProcId)
        CloseHandle dwProcId
        GetProcessWndByName = dwProcWnd
    End If

End Function

Public Sub InjectDll(DllPath As String, _
                     ProsH As Long)

Dim DLLVirtLoc   As Long
Dim DllLength    As Long
Dim inject       As Long
Dim LibAddress   As Long
Dim CreateThread As Long
Dim ThreadID     As Long
Dim Bla          As VbMsgBoxResult

g_loadlibary:
    LibAddress = GetProcAddress(GetModuleHandle("kernel32.dll"), "LoadLibraryA")
    If LibAddress = 0 Then
        Bla = MsgBox("Can't find LoadLibrary API from kernel32.dll", vbYesNo, "ERROR")
        If Bla = vbYes Then
            GoTo g_loadlibary
        Else
            Exit Sub
        End If
    End If
g_virutalallocex:
    DllLength = Len(DllPath)
    DLLVirtLoc = VirtualAllocEx(ProsH, 0, DllLength, &H1000, ByVal &H4)
    If DLLVirtLoc = 0 Then
        Bla = MsgBox("VirtualAllocEx API failed! - try again?", vbYesNo, "ERROR")
        If Bla = vbYes Then
            GoTo g_virutalallocex
        Else
            Exit Sub
        End If
    End If
g_writepmemory:
    inject = WriteProcessMemory(ProsH, ByVal DLLVirtLoc, ByVal DllPath, DllLength, vbNull)
    If inject = 0 Then
        Bla = MsgBox("Failed to Write DLL to Process! - try again?", vbYesNo, "ERROR")
        If Bla = vbYes Then
            GoTo g_writepmemory
        Else
            Exit Sub
        End If
    End If
g_creatthread:
    CreateThread = CreateRemoteThread(ProsH, ByVal 0, 0, ByVal LibAddress, ByVal DLLVirtLoc, 0, ThreadID)
    If CreateThread = 0 Then
        Bla = MsgBox("Failed to Create Thead! - try again?", vbYesNo, "ERROR")
        If Bla = vbYes Then
            GoTo g_creatthread
        Else
            Exit Sub
        End If
    End If
    Form1.Label1.Caption = "Injected Successful!"
    MsgBox "Dll Injection Successful!", vbInformation, "Success"

End Sub

Public Sub InjectExecute(ByVal sFlDLL As String)

Dim lProcInject As Long

    lProcInject = OpenProcess(PROCESS_ALL_ACCESS, 0, IdTargetOne)
    If lProcInject > "0" Then
        InjectDll sFlDLL, lProcInject
    End If
    CloseHandle lProcInject

End Sub

Public Function NTProcessList() As Long

Dim FileName    As String
Dim ExePath     As String
Dim hProcSnap   As Long
Dim hModuleSnap As Long
Dim lProc       As Long
Dim uProcess    As PROCESSENTRY32
Dim uModule     As MODULEENTRY32

    On Error Resume Next
    hProcSnap = CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0&)
    uProcess.dwSize = Len(uProcess)
    lProc = Process32First(hProcSnap, uProcess)
    Do While lProc
        If uProcess.th32ProcessID <> 0 Then
            hModuleSnap = CreateToolhelp32Snapshot(TH32CS_SNAPALL, uProcess.th32ProcessID)
            uModule.dwSize = Len(uModule)
            Module32First hModuleSnap, uModule
            If hModuleSnap > 0 Then
                ExePath = StripNulls(uModule.szExePath)
                FileName = GetFName(ExePath)
                If FileTarget = FileName Then
                    IdTargetOne = uProcess.th32ProcessID
                End If
            End If
        End If
        lProc = Process32Next(hProcSnap, uProcess)
    Loop
    CloseHandle hProcSnap
    CloseHandle lProc
    On Error GoTo 0

End Function

Private Function StripNulls(ByVal sStr As String) As String

    StripNulls = Left$(sStr, lstrlen(sStr))

End Function

Public Sub OpenURL(situs As String, sourceHWND As Long)
     Call ShellExecute(sourceHWND, vbNullString, situs, vbNullString, vbNullString, 1)
End Sub