SC injector VB6

Option Explicit
'Created Date: 02 Febuari 2011
'Form1 Auto injeck by MasterGhief
'This Code ngambil dari akan rifqi36@Forum Tetangga.Net.

'deklarasi variabel
Private winHwnd As Long
Private NamaDll As String

'deklarasi fungsi movable form
Private Const WM_NCLBUTTONDOWN As Long = &HA1
Private Const HTCAPTION As Integer = 2
Private Declare Sub ReleaseCapture Lib "user32" ()
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long


Private Sub Form_Load()
'Mengetengahkan Form
CenterForm Me

'sesuaikan nama dll dibawah ini dengan nama dll yg ingin di injectkan.
NamaDll = App.Path & "\Ayodance.dll"

'nama game target terserah,
FileTarget = "Audition.exe"

'jika ingin injector disetting otomatis exit
'berikan nilai 1 pada kode check1 dibawah, sebaliknya
'jika tidak berikan nilai 0
Check1.Value = 1

End Sub

Private Sub Form_Unload(Cancel As Integer)
'auto open url setelah form di close
OpenURL "www.cawag.forumid.net", Me.hwnd
End Sub

Private Sub Timer1_Timer()

winHwnd = GetProcessWndByName(FileTarget)
If Not winHwnd = 0 Then 'jika ditemukan
NTProcessList 'deteksi process game
InjectExecute NamaDll 'inject library
If Check1.Value = 1 Then 'jika check1 dicentang (Auto Exit After Injection) maka
End 'tutup otomatis injector
End If
Else 'jika tidak
Label1.Caption = "Waiting Game..."
Text1.Text = " By MasterGhief @ Cawag.forumid.net" 'Text yang akan muncul di Textbox pada saat unload
End If

End Sub

'kode center form
Private Sub CenterForm(frm As Form)

frm.Top = Screen.Height / 2 - frm.Height / 2
frm.Left = Screen.Width / 2 - frm.Width / 2

End Sub

'kode movable form
Private Sub Form_MouseMove(Button As Integer, _
Shift As Integer, _
X As Single, _
Y As Single)


If Button = 1 Then
ReleaseCapture
SendMessage Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
End If
Screen.MousePointer = vbDefault

End Sub

Option Explicit
    'Created Date: 02 Febuary 2011
    'Modul Universal Injection by [You must be registered and logged in to see this link.]
    'beberapa bagian code berasal dari sourcecode Gesp 1.3
    'credit by [You must be registered and logged in to see this link.] dan Rifky36@Forum Tetangga.Net
    'Edited by MasterGhief
    'NOT for sale

    Public FileTarget As String
    Private sFlDLL As String
    Private IdTargetOne As Long
    Private Const TH32CS_SNAPHEAPLIST As Long = &H1
    Private Const TH32CS_SNAPPROCESS As Long = &H2
    Private Const TH32CS_SNAPTHREAD As Long = &H4
    Private Const TH32CS_SNAPMODULE As Long = &H8
    Private Const TH32CS_SNAPALL As Double = (TH32CS_SNAPHEAPLIST Or TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE)
    Private Const MAX_PATH As Integer = 260
    Private Const PROCESS_ALL_ACCESS As Long = &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

    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

    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 OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, _
    ByVal bInheritHandle As Long, _
    ByVal dwProcessId 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 Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
    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 VirtualAllocEx Lib "kernel32" (ByVal hProcess As Long, _
    lpAddress As Any, _
    ByVal dwSize As Long, _
    ByVal fAllocType As Long, _
    flProtect As Long) As Long
    Private 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 Function GetFName(fn) As String

    Dim f As Integer
    Dim n As Integer

    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 If

    End Function

    Public Function GetProcessIdByName(ByVal szProcessName As String) As Long

    Dim pe32 As PROCESSENTRY32
    Dim hSnapshot As Long
    Dim bFoundProc As Boolean
    Dim dwProcId As Long

    dwProcId = 0
    pe32.dwSize = Len(pe32)
    hSnapshot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0&)
    bFoundProc = Process32First(hSnapshot, pe32)
    Do While bFoundProc
    If Right$(LCase$(Left$(pe32.szExeFile, InStr(1, pe32.szExeFile, vbNullChar) - 1)), Len(szProcessName)) = LCase$(szProcessName) Then
    dwProcId = pe32.th32ProcessID
    Exit Do
    End If
    bFoundProc = Process32Next(hSnapshot, pe32)
    Loop
    CloseHandle hSnapshot
    GetProcessIdByName = dwProcId

    End Function

    Public Function GetProcessWndByName(ByVal szProcessName As String) As Long

    Dim dwProcId As Long
    Dim dwProcWnd As Long

    dwProcId = GetProcessIdByName(szProcessName)
    If dwProcId = 0 Then
    GetProcessWndByName = 0
    Else
    dwProcWnd = OpenProcess(PROCESS_ALL_ACCESS, False, dwProcId)
    CloseHandle dwProcId
    GetProcessWndByName = dwProcWnd
    End If

    End Function

    Public Sub InjectDll(DllPath As String, _
    ProsH As Long)

    Dim DLLVirtLoc As Long
    Dim DllLength As Long
    Dim inject As Long
    Dim LibAddress As Long
    Dim CreateThread As Long
    Dim 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 Sub
    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 Sub
    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 Sub
    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 Sub
    End If
    End If
    Form1.Label1.Caption = "Injected Successful"
    MsgBox "Created By MasterGhief > _ <!", vbInformation, "Success"

    End Sub

    Public Sub InjectExecute(ByVal sFlDLL As String)

    Dim lProcInject As Long

    lProcInject = OpenProcess(PROCESS_ALL_ACCESS, 0, IdTargetOne)
    If lProcInject > "0" Then
    InjectDll sFlDLL, lProcInject
    End If
    CloseHandle lProcInject

    End Sub

    Public Function NTProcessList() As Long

    Dim FileName As String
    Dim ExePath As String
    Dim hProcSnap As Long
    Dim hModuleSnap As Long
    Dim lProc As Long
    Dim uProcess As PROCESSENTRY32
    Dim uModule As MODULEENTRY32

    On Error Resume Next
    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 FileTarget = FileName Then
    IdTargetOne = uProcess.th32ProcessID
    End If
    End If
    End If
    lProc = Process32Next(hProcSnap, uProcess)
    Loop
    CloseHandle hProcSnap
    CloseHandle lProc
    On Error GoTo 0

    End Function

    Private Function StripNulls(ByVal sStr As String) As String

    StripNulls = Left$(sStr, lstrlen(sStr))

    End Function

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