[Tutorial] Make A Manual Injector

'krisna Ganteng
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Dim Content As String
Dim DllPath As String
Dim ExeName As Integer
Dim i As Long
Dim merah, hijau, biru As Integer
Private 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
Const TH32CS_SNAPHEAPLIST = &H1
Const TH32CS_SNAPPROCESS = &H2
Const TH32CS_SNAPTHREAD = &H4
Const TH32CS_SNAPMODULE = &H8
Const TH32CS_SNAPALL = (TH32CS_SNAPHEAPLIST Or TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE)
Const TH32CS_INHERIT = &H80000000
Const MAX_PATH As Integer = 260
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 Declare Function CreateToolhelp32Snapshot Lib "Kernel32" (ByVal lFlags As Long, ByVal lProcessID 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 OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32.dll" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hHandle As Long) As Long
Private Const PROCESS_ALL_ACCESS = &H1F0FFF
Private Const PROCESS_QUERY_INFORMATION As Long = &H400
Private Const PROCESS_VM_READ = &H10
Private Declare Function EnumProcessModules Lib "psapi.dll" ( _
ByVal hProcess As Long, _
ByRef lphModule As Long, _
ByVal cb As Long, _
ByRef cbNeeded As Long) As Long
Private Declare Function GetModuleFileNameExA Lib "psapi.dll" ( _
ByVal hProcess As Long, _
ByVal hModule As Long, _
ByVal ModuleName As String, _
ByVal nSize As Long) As Long

Public Function Link(ByVal URL As String) As Long
Link = ShellExecute(0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus)
End Function

Private Sub Command1_Click()
'saat open target dll yg mau di inject sediakan common dialog
CommonDialog1.Filter = "Library|*.DLL"
CommonDialog1.ShowOpen
Text1.Text = CommonDialog1.FileName
Text1.SetFocus
End Sub

Private Sub Command2_Click()
'saat open target yg mau dituju sediakan common dialog
CommonDialog1.Filter = "Application|*.EXE"
CommonDialog1.ShowOpen
Text2.Text = CommonDialog1.FileTitle
Text2.SetFocus
End Sub

Private Sub Command3_Click()
If ExeName = 1 Then
ProsH = GetHProcExe(Text2.Text)
If ProsH = 0 Then Label1.Caption = "Can't Find Target": Exit Sub
DllPath = Text1.Text
InjectDll DllPath, ProsH
Else
ProsH = FindProc(Text2.Text)
If ProsH = 0 Then Label1.Caption = "Can't Find Target!": Exit Sub
DllPath = Text1.Textes
InjectDll DllPath, ProsH
End Ifs
End Sub

Private Sub Command4_Click()
'command buat about
MsgBox "Created by Krisna Ganteng" & vbCrLf & "Project ini Di-dedikasikan kepada" & vbCrLf & "Tamboreshacker", vbInformation
End Sub

Private Sub Command5_Click()
'Beri salam perpisahan
MsgBox "Krisna Ganteng Bange'", vbInformation
Unload Me
End Sub

Private Sub Command6_Click()
'untuk membuka sesuatu
Talk
End Sub
Sub Talk()
If Command6.Caption = "my inpiration" Then
Command6.Caption = "Do More"
Command6.ToolTipText = "Click to Close Tools"
krisnaInjector.Height = 7560
Else
Command6.Caption = "my inpiration"
Command6.ToolTipText = "Click to Open Tools"
krisnaInjector.Height = 3840
End If
End Sub

Private Sub Form_Load()
'Beri Salam saat pembukaan
MsgBox "Created by Krisna Ganteng", vbInformation, " ...:::WELCOME:::..."
Option1(0).Value = True
Text2.Text = Load("HProcess", "Box2")
If Text2.Text = Check Then Text2.Text = ""
Text1.Text = Load("DllPath", "Box1")
If Text1.Text = Check Then Text1.Text = ""
End Sub


Private Sub Option1_Click(Index As Integer)
'option auto/manual buat EXE
Select Case Index
Case 0
Label4.Caption = "Process Name:"
Command2.Enabled = True
ExeName = 1
Case 1
Label4.Caption = "Window Name:"
Command2.Enabled = False
ExeName = 2
End Select
End Sub
Private Sub Option2_Click(Index As Integer)
'option auto/manual buat DLL
Select Case Index
Case 0
Label1.Caption = "Name DLL:"
Command1.Enabled = True
DLLName = 1
Case 1
Label1.Caption = "Auto Search DLL:"
Command1.Enabled = False
DLLName = 2
End Select
End Sub

Private Sub Timer1_Timer()
Dim str As String
keyresult = GetAsyncKeyState(96)
If keyresult = -32767 Then
If ExeName = 1 Then
ProsH = GetHProcExe(Text2.Text)
If ProsH = 0 Then Label4.Caption = "aku tidak bisa menemukan target!": Exit Sub
DllPath = Text1.Text
InjectDll DllPath, ProsH
Else
ProsH = FindProc(Text2.Text)
If ProsH = 0 Then Label4.Caption = "aku tidak bisa menemukan target!": Exit Sub
DllPath = Text1.Text
InjectDll DllPath, ProsH
End If
End If
End Sub
Public Function PathByPID(pid As Long) As String
Dim cbNeeded As Long
Dim Modules(1 To 200) As Long
Dim ret As Long
Dim ModuleName As String
Dim nSize As Long
Dim hProcess As Long

hProcess = OpenProcess(PROCESS_QUERY_INFORMATION _
Or PROCESS_VM_READ, 0, pid)

If hProcess <> 0 Then

ret = EnumProcessModules(hProcess, Modules(1), _
200, cbNeeded)

If ret <> 0 Then
ModuleName = Space(MAX_PATH)
nSize = 500
ret = GetModuleFileNameExA(hProcess, _
Modules(1), ModuleName, nSize)
PathByPID = Left(ModuleName, ret)
End If
End If

ret = CloseHandle(hProcess)

If PathByPID = "" Then
PathByPID = ""
End If

If Left(PathByPID, 4) = "\??\" Then
PathByPID = ""
End If


If Left(PathByPID, 12) = "\SystemRoot\" Then
PathByPID = ""
End If
End Function

Private Sub Form_Unload(Cancel As Integer)
Call Save("HProcess", "Box2", Text2.Text)
Call Save("DllPath", "Box1", Text1.Text)
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)

