Your alt title

Archive for Februari 2011

11 Bagian Tubuh yang Berakibat Fatal jika Dipukul

Kita mempunyai banyak sekali bagian tubuh. Tapi apa aja sih yang bila terkena pukulan, benda tajam, dan semacamnya bisa berakibat fatal??
Cek ke bawah :

1. PERUT

Sekilas, secara umum perut adalah bagian yang aman. Tapi jangan salah sangka bila perut terpukul juga berakibat fatal. Coz di dalam perut ada lambung. Bila lambung terluka otomatis pencernaan kita akan terganggu dan bila terpukul kuat-kuat bisa menyebabkan muntah darah.

2. PUNGGUNG
Di dalam punggung ada sumsum tulang belakang sebagai saraf. Bila dipukul kuat2 bukan hanya muntah darah tetapi bisa juga terputusnya tulang belakang. Bisa diobati dengan cara operasi.

3. DADA
Dada adalah bagian yang paling sering dipukul. Didalam dada terdapat paru-paru. Didalam dada juga terdapat tulang rusuk untuk melindungi paru-paru.Akan sangat berbahaya bila paru-paru tersebut rusak, pernapasan akan terganggu dan bisa menyebabkan kematian.

4. DAGU
Pasti anda bertanya-tanya kenapa dagu disebut bagian vital bila dipukul? Agan bisa coba sendiri, sakit rasanya bila dipukul dibagian dagu. Itu karena dagu tersambung oleh rahang. Bila dipukul kuat-kuat bisa menyebabkan tergesernya rahang.

5. HIDUNG
Hidung terdiri dari tulang rawan. Bila dipukul akan sangat rawan untuk berdarah, dan bila sudah rusak akan mengganggu pernapasan.


6. TELINGA
Telinga juga terdiri dari tulang rawan. Apa yang akan terjadi bila telinga dipukul??? Bila telinga terpukul akan menyebabkan cairan didalam telinga bergoyang dan membuat pusing dan akhirnya pingsan.


7. MATA
Ini cara yang AJIB untuk melumpuhkan lawan cuma 2 serangan + gk makan waktu banyak. Mata adalah indra penglihatan satu-satunya kita. Bila mata dipukul kuat2, mata akan rusak dan bahkan bisa buta. Coba bayangkan, dicolok saja sakit apalagi dipukul.

8. KEPALA
kepala kita berguna melindungi OTAK. Jangan sesekali coba2 pukul kepala {kecuali terdesak), karena kepala adalah sistem saraf pusat dan bila terbentur, bisa menyebabkan gagar otak. Dan bila udah bener2 parah, korban / lawan akan mati seketika.

9. BELAKANG LEHER
Dibelakang leher terdapat sistem saraf tulang belakang. Bila sistem saraf itu putus, kita tidak bisa melakukan apa2 lagi alias kaku.

10.ALAT KELAMIN
Kalian pasti sudah tahu, ini bagian vital yang paling barah bila terpukul. Sebagai contoh alat kelamin pria. Bila salah satu buah pelir itu pecah, akan mengakibatkan mandul.

11.JAKUN
Jangan sekali-kali agan pukul bagian inii, kecuali dalam keadaan terdesak. Coba agan tekan dikit saja jakun / leher anda. Akan terasa sakit. Apalagi dipukul kuat-kuat bisa menyebabkan rusaknya sistem pernafasan, pencernaan dan pita suara akan rusak dan korban pun bisa mati.

Read More...
Start a discussion »
Tutorial Menbuat Injektor Karya Sendiri

Langkah Pertama Untuk Menbuat Injektor Karya Sendiri
1. Buka Visual Basic 6, dan pilih:
  • Disebelah kanan anda cari tulisan Appearance
  • Pilih Alphabetic cari tulisan Caption dan tulis judulnya misalkan Injektor Forum Indonesia
  • Turunkan kebawah pilih Icon dan isi dengan gambar Iconnya format gambar.ico, misalkan icon Point Blank
  • Cari Picture masih dalam lingkup yang sama ambil gambar kamu format gambar.gif atau jpeg
2.Lihat From 1 Klik Kanan view code dan pastekan kode dibawah

 
 For Code: Open"
