- Beranda
- Komunitas
- Tech
- Programmer Forum
Membuat TRAINER dengan VB6


TS
virgiecacad
Membuat TRAINER dengan VB6
BISMILAH NIROHMAN NIROHIM
agan agan ane mau share ni cara membuat Trainer dengan VB6
trik ini menggunakan WriteALong(Nama Gamenya, Address, Value)
Ini Contoh Trainer Harvest Moon dengan ePSXe 1.7.0
ini dia komposisinya :
- 1 Form
- 1 Module
- 1 Timer beri interval 11
Jangan Lupa Modulnya
ingat If GetAsyncKeyState(35) Then
(35) itu adalah hotkey untuk End
Hotkey Tersebut bisa agan ganti ko dengan sesuai selera agan agan
ini kumpulan hotkey VB6
GAN ANE TERIMA JUGA KO CENDOLNYA\t
Sekian Dari saya Wassalammualaikum Wr. Wb
agan agan ane mau share ni cara membuat Trainer dengan VB6
trik ini menggunakan WriteALong(Nama Gamenya, Address, Value)
Ini Contoh Trainer Harvest Moon dengan ePSXe 1.7.0
ini dia komposisinya :
- 1 Form
- 1 Module
- 1 Timer beri interval 11
Quote:
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Sub Form_Load()
Dim l As Long
l = CreateRoundRectRgn(0, 0, Me.Width / Screen.TwipsPerPixelX, Me.Height / Screen.TwipsPerPixelY, 20, 20)
SetWindowRgn Me.hWnd, l, True
App.TaskVisible = True 'Sembunyikan aplikasi dari window taskmanager true= untuk menampilkan /false Untuk Tidak menampilkan
'tetapi tidak hidden di process
'perintah menghindari aplikasi dijalankan 2 kali
'pada saat yg bersamaan
'----------------------------------------
If App.PrevInstance Then
End
End If
MsgBox " Virgie Riichnaldi 2011 ", vbInformation, "Tentang"
MsgBox " Kaskus My Faforite Forum!! ", vbCritical, " Perhatian "
MsgBox " Fitur Ada di read me! ", vbInformation, "informasi"
End Sub
Private Sub timer1_timer()
If GetAsyncKeyState(36) Then
Call WriteALong("ePSXe - Enhanced PSX Emulator", &H9BDA8C, 4)
Beep
End If
If GetAsyncKeyState(46) Then
Call WriteALong("ePSXe - Enhanced PSX Emulator", &H9BDA8C, 6)
Beep
End If
If GetAsyncKeyState(115) Then
Call WriteALong("ePSXe - Enhanced PSX Emulator", &H9BD2DC, 99)
Beep
End If
If GetAsyncKeyState(116) Then
Call WriteALong("ePSXe - Enhanced PSX Emulator", &H9BDA7C, 9999999)
Beep
End If
If GetAsyncKeyState(117) Then
Call WriteALong("ePSXe - Enhanced PSX Emulator", &H9BDA60, 65535)
Beep
End If
If GetAsyncKeyState(118) Then
Call WriteALong("ePSXe - Enhanced PSX Emulator", &H9BDA62, 65535)
Beep
End If
If GetAsyncKeyState(119) Then
Call WriteALong("ePSXe - Enhanced PSX Emulator", &H9BDA64, 65535)
Beep
End If
If GetAsyncKeyState(120) Then
Call WriteALong("ePSXe - Enhanced PSX Emulator", &H9BDA66, 65535)
Beep
End If
If GetAsyncKeyState(121) Then
Call WriteALong("ePSXe - Enhanced PSX Emulator", &H9BDA68, 65535)
Beep
End If
If GetAsyncKeyState(122) Then
Call WriteALong("ePSXe - Enhanced PSX Emulator", &H9BDA80, 9999999)
Beep
End If
If GetAsyncKeyState(123) Then
Call WriteALong("ePSXe - Enhanced PSX Emulator", &H9C27C0, 64334)
Beep
End If
If GetAsyncKeyState(33) Then
Call WriteALong("ePSXe - Enhanced PSX Emulator", &H9C2F10, 64334)
Beep
End If
If GetAsyncKeyState(34) Then
Call WriteALong("ePSXe - Enhanced PSX Emulator", &H9C32B8, 64334)
Beep
End If
If GetAsyncKeyState(45) Then
Call WriteALong("ePSXe - Enhanced PSX Emulator", &H9C3BDC, 64334)
Beep
End If
If GetAsyncKeyState(35) Then
Unload Me
MsgBox " Terima kasih telah memakai aplikasi saya ", vbinfomation, " Virgie Riichnaldi 2011 "
End If
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If (MsgBox("Bener Lo Mau Keluar", vbQuestion Or vbYesNo, "Keluar") = vbNo) Then
Cancel = True
End If
End Sub
Private Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Sub Form_Load()
Dim l As Long
l = CreateRoundRectRgn(0, 0, Me.Width / Screen.TwipsPerPixelX, Me.Height / Screen.TwipsPerPixelY, 20, 20)
SetWindowRgn Me.hWnd, l, True
App.TaskVisible = True 'Sembunyikan aplikasi dari window taskmanager true= untuk menampilkan /false Untuk Tidak menampilkan
'tetapi tidak hidden di process
'perintah menghindari aplikasi dijalankan 2 kali
'pada saat yg bersamaan
'----------------------------------------
If App.PrevInstance Then
End
End If
MsgBox " Virgie Riichnaldi 2011 ", vbInformation, "Tentang"
MsgBox " Kaskus My Faforite Forum!! ", vbCritical, " Perhatian "
MsgBox " Fitur Ada di read me! ", vbInformation, "informasi"
End Sub
Private Sub timer1_timer()
If GetAsyncKeyState(36) Then
Call WriteALong("ePSXe - Enhanced PSX Emulator", &H9BDA8C, 4)
Beep
End If
If GetAsyncKeyState(46) Then
Call WriteALong("ePSXe - Enhanced PSX Emulator", &H9BDA8C, 6)
Beep
End If
If GetAsyncKeyState(115) Then
Call WriteALong("ePSXe - Enhanced PSX Emulator", &H9BD2DC, 99)
Beep
End If
If GetAsyncKeyState(116) Then
Call WriteALong("ePSXe - Enhanced PSX Emulator", &H9BDA7C, 9999999)
Beep
End If
If GetAsyncKeyState(117) Then
Call WriteALong("ePSXe - Enhanced PSX Emulator", &H9BDA60, 65535)
Beep
End If
If GetAsyncKeyState(118) Then
Call WriteALong("ePSXe - Enhanced PSX Emulator", &H9BDA62, 65535)
Beep
End If
If GetAsyncKeyState(119) Then
Call WriteALong("ePSXe - Enhanced PSX Emulator", &H9BDA64, 65535)
Beep
End If
If GetAsyncKeyState(120) Then
Call WriteALong("ePSXe - Enhanced PSX Emulator", &H9BDA66, 65535)
Beep
End If
If GetAsyncKeyState(121) Then
Call WriteALong("ePSXe - Enhanced PSX Emulator", &H9BDA68, 65535)
Beep
End If
If GetAsyncKeyState(122) Then
Call WriteALong("ePSXe - Enhanced PSX Emulator", &H9BDA80, 9999999)
Beep
End If
If GetAsyncKeyState(123) Then
Call WriteALong("ePSXe - Enhanced PSX Emulator", &H9C27C0, 64334)
Beep
End If
If GetAsyncKeyState(33) Then
Call WriteALong("ePSXe - Enhanced PSX Emulator", &H9C2F10, 64334)
Beep
End If
If GetAsyncKeyState(34) Then
Call WriteALong("ePSXe - Enhanced PSX Emulator", &H9C32B8, 64334)
Beep
End If
If GetAsyncKeyState(45) Then
Call WriteALong("ePSXe - Enhanced PSX Emulator", &H9C3BDC, 64334)
Beep
End If
If GetAsyncKeyState(35) Then
Unload Me
MsgBox " Terima kasih telah memakai aplikasi saya ", vbinfomation, " Virgie Riichnaldi 2011 "
End If
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If (MsgBox("Bener Lo Mau Keluar", vbQuestion Or vbYesNo, "Keluar") = vbNo) Then
Cancel = True
End If
End Sub
Jangan Lupa Modulnya
Quote:
Public Const PROCESS_ALL_ACCESS = &H1F0FFF
Dim f1holder As Integer
Dim timer_pos As Long
Public Declare Function GetWindowThreadProcessId Lib "user32" (ByVal SomeValueIsStoredHere As Long, lpdwProcessId As Long) As Long
Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId 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
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject 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 GetKeyPress Lib "user32" Alias "GetAsyncKeyState" (ByVal key As Long) As Integer
Public Declare Function ReadProcessMem Lib "kernel32" Alias "ReadProcessMemory" (ByVal hProcess As Long, ByVal lpBaseAddress As Any, ByRef lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Public Function WriteALong(TheGame As String, TheAddress As Long, ThisIsTheValue As Long)
Dim SomeValueIsStoredHere As Long
Dim SomeValueIsStoredHereToo As Long
Dim SomeValue As Long
SomeValueIsStoredHere = FindWindow(vbNullString, TheGame)
GetWindowThreadProcessId SomeValueIsStoredHere, SomeValueIsStoredHereToo
SomeValue = OpenProcess(PROCESS_ALL_ACCESS, False, SomeValueIsStoredHereToo)
If (SomeValue = 0) Then
Exit Function
End If
WriteProcessMemory SomeValue, TheAddress, ThisIsTheValue, 4, 0&
CloseHandle hProcess
End Function
Public Function ReadALong(TheGame As String, TheAddress As Long, TheValue As Long)
Dim SomeValueIsStoredHere As Long
Dim SomeValueIsStoredHereToo As Long
Dim SomeValue As Long
SomeValueIsStoredHere = FindWindow(vbNullString, TheGame)
GetWindowThreadProcessId SomeValueIsStoredHere, SomeValueIsStoredHereToo
SomeValue = OpenProcess(PROCESS_ALL_ACCESS, False, SomeValueIsStoredHereToo)
If (SomeValue = 0) Then
Exit Function
End If
ReadProcessMem SomeValue, TheAddress, TheValue, 4, 0&
CloseHandle hProcess
End Function
Public Function ReadAFloat(TheGame As String, TheAddress As Long, TheValue As Single)
Dim SomeValueIsStoredHere As Long
Dim SomeValueIsStoredHereToo As Long
Dim SomeValue As Long
SomeValueIsStoredHere = FindWindow(vbNullString, TheGame)
GetWindowThreadProcessId SomeValueIsStoredHere, SomeValueIsStoredHereToo
SomeValue = OpenProcess(PROCESS_ALL_ACCESS, False, SomeValueIsStoredHereToo)
If (SomeValue = 0) Then
Exit Function
End If
ReadProcessMem SomeValue, TheAddress, TheValue, 4, 0&
CloseHandle hProcess
End Function
Public Function WriteAFloat(TheGame As String, TheAddress As Long, ThisIsTheValue As Single)
Dim SomeValueIsStoredHere As Long
Dim SomeValueIsStoredHereToo As Long
Dim SomeValue As Long
SomeValueIsStoredHere = FindWindow(vbNullString, TheGame)
GetWindowThreadProcessId SomeValueIsStoredHere, SomeValueIsStoredHereToo
SomeValue = OpenProcess(PROCESS_ALL_ACCESS, False, SomeValueIsStoredHereToo)
If (SomeValue = 0) Then
Exit Function
End If
WriteProcessMemory SomeValue, TheAddress, ThisIsTheValue, 4, 0&
CloseHandle hProcess
End Function
Dim f1holder As Integer
Dim timer_pos As Long
Public Declare Function GetWindowThreadProcessId Lib "user32" (ByVal SomeValueIsStoredHere As Long, lpdwProcessId As Long) As Long
Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId 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
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject 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 GetKeyPress Lib "user32" Alias "GetAsyncKeyState" (ByVal key As Long) As Integer
Public Declare Function ReadProcessMem Lib "kernel32" Alias "ReadProcessMemory" (ByVal hProcess As Long, ByVal lpBaseAddress As Any, ByRef lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Public Function WriteALong(TheGame As String, TheAddress As Long, ThisIsTheValue As Long)
Dim SomeValueIsStoredHere As Long
Dim SomeValueIsStoredHereToo As Long
Dim SomeValue As Long
SomeValueIsStoredHere = FindWindow(vbNullString, TheGame)
GetWindowThreadProcessId SomeValueIsStoredHere, SomeValueIsStoredHereToo
SomeValue = OpenProcess(PROCESS_ALL_ACCESS, False, SomeValueIsStoredHereToo)
If (SomeValue = 0) Then
Exit Function
End If
WriteProcessMemory SomeValue, TheAddress, ThisIsTheValue, 4, 0&
CloseHandle hProcess
End Function
Public Function ReadALong(TheGame As String, TheAddress As Long, TheValue As Long)
Dim SomeValueIsStoredHere As Long
Dim SomeValueIsStoredHereToo As Long
Dim SomeValue As Long
SomeValueIsStoredHere = FindWindow(vbNullString, TheGame)
GetWindowThreadProcessId SomeValueIsStoredHere, SomeValueIsStoredHereToo
SomeValue = OpenProcess(PROCESS_ALL_ACCESS, False, SomeValueIsStoredHereToo)
If (SomeValue = 0) Then
Exit Function
End If
ReadProcessMem SomeValue, TheAddress, TheValue, 4, 0&
CloseHandle hProcess
End Function
Public Function ReadAFloat(TheGame As String, TheAddress As Long, TheValue As Single)
Dim SomeValueIsStoredHere As Long
Dim SomeValueIsStoredHereToo As Long
Dim SomeValue As Long
SomeValueIsStoredHere = FindWindow(vbNullString, TheGame)
GetWindowThreadProcessId SomeValueIsStoredHere, SomeValueIsStoredHereToo
SomeValue = OpenProcess(PROCESS_ALL_ACCESS, False, SomeValueIsStoredHereToo)
If (SomeValue = 0) Then
Exit Function
End If
ReadProcessMem SomeValue, TheAddress, TheValue, 4, 0&
CloseHandle hProcess
End Function
Public Function WriteAFloat(TheGame As String, TheAddress As Long, ThisIsTheValue As Single)
Dim SomeValueIsStoredHere As Long
Dim SomeValueIsStoredHereToo As Long
Dim SomeValue As Long
SomeValueIsStoredHere = FindWindow(vbNullString, TheGame)
GetWindowThreadProcessId SomeValueIsStoredHere, SomeValueIsStoredHereToo
SomeValue = OpenProcess(PROCESS_ALL_ACCESS, False, SomeValueIsStoredHereToo)
If (SomeValue = 0) Then
Exit Function
End If
WriteProcessMemory SomeValue, TheAddress, ThisIsTheValue, 4, 0&
CloseHandle hProcess
End Function
ingat If GetAsyncKeyState(35) Then
(35) itu adalah hotkey untuk End
Hotkey Tersebut bisa agan ganti ko dengan sesuai selera agan agan
ini kumpulan hotkey VB6
Quote:
http://www.mediafire.com/?3df4bn86wsg41p9
passnya : virgieganteng
passnya : virgieganteng
GAN ANE TERIMA JUGA KO CENDOLNYA\t

Sekian Dari saya Wassalammualaikum Wr. Wb
0
5.3K
Kutip
25
Balasan


Komentar yang asik ya
Urutan
Terbaru
Terlama


Komentar yang asik ya
Komunitas Pilihan