'PerX [R] Injector by Alan Januari
'Created Date: 2 Januari 2012

Credit goes to:
AgusWahidPrastyo a.k.a AWP-Slankers [www.awp1st.net]
rifqi36 [www.nyit-nyit.net]
RichardYusan a.k.a RCD [www.richardyusan.wordpress.com]
Reckless Youth [www.MPCforum.com]
Mark Thesing [www.VBforums.com]
Menthol [www.Forum Tetangga.Us] <~ thx for support

Fitur:
1.Multi Dll injection
2.Program akan diDelete secara otomatis jika:
-Nama Program diubah
-Nama Author diubah
-Hak cipta diubah
-Deskripsi program diubah
-Ukuran file(kb) berubah
-isi program dirubah dengan OllyDbg atau Debugger
3.Dapat menggunakan icon 32bit (Lihat keterangan gambar)
4.mendeteksi jika program yang akan diinject sedang running/berjalan
5.Hotkey [F1] sebagai pengganti tombol inject


PENTING !
KODE/SOURCE CODE INI TIDAK DIPERBOLEHKAN DI SHARE KE SITUS/FORUM MANAPUN TANPA IZIN DARI AUTHOR(GembelRasta)!!!
Untuk proteksi yang lebih baik gunakan VMProtect,UPX atau Exe compressor lain,Sesuaikan ukuran file pada Check_Size setelah di Compress
Informasi lebih lanjut kirim ke : rastasoul58@yahoo.co.id(Email & Facebook)


pertama-tama siapkan object berikut:
2 listbox

6 Label dengan caption:
label1>What to inject:
label2>What to inject:
label3>After Injection:
label4>label 4<masukkan kedalam picturebox,caranya klik label 4 kemudian cut(ctrl x) lalu klik picture box dan paste(ctrl v)
label5>Terserah agan mo nulis apa

5 CommandButton dengan caption:
command1>&Browse
command2>Remove &Selected
command3>&Clear List
command4>I&nject
command5>&Quit

2 OptionButton dengan caption:
Option1(0)>Automatically
Option1(1)>Manually
NB : control Option button dibuat control array

1 Checkbox dengan caption Quit when finished

1 textbox

5 timer
NB: Timer5 beri nama tmrDetect

1 Picture box

2 frame

1 CommonDialog dengan nama CD1

5 module dengan nama:
mod32BitIcon
modConfig
modDetect
modInjection
ModKillApp

Lalu copykan code berikut pada Form
'PerX [R] Injector by GembelRasta
'Created Date: 25 September 2011


'PerX [R] Injector by Alan Januari
'Created Date: 2 Januari 2012

'thanx to:
'AgusWahidPrastyo a.k.a AWP-Slankers [www.awp1st.net]
'rifqi36 [www.nyit-nyit.net]
'RichardYusan a.k.a RCD [www.richardyusan.blogspot.com]
'Reckless Youth [www.MPCforum.com]
'Mark Thesing [www.VBforums.com]

'Fitur:
'1.Multi Dll injection
'2.Program akan diDelete secara otomatis jika:
' -Nama Program diubah
' -Nama Author diubah
' -Hak cipta diubah
' -Deskripsi program diubah
' -Ukuran file(kb) berubah
' -isi program dirubah dengan OllyDbg atau Debugger
'3.Dapat menggunakan icon 32bit (Lihat keterangan gambar)
'4.mendeteksi jika program yang akan diinject sedang running/berjalan

'Penting !
'Code ini tidak boleh di share/dibagikan ke situs ataupun forum lain tanpa izin dari Author (GembelRasta)!
'Untuk proteksi yang lebih baik gunakan VMProtect,UPX atau Exe compressor lain,Sesuaikan ukuran file pada Check_Size setelah di Compress
'Informasi lebih lanjut kirim ke : vinonever@yahoo.com(Email & Facebook)
Option Explicit

Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Dim DllPath As String