OpenURL "http://www.facebook.com/RadenKrisnaIndrawan", Me.hwnd
Dim quit
MsgBox "krisna Ganteng'", vbInformation
Exit Sub

End Sub

'modul Browse
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

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

Public Const PROCESS_ALL_ACCESS As Long = &H1F0FFF

Option Explicit
Public Declare Function OpenProcess Lib "Kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal Classname As String, ByVal WindowName As String) As Long
Public Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function CreateToolhelpSnapshot Lib "Kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, ByVal lProcessID 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 Sub CloseHandle Lib "Kernel32" (ByVal hPass As Long)


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 * 260
End Type

Public Function GetHProcExe(strExeName As String) As Long
Dim hSnap As Long
    hSnap = CreateToolhelpSnapshot(2, 0)
   
Dim peProcess As PROCESSENTRY32
    peProcess.dwSize = LenB(peProcess)
   
Dim nProcess As Long
    nProcess = Process32First(hSnap, peProcess)
    Do While nProcess
        If StrComp(Trim$(peProcess.szExeFile), strExeName, vbTextCompare) _
            = 0 Then
            GetHProcExe = OpenProcess(PROCESS_ALL_ACCESS, False, peProcess.th32ProcessID)
            Exit Function
        End If
        peProcess.szExeFile = vbNullString
        nProcess = Process32Next(hSnap, peProcess)
    Loop
    CloseHandle hSnap
End Function
Public Function FindProc(ProcName As String) As Long
Dim hwnd As Long
Dim ProcessID As Long
Dim ProcessHandle As Long
hwnd = FindWindow(vbNullString, ProcName)
GetWindowThreadProcessId hwnd, ProcessID
ProcessHandle = OpenProcess(PROCESS_ALL_ACCESS, False, ProcessID)
FindProc = ProcessHandle
End Function

'Module Injectionya
'By cRoZzye
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 LoadLibrary Lib "Kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName 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
Public 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 ProsH As Long


Public Function InjectDll(DllPath As String, ProsH As Long)
Dim DLLVirtLoc As Long, DllLength, Inject As Long, LibAddress As Long
Dim CreateThread As Long, ThreadID As Long


