Cara membuat Injector DLL dengan Visual Basic 6.0

Cara membuat Injector DLL dengan Visual Basic 6.0

Halo! bersama lagi bersama saya :)
Pada pelajaran hari ini saya akan membuat aplikasi Injector DLL dengan program Visual Basic 6.0
Bahan yang di butuhkan untuk membuat adalah :
Visual Studio 6.0 Professional Edition [ Download ] / Enterpize Edition [ Download ]

Langsung saja ke TKP! hehehe...

1. Pertama buka VB 6.0
2. Setelah membuka VB 6.0-nya, lalu pilih Standard EXE, klik Open
3. Pada Form1, pilih BorderStyle : 0 - None, di bagian Properties
4. Pada Caption, terserah anda, misalnya Trainer CS 1.6 By SamFX
5. Pada Icon, cari sendiri icon yang anda miliki
6. Pada ShowInTaskbar, pilih True
7. Pada StartUpPosition, pilih 3 - CenterScreen
8. Dan buat 1 Form lagi bernama : Form2
9. Seperti diatas tetapi lihat di bawah ini :
( Tip : Jika kurang jelas, silahkan di klik )

Contoh programnya

10. Masukkan kode di bawah ini untuk Form1

Option Explicit
'Created Date: 15 September 2013
'Form1 Counter Strike 1.6 Injector by M.Sammy Budiarjo
'Email : samfx66@gmail and sfxpm.inc@gmail
'Editan : Ya

Private winHwnd As Long
Private NamaDll As String
Private Keluardariprogram As String

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()
NamaDll = App.Path & "\CounterStrike1.6Injector.dll" 'Tidak diberbolehkan spasi

FileTarget = "hl.exe"

Check1.Value = 1
End Sub

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

Private Sub lblAbout_Click()
Form2.Show
End Sub

Private Sub lblClose_Click()
Keluardariprogram = MsgBox("         Close this program?", vbYesNo, "Exit")
If Keluardariprogram = vbYes Then Unload Me
End Sub

Private Sub Timer1_Timer()
winHwnd = GetProcessWndByName(FileTarget)
If Not winHwnd = 0 Then
NTProcessList
InjectExecute NamaDll
If Check1.Value = 1 Then
End
End If
Else
Label1.Caption = "Waiting hl.exe"
End If
End Sub

Yang warna merah silahkan anda edit

Yang warna orange jangan di edit

11. Masukkan kode di bawah ini pada form2

Private Sub lblCloseAboutMenu_Click()

Unload Me

End Sub

12. Buat 1 module bernama : ModInjector, dan massukan kode di bawah ini pada module tersebut

Option Explicit

'Created Date: 15 September 2013

'Form1 Counter Strike 1.6 Injector by M.Sammy Budiarjo

'Email : samfx66@gmail and sfxpm.inc@gmail

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

Yang warna orange jangan di ganti

13. Jika sudah di coba dulu program-nya

14. Jika sudah benar, kita compile menjadi EXE, caranya :

14 : 1. Klik menu File

14 : 2. Klik sub menu Make Nama project anda.exe

15. Enjoy, Heppy programming :D