[Tutorial] Cara Membuat Injector sendiri
2.buat 1 form dengan nama form1 , kemudian Isi Form1 dengan 6 Timer, simpan dimana saja.
buat 6 command button, masing2 beri nama :
- Command1
- Command2
- Command3
- cmdInjector
- cmdExecute
- cmdTerminate
3. - Untuk cmdInjector beri nama pada menu Caption "Select DLL For Inject"
- Untuk cmdExecute beri nama pada menu Caption "Resume"
- Untuk cmdTerminate beri nama pada menu Caption "Terminate"
4. Klik kanan pada Form1 -> View Code , lalu masukan Code berikut :
-
'N2 Injector Revisi 5 November 2010 by Sapta_Agunk, Multi Injector (WhItE_Injector) by Sapta_Agunk from nstars.net [N2]
Private noc As Integer
Private str1 As String
Private str2 As String
Private str3 As String
Private strmessage As String
Private resmue As String
Private winHwnd As Long
Private bSuspend As Boolean
Option Explicit
Private Declare Function ExtCreateRegion Lib "gdi32" (lpXform As Any, ByVal nCount As Long, lpRgnData As Any) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Dim bytRegion(31) As Byte
Dim nBytes As Long
'Win 2k, ME, XP
Private Const GWL_EXSTYLE As Long = (-20)
Private Const WS_EX_LAYERED As Long = &H80000
Private Const LWA_ALPHA As Long = &H2
Private NamaDll As String
Private Declare Function GetWindowLongA Lib "user32" (ByVal hWnd As Long, _
ByVal nIndex As Long) As Long
Private Declare Function SetWindowLongA Lib "user32" (ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, _
ByVal crey As Byte, _
ByVal bAlpha As Byte, _
ByVal dwFlags As Long) As Long
Private Sub cmdExecute_Click()
resmue = "yes"
Unload Me
End Sub
Private Sub cmdInjector_Click()
On Error GoTo errLine
If Not cmdInjector.Caption = "Inject Now" Then
Dim theTemp As String
theTemp = OpenDialog(Me, "DLL files (*.dll)|*.dll", "Select DLL File For Inject...", App.Path)
If Trim$(theTemp) <> "" Then
If Dir$(theTemp) <> "" Then
sFlDLL = theTemp
cmdInjector.Caption = "Inject Now"
Else
sFlDLL = "None"
cmdInjector.Caption = "Select Dll For Inject"
End If
End If
Else
If sFlDLL = "None" Then
MsgBox "You can't Injector execute", 48, "Error Injector"
Exit Sub
Else
InjectExecute sFlDLL
sFlDLL = "None"
cmdInjector.Caption = "Select Dll For Inject"
End If
End If
Exit Sub
errLine:
MsgBox "File tidak respon atau tidak support", 48, "Error"
End Sub
Private Sub cmdTerminate_Click()
resmue = "yes"
On Error Resume Next
Dim lExitCode As Long
If MsgBox("Terminate Hackshield sekarang?", _
vbYesNo + vbExclamation, "Terminate Proses") = vbYes Then
lExitCode = TerminateTargetOne
If lExitCode = 0 Then
MsgBox "Proses terminate gagal.", _
vbExclamation, "Terminate info"
cmdTerminate.Enabled = False
Else
lExitCode = TerminateTargetTwo
If lExitCode = 0 Then
MsgBox "Succsses.! Jika ada masalah hubungi nstars.net !!", _
vbExclamation, "Succsses Terminate N2 Injector"
Else
Unload Me
End If
End If
End If
End Sub
Private Sub Command1_Click()
InjectExecute App.Path & "\Exm1.dll"
End Sub
Private Sub Command2_Click()
InjectExecute App.Path & "\Exm2.dll"
End Sub
Private Sub Command3_Click()
InjectExecute App.Path & "\Exm3.dll"
End Sub
Private Sub File1_Click()
End Sub
'fungsi transparent form
Private Sub Opacity(Value As Byte, _
Frm As Form)
Dim MaxVal As Byte
Dim MinVal As Byte
On Error GoTo ErrorHandler
MinVal = 20
MaxVal = 255
If Value > MaxVal Then
Value = MaxVal
End If
If Value < MinVal Then
Value = MinVal
End If
SetWindowLongA Frm.hWnd, GWL_EXSTYLE, GetWindowLongA(Frm.hWnd, GWL_EXSTYLE) Or WS_EX_LAYERED
SetLayeredWindowAttributes Frm.hWnd, 0, Value, LWA_ALPHA
ErrorHandler:
Exit Sub
End Sub
Private Sub form_load()
Dim Welcome As String
Welcome = MsgBox("Jangan Lupa Ucapkan terimakasih to Sapta_Agunk !! ^_^V Peace !! ", vbInformation, "N2 Injector")
Welcome = MsgBox(" oea ada yg kelupaan !! Selamat Bergabung di nstars.net !! xixixixi", vbInformation, "Jangan Lupa Koment ya !!")
bSuspend = False
Timer2.Interval = 20
Timer2.Enabled = True
FileTargetOne = "PointBlank.exe" 'target nya sob
FileTargetTwo = "HSUpdate.exe" 'target nya juga xixixixi
str1 = "Sapta_Agunk" 'contoh text yg akan Kedap Kedip
str2 = "Special Thanks to Credit" 'contoh text yg akan Kedap Kedip
str3 = "http://www.nstars.net _copyright@2010 " 'contoh text yg akan berjalan sob
Opacity 200, Me 'pengaturan transparent form MinVal = 20: MaxVal = 255
WindowsMediaPlayer1.URL = App.Path & "\Exm.mp3" 'nih audio nya sob
Dim rgnMain As Long
nBytes = 100
LoadBytes
rgnMain = ExtCreateRegion(ByVal 0&, nBytes, bytRegion(0))
SetWindowRgn Me.hWnd, rgnMain, True
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Screen.MousePointer = vbDefault
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If bSuspend = True Then
If Not resmue = "yes" Then
If MsgBox("Klik Yes untuk Terminate (PB dan HS) dan No Untuk Membatalkan", vbYesNo, "") = vbYes Then
cmdTerminate_Click
Else
Cancel = -1
End If
Else
OpenURL "http://nstars.net", Me.hWnd
End If
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
If bSuspend = True Then SetSuspendResumeThread False
End
End Sub
Private Sub Timer1_Timer()
winHwnd = FindWindow(vbNullString, "HSUpdate")
If winHwnd <> 0 Then
NTProcessList
SetSuspendResumeThread True
cmdTerminate.Enabled = True
cmdExecute.Enabled = True
cmdInjector.Enabled = True
'pengaturan tombol jadi aktif
Command1.Enabled = True
Command2.Enabled = True
Command3.Enabled = True
bSuspend = True
Vibrate Me, 100, 50
Timer1.Enabled = False
Else
cmdTerminate.Enabled = False
cmdExecute.Enabled = False
cmdInjector.Enabled = False
'-------------------------
'pengaturan tombol jadi tidak aktif
Command1.Enabled = False
Command2.Enabled = False
Command3.Enabled = False
Timer1.Enabled = True
bSuspend = False
End If
End Sub
Private Sub Timer2_Timer()
Me.Top = (Screen.Height - Height) / 2
Timer2.Enabled = False
Timer1.Enabled = True
Timer1.Interval = 20
End Sub
Private Sub Timer3_Timer()
If Label1.Visible = True Then
Label1.Visible = False
Else
Label1.Visible = True
End If
End Sub
Private Sub Timer4_Timer()
If Label3.Visible = True Then
Label3.Visible = False
Else
Label3.Visible = True
End If
End Sub
Private Sub timer5_Timer()
Timer5.Interval = 300
Label4.Caption = Mid(Label4.Caption, 2, Len(Label4.Caption) - 1) + Mid(Label4.Caption, 1, 1)
End Sub
Private Sub Timer6_Timer()
WindowsMediaPlayer1.Controls.play
End Sub
Sub SlideWindow(frmSlide As Form, iSpeed As Integer)
While frmSlide.Top - frmSlide.Height < Screen.Height
DoEvents
frmSlide.Top = frmSlide.Top + iSpeed
Wend
End Sub
Private Sub MoveToTop()
Dim currentTop As Long
Dim TargetTop As Long
Dim currentLeft As Long
Dim TargetLeft As Long
Dim i As Long
For i = currentTop To TargetTop Step -2
Me.Top = i
Next i
For i = currentLeft To TargetLeft Step 2
Me.Left = i
Next i
End Sub
Private Sub Vibrate(Frm As Form, rScale As Integer, Times As Integer)
Dim Lft As Long, Tp As Long
Dim i
Lft = Frm.Left
Tp = Frm.Top
For i = 0 To Times
Frm.Move Lft + Sgn(rScale)
Pause 20
Frm.Move Lft + rScale
Pause 20
Frm.Move Lft, Tp + Sgn(rScale), Frm.Width, Frm.Height
Pause 20
Frm.Move Lft, Tp + rScale, Frm.Width, Frm.Height
Pause 20
Next i
End Sub
Private Sub Pause(ms)
Dim secs
Dim g
secs = ms / 1000
g = Timer
Do While Timer - g < secs
DoEvents
Loop
End Sub
Private Sub LoadBytes()
bytRegion(0) = 100
bytRegion(4) = 10
End Sub
5. Jika sudah lalu buat 4 Module, dengan memilih Project -> Add Module (ALT+P+M), lalu beri Nama :
- ModCDialog
- ModInjector
- ModBrowser
- ModProcess
6. Kemudian pada ModCDialog Isi kan Code berikut :
7. Isikan Code Berikut Pada ModInjector :
9. Isikan ModBrowser dengan Code Berikut
10.Isikan ModProcess dengan Code berikut
11. Ingat : perhatikan kode command1 dan command2 pada listing code pada form1
Private Sub Command1_Click()
InjectExecute App.Path & "\Exm1.dll"
End Sub
- Ganti "Exm1.dll" dengan Nama dll yg pengen di masukin, Tapi Saat Inject Harus 1 Folder dengan Injector !
Semoga Bermanfaat...!!
0 komentar:
Post a Comment