Private Declare Function IsDebuggerPresent Lib "kernel32" () 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 CloseHandle Lib "kernel32" ( _
ByVal hObject As Long) As Long
Private Declare Function EnumProcesses Lib "PSAPI.DLL" ( _
lpidProcess As Long, ByVal cb As Long, cbNeeded As Long) As Long
Private Declare Function EnumProcessModules Lib "PSAPI.DLL" ( _
ByVal hProcess As Long, lphModule As Long, ByVal cb As Long, lpcbNeeded As Long) As Long
Private Declare Function GetModuleBaseName Lib "PSAPI.DLL" Alias "GetModuleBaseNameA" ( _
ByVal hProcess As Long, ByVal hModule As Long, ByVal lpFileName As String, ByVal nSize As Long) As Long

Private Const PROCESS_VM_READ = &H10
Private Const PROCESS_QUERY_INFORMATION = &H400

Private Function IsProcessRunning(ByVal sProcess As String) As Boolean
Const MAX_PATH As Long = 260
Dim lProcesses() As Long, lModules() As Long, N As Long, lRet As Long, hProcess As Long
Dim sName As String

sProcess = UCase$(sProcess)

ReDim lProcesses(1023) As Long
If EnumProcesses(lProcesses(0), 1024 * 4, lRet) Then
For N = 0 To (lRet \ 4) - 1
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, lProcesses(N))
If hProcess Then
ReDim lModules(1023)
If EnumProcessModules(hProcess, lModules(0), 1024 * 4, lRet) Then
sName = String$(MAX_PATH, vbNullChar)
GetModuleBaseName hProcess, lModules(0), sName, MAX_PATH
sName = Left$(sName, InStr(sName, vbNullChar) - 1)
If Len(sName) = Len(sProcess) Then
If sProcess = UCase$(sName) Then IsProcessRunning = True: Exit Function
End If
End If
End If
CloseHandle hProcess
Next N
End If
End Function

Function Check_OllyDBG()
If IsProcessRunning("ollydbg.exe") = True Then
Call DeleteAPP
Kill App.Path & "\PerX.ini"
MsgBox "Debugger Detected is running on your computer, please turn it down and reboot your computer", vbExclamation, "Error"
End
End If

End Function

Function Check_Debugger()
If IsDebuggerPresent <> 0 Then
Call DeleteAPP
Kill App.Path & "\PerX.ini"
MsgBox "Debugger Detected is running on your computer, please turn it down and reboot your computer", vbExclamation, "Error"
End
End If

End Function

Function Check_Size()
On Error GoTo err
If FileLen(App.EXEName + ".exe") <> 499712 Then '499712 adalah file size(kb) setelah dicompile,sesuaikan jika anda menggunakan VMProtect,UPX atau exe compressor lainnya
Call DeleteAPP
Kill App.Path & "\PerX.ini"
MsgBox "File Size is changed !, Application will delete from your computer...", vbCritical, "Error"
End
End If
err:
End Function

Function Check_Misc()
On Error Resume Next

If App.CompanyName <> "x1nixmzeng" Then 'jika credit author diganti
Call DeleteAPP 'aplikasi akan di delete secara otomatis
Kill App.Path & "\PerX.ini"
MsgBox "Company name has been changed, Application will delete from your computer...", vbCritical, "Error"
End
End If

If App.EXEName <> "PerX [R]" Then 'idem
Call DeleteAPP
Kill App.Path & "\PerX.ini"
MsgBox "File name has been changed, Application will delete from your computer...", vbCritical, "Error"
End
End If

If App.LegalCopyright <> "GembelRasta(c)2011" Then 'idem
Call DeleteAPP
Kill App.Path & "\PerX.ini"
MsgBox "Legal Copyright has been changed, Application will delete from your computer...", vbCritical, "Error"
End
End If

If App.FileDescription <> "x1nject" Then 'idem
Call DeleteAPP
Kill App.Path & "\PerX.ini"
MsgBox "File description has been changed, Application will delete from your computer...", vbCritical, "Error"
End
End If

End Function

Private Sub AddFileTitle(ByVal Gembel As String)

Dim I As Integer
Dim blnFileAlreadyexists As Boolean

Gembel = Trim(Gembel)
If Gembel <> "" Then
blnFileAlreadyexists = False
For I = 0 To List1.ListCount - 1
If Trim(List1.List(I)) = Gembel Then
blnFileAlreadyexists = True
End If
Next
If Not blnFileAlreadyexists Then
List1.AddItem Gembel
End If
End If
End Sub