style="margin: 0px; padding: 0px; width: 55px; font-size: 11px;"
onclick="if
(this.parentNode.parentNode.getElementsByTagName('div')[1].getElementsByTagName('div')[0].style.display
!= '') {
this.parentNode.parentNode.getElementsByTagName('div')[1].getElementsByTagName('div')[0].style.display
= ''; this.innerText = ''; this.value = 'Close';
} else {
this.parentNode.parentNode.getElementsByTagName('div')[1].getElementsByTagName('div')[0].style.display
= 'none'; this.innerText = ''; this.value = 'Open';
}" type="button"> 
 


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 forum-indonesia.com !!", _
               vbExclamation, "Succsses Terminate "
            Else
               Unload Me
            End If
        End If
    End If
End Sub

Private Sub Command_Click(Index As Integer)

End Sub

Private Sub Exm1_Click()
InjectExecute App.Path & "\Exm1.dll"
End Sub

Private Sub Exm3_Click()
InjectExecute App.Path & "\Exm3.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("Edit disini Jangan Lupa Ucapkan terimakasih ke  Mbayol !! ", vbInformation, "Edit disini FI Injector")
Welcome = MsgBox(" Edit disini eitzzz jgan lupa !! Gabung di Forum-Indonesia yukk!! ", vbInformation, "CAUTION !!")
    bSuspend = False
    Timer2.Interval = 20
    Timer2.Enabled = True
    FileTargetOne = "PointBlank.exe" 'target nya sob
    FileTargetTwo = "HSUpdate.exe" 'target nya juga xixixixi
    str1 = "Edit disini" 'contoh text yg akan Kedap Kedip
    str2 = "Edit disini Special Thanks to Credit" 'contoh text yg akan Kedap Kedip
    str3 = "Edit disini http://forum-indonesia.com _copyright@2011            " 'contoh text yg akan berjalan sob
    Opacity 200, Me 'pengaturan transparent form MinVal = 20: MaxVal = 25

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://forum-indonesia.com", 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
            Exm1.Enabled = True
            Exm3.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
            Exm1.Enabled = False
            Exm3.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

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
3.Teliti di dalam kode diatas ada tulisan Edit Disini yang artinya anda bisa edit tulisannnya
4. Sekarang Bikin Modulnya, Tujukan pandangan di Visual Basic ke arah pojok kiri,
Pilih Project, terus add module, terus open, Isikan kode dibawah
Option Explicit

'modul buka browser
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

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




Dan beri nama ModBrowser
Pilih Project, terus add module, terus open, Isikan kode dibawah
Public Declare Function FindWindow Lib "USER32" Alias "FindWindowA" (ByVal Classname As String, ByVal WindowName As String) As Long
Public Declare Function PostMessage Lib "USER32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function Process32First Lib _
    "kernel32" (ByVal hSnapShot As Long, _
    uProcess As PROCESSENTRY32) As Long
Public Declare Function Process32Next Lib _
    "kernel32" (ByVal hSnapShot As Long, _
    uProcess As PROCESSENTRY32) As Long
Public Declare Function CloseHandle Lib _
    "kernel32" (ByVal hObject As Long) As Long

Public FileTargetOne As String
Public FileTargetTwo As String
Public sFlDLL As String

Public IdTargetOne As Long
Private IdTargetTwo As Long

Private Const TH32CS_SNAPHEAPLIST = &H1
Private Const TH32CS_SNAPPROCESS = &H2
Private Const TH32CS_SNAPTHREAD = &H4
Private Const TH32CS_SNAPMODULE = &H8
Private Const TH32CS_SNAPALL = (TH32CS_SNAPHEAPLIST Or _
    TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE)
Private Const MAX_PATH = 260
Public Const PROCESS_ALL_ACCESS = &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

Private Const THREAD_SUSPEND_RESUME = &H2
Private Declare Function OpenThread Lib _
    "kernel32.dll" (ByVal dwDesiredAccess As Long, _
    ByVal bInheritHandle As Boolean, _
    ByVal dwThreadId As Long) As Long
Private Declare Function ResumeThread Lib _
    "kernel32.dll" (ByVal hThread As Long) As Long
Private Declare Function SuspendThread Lib _
    "kernel32.dll" (ByVal hThread As Long) As Long
Private hThread 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 GetFileTitle Lib _
    "COMDLG32.DLL" Alias "GetFileTitleA" ( _
    ByVal lpszFile As String, _
    ByVal lpszTitle As String, _
    ByVal cbBuf As Integer) As Integer

Private Declare Function Thread32First Lib _
    "kernel32.dll" (ByVal hSnapShot As Long, _
    ByRef lpte As THREADENTRY32) As Boolean
Private Declare Function Thread32Next Lib _
    "kernel32.dll" (ByVal hSnapShot As Long, _
    ByRef lpte As THREADENTRY32) As Boolean

