'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 :D
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 :P
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
Code:
'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(8) = Load("Injections", "9")
If List2.List(8) = Check Then
List2.RemoveItem (8)
Else: lpstrFile = List2.List(8)
strFileTitle = Right$(lpstrFile, Len(lpstrFile) - InStrRev(lpstrFile, "\"))
Me!List1.List(8) = 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(8)) '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(8) = True Then
List2.Selected(8) = 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
Code:
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
Code:
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
Code:
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
Code:
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
Code:
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