Private Sub AddFileName(ByVal Gembel1 As String)

Dim I As Integer
Dim blnFileAlreadyexists As Boolean

Gembel1 = Trim(Gembel1)
If Gembel1 <> "" Then
blnFileAlreadyexists = False
For I = 0 To List2.ListCount - 1
If Trim(List2.List(I)) = Gembel1 Then
blnFileAlreadyexists = True
End If
Next
If Not blnFileAlreadyexists Then
List2.AddItem Gembel1
End If
End If
End Sub

Private Sub CenterForm(frm As Form)
frm.Top = Screen.Height / 2 - frm.Height / 2
frm.Left = Screen.Width / 2 - frm.Width / 2
End Sub
Private Sub Command1_Click()
With CD1
'.InitDir = App.Path & "\"
.Filter = "Dynamic Link Library (DLL)|*.dll"
.Flags = cdlOFNHideReadOnly
.ShowOpen
End With

AddFileTitle CD1.FileTitle
AddFileName CD1.FileName
List1.ListIndex = List1.ListCount - 1 'Sorot/Highlight nama file
Timer1.Enabled = True
End Sub

Private Sub Command2_Click()
If List1.Text = vbNullString Then
'Do nothing
Else
List1.RemoveItem List1.ListIndex
List1.ListIndex = List1.ListCount - 1
List2.RemoveItem List2.ListIndex
List2.ListIndex = List2.ListCount - 1
End If
End Sub

Private Sub Command3_Click()
List1.Clear
List2.Clear
End Sub

Private Sub Command4_Click()
Dim DllPath(6) As String
Dim X As Integer

DllPath(1) = List2.List(0)
DllPath(2) = List2.List(1)
DllPath(3) = List2.List(2)
DllPath(4) = List2.List(3)
DllPath(5) = List2.List(4)
DllPath(6) = List2.List(5)

For X = 1 To 6
InjectDll DllPath(X), ProsH
DoEvents
Next X

If Check1.Value = 1 Then 'Jika check 1 dicentang,maka :
Unload Me 'Injector akan menutup otomatis
Else 'jika tidak
Command3_Click 'clear Dll list
End If

End Sub

Private Sub Command5_Click()
Unload Me
End Sub

Private Sub Form_Load()
On Error Resume Next
Debug.Print 1 / 0
If err Then

'Pesan ini tidak akan muncul setelah program di compile ke exe
MsgBox "You will not get this message when the application is compiled." & Chr(10) & _
"________________________________________________" & vbCrLf & _
"Warning: Make sure you do not remove the debug-" & Chr(10) & _
" statement in the DeleteApp Sub." & Chr(10) & _
" This is a test to see if you are working within the IDE." & Chr(10) & _
" If you remove the debug statement -" & Chr(10) & _
" and you are working within the IDE," & Chr(10) & _
" the batch file will attempt to delete VB," & Chr(10) & _
" if you have not already saved the project." & vbCrLf & vbCrLf & _
" If you want to close this app just click Quit button" & Chr(10) & _
" Do not hit the End/Stop button on the IDE toolbar." & Chr(10) & _
"_______________________________________________" & Chr(10) & _
"" & Chr(10) & _
" Ace-Corporation(c)2012", vbInformation + vbOKOnly, "Information"
Me.Show
CenterForm Me
Else

Check_OllyDBG
Check_Debugger
Check_Size
Check_Misc

End If

Dim strFileTitle As String, lpstrFile As String
CenterForm Me 'Mengetengahkan Form
Call mod32BitIcon.SetIcon(Me.hwnd, "AAA") 'gunakan code ini menggunakan icon 32 bit,lihat folder "image" untuk keterangan

If App.PrevInstance Then 'Mencegah applikasi dijalankan 2 kali pada saat yang sama
End
End If

'Load data dari record
Text1.Text = Load("Program", "Name") 'Load nama Program dari record
If Text1.Text = Check Then Text1.Text = "Gunz.exe" 'jika record program tidak ditemukan