krisnaInjector.Label4.Caption = "Mohon tunggu"
'Find a nice spot for your DLL to chill using VirtualAllocEx
DllLength = Len(DllPath)
DLLVirtLoc = VirtualAllocEx(ProsH, ByVal 0, DllLength, &H1000, ByVal &H4)
If DLLVirtLoc = 0 Then krisnaInjector.Label1.Captsion = "Aku tidak menemukan target": Exit Function
'Inject the Dll into that spot
Inject = WriteProcessMemory(ProsH, DLLVirtLoc, ByVal DllPath, DllLength, vbNull)
If Inject = 0 Then krisnaInjector.Label1.Caption = "Gagal untuk inject target"
krisnaInjector.Label1.Captsion = "Dll Injected"
LibAddress = GetProcAddress(GetModuleHandle("kernel32.dll"), "LoadLibraryA")
If LibAddress = 0 Then krisnaInjector.Label1.Caption = "tidak menemukan kernel32.dll": Exit Function
CreateThread = CreateRemoteThread(ProsH, vbNull, 0, LibAddress, DLLVirtLoc, 0, ThreadID)
If CreateThread = 0 Then krisnaInjector.Label1.Caption = "gagal untuk inject"
krisnaInjector.Label1.Caption = "Process DLL Inject Suskses!"
End Function

]Declare Function WritePrivateProfileString Lib "Kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationname As String, ByVal lpKeyName As Any, ByVal lsString As Any, ByVal lplFilename As String) As Long
Declare Function GetPrivateProfileString Lib "Kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationname As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Public Check As String

Public Function Load(Section As String, Key As String) As String
Dim lngResult As Long
Dim strFileName
Dim strResult As String * 300
strFileName = App.Path & "\sets.ini"
lngResult = GetPrivateProfileString(Section, Key, strFileName, strResult, Len(strResult), strFileName)
Check = App.Path & "\sets.ini"
Load = Trim(strResult)
End Function

Public Function Save(Section As String, Key As String, Content As String)
Dim lngResult As Long
Dim strFileName
strFileName = App.Path & "\sets.ini"
lngResult = WritePrivateProfileString(Section, Key, Content, strFileName)
End Function

'modul buat Project
Private Const EWX_LOGOFF = 0
Private Const EWX_SHUTDOWN = 1
Private Const EWX_REBOOT = 2
Private Const EWX_FORCE = 4
Private Const TOKEN_ADJUST_PRIVILEGES = &H20
Private Const TOKEN_QUERY = &H8
Private Const SE_PRIVILEGE_ENABLED = &H2
Private Const ANYSIZE_ARRAY = 1
Private Const VER_PLATFORM_WIN32_NT = 2
Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type
Type LUID
    LowPart As Long
    HighPart As Long
End Type
Type LUID_AND_ATTRIBUTES
    pLuid As LUID
    Attributes As Long
End Type
Type TOKEN_PRIVILEGES
    PrivilegeCount As Long
    Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
End Type
Private Declare Function GetCurrentProcess Lib "Kernel32" () As Long
Private Declare Function OpenProcessToken Lib "advapi32" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function LookupPrivilegeValue Lib "advapi32" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
Private Declare Function AdjustTokenPrivileges Lib "advapi32" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long
Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Private Declare Function GetVersionEx Lib "Kernel32" Alias "GetVersionExA" (ByRef lpVersionInformation As OSVERSIONINFO) As Long

Public Function IsWinNT() As Boolean
    Dim myOS As OSVERSIONINFO
    myOS.dwOSVersionInfoSize = Len(myOS)
    GetVersionEx myOS
    IsWinNT = (myOS.dwPlatformId = VER_PLATFORM_WIN32_NT)
End Function

Private Sub EnableAction()
    Dim hProc As Long
    Dim hToken As Long
    Dim mLUID As LUID
    Dim mPriv As TOKEN_PRIVILEGES
    Dim mNewPriv As TOKEN_PRIVILEGES
    hProc = GetCurrentProcess()
    OpenProcessToken hProc, TOKEN_ADJUST_PRIVILEGES + TOKEN_QUERY, hToken
    LookupPrivilegeValue "", "SeShutdownPrivilege", mLUID
    mPriv.PrivilegeCount = 1
    mPriv.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
    mPriv.Privileges(0).pLuid = mLUID

    AdjustTokenPrivileges hToken, False, mPriv, 4 + (12 * mPriv.PrivilegeCount), mNewPriv, 4 + (12 * mNewPriv.PrivilegeCount)
End Sub

Public Sub ShutDownNT(Force As Boolean, Action As Integer)
    Dim ret As Long
    Dim Flags As Long
      Select Case Action
        Case 0
          Flags = EWX_LOGOFF
        Case 1
          Flags = EWX_SHUTDOWN
        Case 2
          Flags = EWX_REBOOT
      End Select
    If Force Then Flags = Flags + EWX_FORCE
    If IsWinNT Then EnableAction
    ExitWindowsEx Flags, 0
End Sub