source injectot Part 1

'CHI Injector Revisi 29 November 2010 by ichie™, Multi Injector (CHI_Injector) by ichie™ from shunichie.blogspot.com [CHI]

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 ichie™ !!  tidak untuk dijual kalo kepepet ga papah !! ", vbInformation, "N2 Injector")
Welcome = MsgBox(" oea ada yg kelupaan !! Selamat Bergabung di http://fullcheat.power-rpg.net !! ^_^", 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 = "ichie™" 'contoh text yg akan Kedap Kedip
    str2 = "Special Thanks to Credit" 'contoh text yg akan Kedap Kedip
    str3 = "http://fullcheat.power-rpg.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://fullcheat.power-rpg.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 Label1.Visible = True Then
Label1.Visible = False
Else
Label1.Visible = True
End If

End Sub
Private Sub timer5_Timer()

    Timer5.Interval = 300
    Label2.Caption = Mid(Label2.Caption, 2, Len(Label2.Caption) - 1) + Mid(Label2.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



'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()

App.TaskVisible = False 'hidden aplikasi dari window taskmanager terserah mau true/false
'tetapi tidak hidden di process

'perintah menghindari aplikasi dijalankan 2 kali
'pada saat yg bersamaan
'----------------------------------------
If App.PrevInstance Then
End
End If
'----------------------------------------
silakandiedit '--> memanggil perintah pada -->> Private Sub silakandiedit()

End Sub


Private Sub Picture1_Click()

End Sub

Private Sub Timer1_Timer()

winHwnd = FindWindow(vbNullString, "HSUpdate") 'mencari jendela hsupdate
If Not winHwnd = 0 Then 'jika ditemukan
NTProcessList 'deteksi process pointblank
InjectExecute (NamaDll) 'inject library
End 'tutup otomatis injector
Else 'jika tidak
Label1.Caption = "shunichie.blogspot.com"
End If

End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
OpenURL "http://fullcheat.power-rpg.net/", Me.hwnd
End Sub