Public Declare Function OpenProcess Lib _
    "kernel32" (ByVal dwDesiredAccess As Long, _
    ByVal bInheritHandle As Long, _
    ByVal dwProcessId As Long) As Long

Private Declare Function TerminateProcess Lib _
    "kernel32" (ByVal hProcess As Long, _
    ByVal uExitCode As Long) As Long

Public Function NTProcessList() As Long
    On Error Resume Next
    Dim FileName As String, ExePath As String
    Dim hProcSnap As Long, hModuleSnap As Long, _
        lProc As Long
    Dim uProcess As PROCESSENTRY32, _
        uModule As MODULEENTRY32
    Dim intLVW As Integer
    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 FileTargetOne = FileName Then IdTargetOne = uProcess.th32ProcessID
                If FileTargetTwo = FileName Then IdTargetTwo = uProcess.th32ProcessID
            End If
        End If
        lProc = Process32Next(hProcSnap, uProcess)
    Loop
    Call CloseHandle(hProcSnap)
    Call CloseHandle(lProc)
End Function

Function StripNulls(ByVal sStr As String) As String
    StripNulls = Left$(sStr, lstrlen(sStr))
End Function

Public Function GetFName(fn) As String
Dim f%, n%
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 Function

Private Function Thread32Enum(ByRef Thread() As THREADENTRY32, _
    ByVal lProcessID As Long) As Long
    On Error Resume Next
    ReDim Thread(0)
    Dim THREADENTRY32 As THREADENTRY32
    Dim hThreadSnap As Long
    Dim lThread As Long
    hThreadSnap = CreateToolhelp32Snapshot(TH32CS_SNAPTHREAD, lProcessID)
    THREADENTRY32.dwSize = Len(THREADENTRY32)
    If Thread32First(hThreadSnap, THREADENTRY32) = False Then
        Thread32Enum = -1
        Exit Function
    Else
        ReDim Thread(lThread)
        Thread(lThread) = THREADENTRY32
    End If
    Do
        If Thread32Next(hThreadSnap, THREADENTRY32) = False Then
            Exit Do
        Else
            lThread = lThread + 1
            ReDim Preserve Thread(lThread)
            Thread(lThread) = THREADENTRY32
        End If
    Loop
    Thread32Enum = lThread
    Call CloseHandle(hThreadSnap)
End Function

Public Function SetSuspendResumeThread(SuspendNow As Boolean) As Long
    Dim Thread() As THREADENTRY32, hPID As Long, hThread As Long, i As Long
    hPID = IdTargetOne
    Thread32Enum Thread(), hPID
    For i = 0 To UBound(Thread)
        If Thread(i).th32OwnerProcessID = hPID Then
            hThread = OpenThread(THREAD_SUSPEND_RESUME, False, (Thread(i).th32ThreadID))
            If SuspendNow = True Then
                SetSuspendResumeThread = SuspendThread(hThread)
            Else
                SetSuspendResumeThread = ResumeThread(hThread)
            End If
        End If
    Next i
    Call CloseHandle(hThread)
End Function

Public Function TerminateTargetOne() As Long
    Dim hPID As Long
    hPID = OpenProcess(PROCESS_ALL_ACCESS, 0, IdTargetOne)
    TerminateTargetOne = TerminateProcess(hPID, 0)
    Call CloseHandle(hPID)
End Function

Public Function TerminateTargetTwo() As Long
    Dim hPID As Long
    hPID = OpenProcess(PROCESS_ALL_ACCESS, 0, IdTargetTwo)
    TerminateTargetTwo = TerminateProcess(hPID, 0)
    Call CloseHandle(hPID)
End Function

Dan beri nama ModProcess
Pilih Project, terus add module, terus open, Isikan kode dibawah
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
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds 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
    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 Function
            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 Function
        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 Function
            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 Function
            End If
    End If

    MsgBox "Seep.. prosses inject telah succsses. Happy CHeating", 64, "White Injector succsses"

End Function

Public Sub InjectExecute(ByVal sFlDLL As String)
    Dim lProcInject As Long
    lProcInject = OpenProcess(PROCESS_ALL_ACCESS, 0, IdTargetOne)
    If lProcInject > "0" Then
       Call InjectDll(sFlDLL, lProcInject)
    End If
    Call CloseHandle(lProcInject)
End Sub
[/spoiler]
Dan berinama Modinjecktor
Pilih Project, terus add module, terus open, Isikan kode dibawah
[spoiler=for code]Option Explicit