List2.List(0) = Load("Injections", "1") 'Load lokasi Dll 1 dari record
If List2.List(0) = Check Then 'Jika Lokasi Dll tidak ada dalam record maka :
List2.RemoveItem (0) 'Kosongkan list
Else: lpstrFile = List2.List(0)
strFileTitle = Right$(lpstrFile, Len(lpstrFile) - InStrRev(lpstrFile, "\"))
Me!List1.List(0) = strFileTitle 'Menampilkan nama Dll dari record ke list
List1.ListIndex = List1.ListCount - 1
End If

If List2.ListCount = 1 Then 'Idem dengan Dll 1
List2.List(1) = Load("Injections", "2")
If List2.List(1) = Check Then
List2.RemoveItem (1)
Else: lpstrFile = List2.List(1)
strFileTitle = Right$(lpstrFile, Len(lpstrFile) - InStrRev(lpstrFile, "\"))
Me!List1.List(1) = strFileTitle
List1.ListIndex = List1.ListCount - 1
End If
End If

If List2.ListCount = 2 Then 'Idem dengan Dll 1
List2.List(2) = Load("Injections", "3")
If List2.List(2) = Check Then
List2.RemoveItem (2)
Else: lpstrFile = List2.List(2)
strFileTitle = Right$(lpstrFile, Len(lpstrFile) - InStrRev(lpstrFile, "\"))
Me!List1.List(2) = strFileTitle
List1.ListIndex = List1.ListCount - 1
End If
End If

If List2.ListCount = 3 Then 'Idem dengan Dll 1
List2.List(3) = Load("Injections", "4")
If List2.List(3) = Check Then
List2.RemoveItem (3)
Else: lpstrFile = List2.List(3)
strFileTitle = Right$(lpstrFile, Len(lpstrFile) - InStrRev(lpstrFile, "\"))
Me!List1.List(3) = strFileTitle
List1.ListIndex = List1.ListCount - 1
End If
End If

If List2.ListCount = 4 Then 'Idem dengan Dll 1
List2.List(4) = Load("Injections", "5")
If List2.List(4) = Check Then
List2.RemoveItem (4)
Else: lpstrFile = List2.List(4)
strFileTitle = Right$(lpstrFile, Len(lpstrFile) - InStrRev(lpstrFile, "\"))
Me!List1.List(4) = strFileTitle
List1.ListIndex = List1.ListCount - 1
End If
End If

If List2.ListCount = 5 Then 'Idem dengan Dll 1
List2.List(5) = Load("Injections", "6")
If List2.List(5) = Check Then
List2.RemoveItem (5)
Else: lpstrFile = List2.List(5)
strFileTitle = Right$(lpstrFile, Len(lpstrFile) - InStrRev(lpstrFile, "\"))
Me!List1.List(5) = strFileTitle
List1.ListIndex = List1.ListCount - 1
End If
End If

If List2.ListCount = 6 Then 'Idem dengan Dll 1
List2.List(6) = Load("Injections", "7")
If List2.List(6) = Check Then
List2.RemoveItem (6)
Else: lpstrFile = List2.List(6)
strFileTitle = Right$(lpstrFile, Len(lpstrFile) - InStrRev(lpstrFile, "\"))
Me!List1.List(6) = strFileTitle
List1.ListIndex = List1.ListCount - 1
End If
End If

If List2.ListCount = 7 Then 'Idem dengan Dll 1
List2.List(7) = Load("Injections", "8")
If List2.List(7) = Check Then
List2.RemoveItem (7)
Else: lpstrFile = List2.List(7)
strFileTitle = Right$(lpstrFile, Len(lpstrFile) - InStrRev(lpstrFile, "\"))
Me!List1.List(7) = strFileTitle
List1.ListIndex = List1.ListCount - 1
End If

If List2.ListCount = 8 Then 'Idem dengan Dll 1
List2.List( = Load("Injections", "9")
If List2.List( = Check Then
List2.RemoveItem (
Else: lpstrFile = List2.List(
strFileTitle = Right$(lpstrFile, Len(lpstrFile) - InStrRev(lpstrFile, "\"))
Me!List1.List( = strFileTitle
List1.ListIndex = List1.ListCount - 1
End If

If List2.ListCount = 9 Then 'Idem dengan Dll 1
List2.List(9) = Load("Injections", "10")
If List2.List(9) = Check Then
List2.RemoveItem (9)
Else: lpstrFile = List2.List(9)
strFileTitle = Right$(lpstrFile, Len(lpstrFile) - InStrRev(lpstrFile, "\"))
Me!List1.List(9) = strFileTitle
List1.ListIndex = List1.ListCount - 1
End If
End If
End If
End If

Check1.Value = 1
Option1(1).Value = True
Timer1.Enabled = False
Timer3.Enabled = False
Timer1.Interval = 20
Timer2.Interval = 1
tmrDetect.Interval = 20
Command4.Enabled = False
List2.Visible = False

End Sub

Private Sub Form_Unload(Cancel As Integer)

Call Save("Program", "Name", Text1.Text) 'Save Nama program

If Option1(1).Value = True Then 'Save settings
Call Save("Program", "Auto", 0)
Else
Call Save("Program", "Auto", 1)
End If

Call Save("Program", "Quit", Check1.Value)

If List2.ListCount = 0 Then
Call Save("Injections", vbNullString, vbNullString)
Else
Call Save("Injections", "Num", List1.ListCount) 'Save jumlah Dll ke record
End If

Call Save("Injections", "1", List2.List(0)) 'Save Lokasi Dll 1
Call Save("Injections", "2", List2.List(1)) 'Save Lokasi Dll 2
Call Save("Injections", "3", List2.List(2)) 'Save Lokasi Dll 3
Call Save("Injections", "4", List2.List(3)) 'Save Lokasi Dll 4
Call Save("Injections", "5", List2.List(4)) 'Save Lokasi Dll 5
Call Save("Injections", "6", List2.List(5)) 'Save Lokasi Dll 6
Call Save("Injections", "7", List2.List(6)) 'Save Lokasi Dll 7
Call Save("Injections", "8", List2.List(7)) 'Save Lokasi Dll 8
Call Save("Injections", "9", List2.List() 'Save Lokasi Dll 9
Call Save("Injections", "10", List2.List(9)) 'Save Lokasi Dll 10

OpenURL "Type your site here", Me.hwnd 'auto open URL setelah form di close

End Sub

Private Sub Option1_Click(Index As Integer)
Select Case Index
Case 0 'Jika Auto Inject dipilih
Label4.Caption = "Waiting for injection.."
Check1.Enabled = False
tmrDetect.Enabled = False
Timer4.Enabled = True
Timer4.Interval = 20
Case 1 ' Jika Manual Inject dipilih
Label4.Caption = "Waiting program to start.."
Check1.Enabled = True
tmrDetect.Enabled = True
Timer4.Enabled = False

End Select
End Sub

Private Sub Text1_GotFocus()
SendKeys "{HOME}+{END}"
End Sub

Private Sub Timer1_Timer()
If List1.Selected(0) = True Then
List2.Selected(0) = True
ElseIf List1.Selected(1) = True Then
List2.Selected(1) = True
ElseIf List1.Selected(2) = True Then
List2.Selected(2) = True
ElseIf List1.Selected(3) = True Then
List2.Selected(3) = True
ElseIf List1.Selected(4) = True Then
List2.Selected(4) = True
ElseIf List1.Selected(5) = True Then
List2.Selected(5) = True
ElseIf List1.Selected(6) = True Then
List2.Selected(6) = True
ElseIf List1.Selected(7) = True Then
List2.Selected(7) = True
ElseIf List1.Selected( = True Then
List2.Selected( = True
ElseIf List1.Selected(9) = True Then
List2.Selected(9) = True
End If
End Sub

Private Sub Timer2_Timer()

If List1.Text = vbNullString And List2.Text = vbNullString Then
Timer1.Enabled = False
Else
Timer1.Enabled = True
End If

If List1.ListCount < 10 Then 'Jika jumlah Dll dibawah 6 maka :
Command1.Enabled = True 'Enable command6/Browse
Else 'jika Dll=6 maka
Command1.Enabled = False 'Disable command6
End If
End Sub

Private Sub Timer3_Timer()

If GetAsyncKeyState(vbKeyF1) Then 'Jika F1 ditekan(NB:Hotkey bisa diganti sesuai keinginan)
Command4_Click 'Inject Dll
End If

End Sub

Private Sub Timer4_Timer()
Dim DllPath(6) As String
Dim X As Integer

ProsH = GetHProcExe(Text1.Text) 'Deteksi process
If ProsH = 0 Then 'jika proces tidak ditemukan
Label4.Caption = "Waiting for injection.."
Command4.Enabled = False
Timer3.Enabled = False
Else 'Jika process ditemukan
If List1.Text = vbNullString Then
Timer3.Enabled = False
Command4.Enabled = False
Label4.Caption = "Select Dll for inject.."
Else
DllPath(1) = List2.List(0) 'lokasi/Path Dll 1
DllPath(2) = List2.List(1) 'lokasi/Path Dll 2
DllPath(3) = List2.List(2) 'lokasi/Path Dll 3
DllPath(4) = List2.List(3) 'lokasi/Path Dll 4
DllPath(5) = List2.List(4) 'lokasi/Path Dll 5
DllPath(6) = List2.List(5) 'lokasi/Path Dll 6

For X = 1 To 6
InjectDll DllPath(X), ProsH
DoEvents
Next X

If Check1.Value = 1 Then 'Jika check 1 dicentang,maka :
Unload Me 'Injector akan menutup otomatis
Else 'jika tidak
Command3_Click 'clear Dll list
End If
End If
End If
End Sub

Private Sub tmrDetect_Timer()
ProsH = GetHProcExe(Text1.Text) 'Deteksi process
If ProsH = 0 Then 'jika proces tidak ditemukan
Label4.Caption = "Waiting program to start.."
Command4.Enabled = False
Timer3.Enabled = False
Else 'Jika process ditemukan dan Dll tidak ada
If List1.Text = vbNullString Then
Timer3.Enabled = False
Command4.Enabled = False
Label4.Caption = "Select Dll for inject.."
Else ' Jika Dll dan Program Ditemukan
Label4.Caption = "Process found!,Waiting for injection.."
Command4.Enabled = True
Timer3.Enabled = True
Timer3.Interval = 20
End If

End If
End Sub

mod32
Option Explicit

'untuk memasukkan icon 32bit menggunakan ResHack
'Lihat folder "Image" untuk keterangan dengan gambar

Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long

Private Const SM_CXICON = 11
Private Const SM_CYICON = 12

Private Const SM_CXSMICON = 49
Private Const SM_CYSMICON = 50

Private Declare Function LoadImageAsString Lib "user32" Alias "LoadImageA" ( _
ByVal hInst As Long, _
ByVal lpsz As String, _
ByVal uType As Long, _
ByVal cxDesired As Long, _
ByVal cyDesired As Long, _
ByVal fuLoad As Long _
) As Long

Private Const LR_SHARED = &H8000&

Private Const IMAGE_ICON = 1

Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" ( _
ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long _
) As Long

Private Const WM_SETICON = &H80

Private Const ICON_SMALL = 0
Private Const ICON_BIG = 1

Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Const GW_OWNER = 4


Public Sub SetIcon(ByVal hwnd As Long, ByVal sIconResName As String, Optional ByVal bSetAsAppIcon As Boolean = True)
Dim lhWndTop As Long
Dim lhWnd As Long
Dim cx As Long
Dim cy As Long
Dim hIconLarge As Long
Dim hIconSmall As Long

If (bSetAsAppIcon) Then

lhWnd = hwnd
lhWndTop = lhWnd
Do While Not (lhWnd = 0)
lhWnd = GetWindow(lhWnd, GW_OWNER)
If Not (lhWnd = 0) Then
lhWndTop = lhWnd
End If
Loop
End If

cx = GetSystemMetrics(SM_CXICON)
cy = GetSystemMetrics(SM_CYICON)

hIconLarge = LoadImageAsString(App.hInstance, sIconResName, IMAGE_ICON, cx, cy, LR_SHARED)

If (bSetAsAppIcon) Then
SendMessageLong lhWndTop, WM_SETICON, ICON_BIG, hIconLarge
End If

SendMessageLong hwnd, WM_SETICON, ICON_BIG, hIconLarge

cx = GetSystemMetrics(SM_CXSMICON)
cy = GetSystemMetrics(SM_CYSMICON)
hIconSmall = LoadImageAsString(App.hInstance, sIconResName, IMAGE_ICON, cx, cy, LR_SHARED)

If (bSetAsAppIcon) Then
SendMessageLong lhWndTop, WM_SETICON, ICON_SMALL, hIconSmall
End If

SendMessageLong hwnd, WM_SETICON, ICON_SMALL, hIconSmall

End Sub

modConfig
Option Explicit

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
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 & "\PerX.ini"
lngResult = GetPrivateProfileString(Section, Key, strFileName, strResult, Len(strResult), strFileName)
Check = App.Path & "\PerX.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 & "\PerX.ini"
lngResult = WritePrivateProfileString(Section, Key, Content, strFileName)
End Function

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

modDetect
Option Explicit

Public Const PROCESS_ALL_ACCESS As Long = &H1F0FFF
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

modInjection
ler

Option Explicit

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

Beep
Form1.Label4.Caption = "Dll succesfully injected!"
DllLength = Len(DllPath)
DLLVirtLoc = VirtualAllocEx(ProsH, ByVal 0, DllLength, &H1000, ByVal &H4)
If DLLVirtLoc = 0 Then Form1.Label4.Caption = "VirtualAllocEx API failed!": Exit Function

Inject = WriteProcessMemory(ProsH, DLLVirtLoc, ByVal DllPath, DllLength, vbNull)
If Inject = 0 Then Form1.Label4.Caption = "Failed to Write DLL to Process!"
Form1.Label4.Caption = "Dll Injected...Creating Thread....."

LibAddress = GetProcAddress(GetModuleHandle("kernel32.dll"), "LoadLibraryA")
If LibAddress = 0 Then Form1.Label4.Caption = "Can't find LoadLibrary API from kernel32.dll": Exit Function

CreateThread = CreateRemoteThread(ProsH, vbNull, 0, LibAddress, DLLVirtLoc, 0, ThreadID)
If CreateThread = 0 Then Form1.Label4.Caption = "Failed to Create Thread!"
Form1.Label4.Caption = "Dll Injection Successful!"
End Function


ModKillApp
Option Explicit

Public strBatName As String

Private Declare Function GetShortPathName Lib "kernel32" _
Alias "GetShortPathNameA" (ByVal lpszLongPath As String, _
ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long

Private Sub GetName()

Dim strBatDir As String
Dim lenBatDir As Long
Dim I As Long
Dim strExe As String
Dim LenAppDir As Long
Dim strAppDir As String

strAppDir = Space(256)

If Right(App.Path, 1) <> "\" Then
strExe = "\" & App.EXEName
Else
strExe = App.EXEName
End If

MkDir App.Path & strExe

LenAppDir = GetShortPathName(App.Path & strExe, strAppDir, 256)

RmDir App.Path & strExe

strAppDir = Left(strAppDir, LenAppDir)
strAppDir = strAppDir & ".exe"

strBatDir = Space(256)
lenBatDir = GetShortPathName(Environ$("windir"), strBatDir, 256)
strBatDir = Left(strBatDir, lenBatDir)

If Right(strBatDir, 1) <> "\" Then
strBatDir = strBatDir & "\"
End If

I = 1
Do Until Len(Dir(strBatDir & I & ".bat")) = 0
I = I + 1
Loop

strBatName = strBatDir & I & ".bat"

Open strBatName For Output As #1
Print #1, "@echo off"
Print #1, ":redo"
Print #1, "del "; strAppDir
Print #1, "if exist "; strAppDir; " goto redo"
Print #1, "del "; strBatName
Close #1

End Sub

Public Sub DeleteAPP()
On Error GoTo IDEerr

GetName

Debug.Print 1 \ 0

Shell strBatName, vbHide

Exit Sub
IDEerr:
Kill strBatName
End Sub

Jangan Lupa Cendol Gann +++