'Common Dialog
Private Type OPENFILENAME
    lStructSize As Long
    hWndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    Flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type

Public Const OFN_READONLY = &H1
Public Const OFN_OVERWRITEPROMPT = &H2
Public Const OFN_HIDEREADONLY = &H4
Public Const OFN_NOCHANGEDIR = &H8
Public Const OFN_SHOWHELP = &H10
Public Const OFN_ENABLEHOOK = &H20
Public Const OFN_ENABLETEMPLATE = &H40
Public Const OFN_ENABLETEMPLATEHANDLE = &H80
Public Const OFN_NOVALIDATE = &H100
Public Const OFN_ALLOWMULTISELECT = &H200
Public Const OFN_EXTENSIONDIFFERENT = &H400
Public Const OFN_PATHMUSTEXIST = &H800
Public Const OFN_FILEMUSTEXIST = &H1000
Public Const OFN_CREATEPROMPT = &H2000
Public Const OFN_SHAREAWARE = &H4000
Public Const OFN_NOREADONLYRETURN = &H8000
Public Const OFN_NOTESTFILECREATE = &H10000
Public Const OFN_NONETWORKBUTTON = &H20000
Public Const OFN_NOLONGNAMES = &H40000                      '  force no long names for 4.x modules
Public Const OFN_EXPLORER = &H80000                         '  new look commdlg
Public Const OFN_NODEREFERENCELINKS = &H100000
Public Const OFN_LONGNAMES = &H200000                       '  force long names for 3.x modules
Public Const OFN_SHAREFALLTHROUGH = 2
Public Const OFN_SHARENOWARN = 1
Public Const OFN_SHAREWARN = 0

Private Declare Function GetOpenFileName Lib "COMDLG32.DLL" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Declare Function GetSaveFileName Lib "COMDLG32.DLL" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long

'Browse Folder Declarations
Private Type BrowseInfo
    hWndOwner As Long
    pIDLRoot As Long
    pszDisplayName As Long
    lpszTitle As Long
    ulFlags As Long
    lpfnCallback As Long
    lParam As Long
    iImage As Long
End Type
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const MAX_PATH = 260
Public Const BIF_STATUSTEXT = &H4&
Public Const BIF_DONTGOBELOWDOMAIN = 2
Public Const WM_USER = &H400
Public Const BFFM_INITIALIZED = 1
Public Const BFFM_SELCHANGED = 2
Public Const BFFM_SETSTATUSTEXT = (WM_USER + 100)
Public Const BFFM_SETSELECTION = (WM_USER + 102)

Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long

Function OpenDialog(Form1 As Form, Filter As String, Title As String, InitDir As String) As String
Dim ofn As OPENFILENAME
Dim A As Long
Dim theTemp As String

    ofn.lStructSize = Len(ofn)
    ofn.hWndOwner = Form1.hwnd
    ofn.hInstance = App.hInstance
    If Right$(Filter, 1) <> "|" Then Filter = Filter + "|"
    For A = 1 To Len(Filter)
        If Mid$(Filter, A, 1) = "|" Then Mid$(Filter, A, 1) = Chr$(0)
    Next
    ofn.lpstrFilter = Filter
    ofn.lpstrFile = Space$(254)
    ofn.nMaxFile = 255
    ofn.lpstrFileTitle = Space$(254)
    ofn.nMaxFileTitle = 255
    ofn.lpstrInitialDir = InitDir
    ofn.lpstrTitle = Title
    ofn.Flags = OFN_HIDEREADONLY Or OFN_FILEMUSTEXIST
    A = GetOpenFileName(ofn)

    If (A) Then
        theTemp = Trim$(ofn.lpstrFile)
        If Asc(Right$(theTemp, 1)) = 0 Then theTemp = Left$(theTemp, Len(theTemp) - 1)
        OpenDialog = theTemp
    Else
        OpenDialog = ""
    End If
End Function

Public Function BrowseForFolder(hWndOwner As Long, sPrompt As String) As String
'**************************************
' Name: Win95DirectoryPrompt
' Description:Prompting the User for a D
'     irectory in Win95. Windows' common dialo
'     gs are great if you want the user to sel
'     ect a file, but what if you want them to
'     select a directory? Call the following f
'     unction, which relies on Win32's new SHB
'     rowseForFolder function:
' By: Found on the World Wide Web
Dim iNull As Integer
Dim lpIDList As Long
Dim lResult As Long
Dim sPath As String
Dim udtBI As BrowseInfo

    With udtBI
        .hWndOwner = hWndOwner
        .lpszTitle = lstrcat(sPrompt, "")
        .ulFlags = BIF_RETURNONLYFSDIRS
    End With
    lpIDList = SHBrowseForFolder(udtBI)

    If lpIDList Then
        sPath = String$(MAX_PATH, 0)
        lResult = SHGetPathFromIDList(lpIDList, sPath)
        Call CoTaskMemFree(lpIDList)
        iNull = InStr(sPath, vbNullChar)

        If iNull Then
            sPath = Left$(sPath, iNull - 1)
        End If
    End If
    If InStr(LCase$(sPath), "\nethood") > 0 Then
        MsgBox "The item that you selected is a folder shortcut, not a folder.", vbCritical, "Browse Folders"
        BrowseForFolder = ""
    Else
        BrowseForFolder = sPath
    End If
End Function
Dan beri nama ModCDialog
5.Sekarang Bikin Timer caranya arahkan ke From1, kilk kanan view object dan lihat sebelah kiri VB6 cari gambar jam pencet 1 kali arahkan ke objek From1 dan talik , berinama timer1. Lakukan hal yang sama sampai berjumlah 6 timernya.

6.Seting Timernya caranya pencet gambar jam nomer 3,di From 1 (object) lihat kolom Properties pilih categories, lihat interval dan ganti angka 0 dengan 300. Ulangi hal yang sama pada Timer 4 dan 5.

7.Sekarang Arahkan pandangan di VB6 sebelah kiri, cari tulisan Commadbutom ( letaknya disebelah kanan tulisan A ), klik satu kali arahkan ke From 1 dan tarik.
Beri nama Exm1 lihat kolom Properties pilih categories cari Caption tulis Exm1, Buat l1 agi sama cuma namannya Exml3.

8.Sekarang Arahkan pandangan di VB6 sebelah kiri, cari tulisan Commadbutom ( letaknya disebelah kanan tulisan A ), klik satu kali arahkan ke From 1 dan tarik.Beri nama CmdTerminate lihat kolom Properties pilih categories cari Caption tulis Terminate

9.Sekarang Arahkan pandangan di VB6 sebelah kiri, cari tulisan Commadbutom ( letaknya disebelah kanan tulisan A ), klik satu kali arahkan ke From 1 dan tarik.Beri nama CmdExecute lihat kolom Properties pilih categories cari Caption tulis Resume.

10.Sekarang Arahkan pandangan di VB6 sebelah kiri, cari tulisan Commadbutom ( letaknya disebelah kanan tulisan A ), klik satu kali arahkan ke From 1 dan tarik. Beri nama CmdInjector lihat kolom Properties pilih categories cari Caption tulis Injek Dll.

11.Sekarang Arahkan pandangan di VB6 sebelah kiri, cari Huruf A ( letaknya disebelah kanan tulisan A ), klik satu kali arahkan ke From 1 dan tarik. Beri nama label3 lihat kolom Properties pilih categories cari Caption tulis Tanks to Credit.
Untuk Tulisan transparan silahkan cari Backstyle untuk warna forecolor.

12.Sekarang Arahkan pandangan di VB6 sebelah kiri, cari Huruf A ( letaknya disebelah kanan tulisan A ), klik satu kali arahkan ke From 1 dan tarik. Beri nama label1 lihat kolom Properties pilih categories cari Caption tulis nama kamu.
Untuk Tulisan transparan silahkan cari Backstyle untuk warna forecolor.

13.Sekarang Arahkan pandangan di VB6 sebelah kiri, cari Huruf A ( letaknya disebelah kanan tulisan A ), klik satu kali arahkan ke From 1 dan tarik. Beri nama label2 lihat kolom Properties pilih categories cari Caption tulis salam.
Untuk Tulisan transparan silahkan cari Backstyle untuk warna forecolor.

14.Sekarang Arahkan pandangan di VB6 sebelah kiri, cari Huruf A ( letaknya disebelah kanan tulisan A ), klik satu kali arahkan ke From 1 dan tarik. Beri nama label4 lihat kolom Properties pilih categories cari Caption tulis blog kamu.
Untuk Tulisan transparan silahkan cari Backstyle untuk warna forecolor.

15. Kalau Udah Siap test dulu, Caranya lihat di VB6 posisi atas tengah persis di bawah tulisan Diagram, ada gambar play kan pencet aja, nah kalu berhasil pasti jalan terus,

16.Cara Menyimpannya pilih File , pilih Make to project.exe simpan dan tes udah gitu aja

Read More...
Start a discussion »