Bir Form Acın Ve icinde Bir module Acın Ve Moduleye Sunları Ekleyin
'gerekli bileşenler yüklenir.
Option Explicit
Public Declare Function EnumProcessModules Lib "PSAPI.DLL" (ByVal hProcess As Long, ByRef lphModule As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
Public Declare Function GetModuleFileNameExA Lib "PSAPI.DLL" (ByVal hProcess As Long, ByVal hModule As Long, ByVal ModuleName As String, ByVal nSize As Long) As Long
Public Declare Function GetModuleInformation Lib "PSAPI.DLL" (ByVal hProcess As Long, ByVal hModule As Long, lpmodinfo As MODULEINFO, ByVal cb As Long) As Long
Public Declare Function GetTickCount Lib "kernel32" () As Long
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 Declare Function WriteProcessMem Lib "kernel32" Alias "WriteProcessMemory" (ByVal hProcess As Long, ByVal lpBaseAddress As Any, ByRef lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Public Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public KO_TITLE As String
Public KO_HANDLE As Long
Public KO_PID As Long
Public Const PROCESS_ALL_ACCESS = &H1F0FFF
Public HP As Long
Public MP As Long
Public Atack As Long
Public ko As Long
Public KO_PTR_CHR As Long
Public DINPUT_Handle As Long
Public DINPUT_lpBaseOfDLL As Long
Public DINPUT_SizeOfImage As Long
Public DINPUT_EntryPoint As Long
Public DINPUT_KEYDMA As Long
Public DINPUT_K_1 As Long
Public DINPUT_K_2 As Long
Public DINPUT_K_3 As Long
Public DINPUT_K_4 As Long
Public DINPUT_K_5 As Long
Public DINPUT_K_6 As Long
Public DINPUT_K_7 As Long
Public DINPUT_K_8 As Long
Public DINPUT_K_Z As Long
Public DINPUT_K_C As Long
Public DINPUT_K_S As Long
Public Type MODULEINFO
lpBaseOfDLL As Long
SizeOfImage As Long
EntryPoint As Long
End Type
' dll inject komutları
Public Function HookDI8() As Boolean
Dim Ret As Long
Dim lmodinfo As MODULEINFO
DINPUT_Handle = 0
DINPUT_Handle = FindModuleHandle("dinput8.dll")
Ret = GetModuleInformation(KO_HANDLE, DINPUT_Handle, lmodinfo, Len(lmodinfo))
If Ret <> 0 Then
With lmodinfo
DINPUT_EntryPoint = .EntryPoint
DINPUT_lpBaseOfDLL = .lpBaseOfDLL
DINPUT_SizeOfImage = .SizeOfImage
End With
Else
Exit Function
End If
SetupDInput
HookDI8 = True
End Function
Public Function FindModuleHandle(ModuleName As String) As Long
Dim hModules(1 To 256) As Long
Dim BytesReturned As Long
Dim ModuleNumber As Byte
Dim TotalModules As Byte
Dim FileName As String * 128
Dim ModName As String
EnumProcessModules KO_HANDLE, hModules(1), 1024, BytesReturned
TotalModules = BytesReturned / 4
For ModuleNumber = 1 To TotalModules
GetModuleFileNameExA KO_HANDLE, hModules(ModuleNumber), FileName, 128
ModName = Left(FileName, InStr(FileName, Chr(0)) - 1)
If UCase(Right(ModName, Len(ModuleName))) = UCase(ModuleName) Then
FindModuleHandle = hModules(ModuleNumber)
End If
Next
End Function
Sub SetupDInput()
DINPUT_KEYDMA = FindDInputKeyPtr
If DINPUT_KEYDMA <> 0 Then
DINPUT_K_1 = DINPUT_KEYDMA + 2
DINPUT_K_2 = DINPUT_KEYDMA + 3
DINPUT_K_3 = DINPUT_KEYDMA + 4
DINPUT_K_4 = DINPUT_KEYDMA + 5
DINPUT_K_5 = DINPUT_KEYDMA + 6
DINPUT_K_6 = DINPUT_KEYDMA + 7
DINPUT_K_7 = DINPUT_KEYDMA + 8
DINPUT_K_8 = DINPUT_KEYDMA + 9
DINPUT_K_Z = DINPUT_KEYDMA + 44
DINPUT_K_C = DINPUT_KEYDMA + 46
DINPUT_K_S = DINPUT_KEYDMA + 31
End If
End Sub
Function FindDInputKeyPtr() As Long
Dim pBytes() As Byte
Dim pSize As Long
Dim x As Long
pSize = DINPUT_SizeOfImage
ReDim pBytes(1 To pSize)
ReadByteArray DINPUT_lpBaseOfDLL, pBytes, pSize
For x = 1 To pSize - 10
If pBytes(x) = &H57 And pBytes(x + 1) = &H6A And pBytes(x + 2) = &H40 And pBytes(x + 3) = &H33 And pBytes(x + 4) = &HC0 And pBytes(x + 5) = &H59 And pBytes(x + 6) = &HBF Then
FindDInputKeyPtr = Val("&H" & IIf(Len(Hex(pBytes(x + 10))) = 1, "0" & Hex(pBytes(x + 10)), Hex(pBytes(x + 10))) & IIf(Len(Hex(pBytes(x + 9))) = 1, "0" & Hex(pBytes(x + 9)), Hex(pBytes(x + 9))) & IIf(Len(Hex(pBytes(x + )) = 1, "0" & Hex(pBytes(x + ), Hex(pBytes(x + )) & IIf(Len(Hex(pBytes(x + 7))) = 1, "0" & Hex(pBytes(x + 7)), Hex(pBytes(x + 7))))
Exit For
End If
Next
End Function
' Buraya ben yolla yazdım sizde istediğinizi yaza bilir siniz.
'ama prejedeki Bütün Yolla yazan yerleri değiştirmelisiniz.
Function yolla(pKey As String) As Long
pKey = Strings.UCase(pKey)
Select Case pKey
Case "S"
yolla = DINPUT_K_S
Case "Z"
yolla = DINPUT_K_Z
Case "1"
yolla = DINPUT_K_1
Case "2"
yolla = DINPUT_K_2
Case "3"
yolla = DINPUT_K_3
Case "4"
yolla = DINPUT_K_4
Case "5"
yolla = DINPUT_K_5
Case "6"
yolla = DINPUT_K_6
Case "7"
yolla = DINPUT_K_7
Case "8"
yolla = DINPUT_K_8
Case "C"
yolla = DINPUT_K_C
End Select
End Function
Sub WriteByte(Addr As Long, pVal As Byte)
Dim pbw As Long
WriteProcessMem KO_HANDLE, Addr, pVal, 1, pbw
End Sub
Sub ReadByteArray(Addr As Long, pmem() As Byte, pSize As Long)
Dim Value As Byte
ReDim pmem(1 To pSize) As Byte
ReadProcessMem KO_HANDLE, Addr, pmem(1), pSize, 0&
End Sub
' Buraya ben TUS yazdım sizde istediğinizi yaza bilir siniz.
'ama prejedeki Bütün TUS yazan yerleri değiştirmelisiniz.
Sub Tuş(pKey As Long, Optional pTimeMS As Long = 50)
WriteByte pKey, 128
f_Sleep pTimeMS, True
WriteByte pKey, 0
End Sub
Sub f_Sleep(pMS As Long, Optional pDoevents As Boolean = False)
Dim pTime As Long
pTime = GetTickCount
Do While pMS + pTime > GetTickCount
If pDoevents = True Then DoEvents
Loop
End Sub
' knight online Pencere komutları
Sub kohafıza()
KO_TITLE = "Knight OnLine Client"
GetWindowThreadProcessId FindWindow(vbNullString, KO_TITLE), KO_PID
KO_HANDLE = OpenProcess(PROCESS_ALL_ACCESS, False, KO_PID)
If KO_PID <> 0 Then
Else
MsgBox "KnightOnline açık değil!!!", vbDefaultButton1, "Dikkat"
End
End If
KO_PTR_CHR = &HB6D39C 'Karakter Pointer
HP = &H594
MP = &H93C
Atack = &H88
KO_TITLE = "Knight OnLine Client"
ko = ReadLong(KO_PTR_CHR)
End Sub
Public Function ReadLong(Addr As Long) As Long '4 byte lık değer okur
Dim Value As Long
ReadProcessMem KO_HANDLE, Addr, Value, 4, 0&
ReadLong = Value
End Function
Bakın simdi 6 adet text Ekleyin,1adet combo box ekleyin 3 adette timer ekleyin
Text1in ismi hpt ,Text2nin ismi hplımıt , text3un ismi hptus , text4un ismi mpt,text 5inismi mplımıt , text6nın ismide mptus olsun
comboboxun ismide ComboSKİL1 olsun
iki adet button ekleyin
Private Sub Timer1_Timer()
Link Kodu:
If ComboSKİL1.Text = "1" Then
Tuş yolla("1")
Tuş yolla("z")
End If
If ComboSKİL1.Text = "2" Then
Tuş yolla("2")
Tuş yolla("z")
End If
If ComboSKİL1.Text = "3" Then
Tuş yolla("3")
Tuş yolla("z")
End If
If ComboSKİL1.Text = "4" Then
Tuş yolla("4")
Tuş yolla("z")
End If
If ComboSKİL1.Text = "5" Then
Tuş yolla("5")
Tuş yolla("z")
End If
If ComboSKİL1.Text = "6" Then
Tuş yolla("6")
Tuş yolla("z")
End If
If ComboSKİL1.Text = "7" Then
Tuş yolla("7")
Tuş yolla("z")
End If
If ComboSKİL1.Text = "8" Then
Tuş yolla("8")
Tuş yolla("z")
End If
End Sub
Link Kodu:
Timer2.Timer()
'___HP______
If Check2.Value = 1 Then
If hptus.Text = "" Then
MsgBox "Lütfen HP tus Giriniz", vbDefaultButton1, "Dikkat"
Check2.Value = 0
Else
If hplımıt.Text = "" Then
MsgBox "Lütfen HP Limitinizi Giriniz", vbDefaultButton1, "Dikkat"
Check2.Value = 0
Else
If hplımıt.Text > hpt.Text Then
Tuş yolla(hptus.Text)
End If
End If
End If
End If
'________MP_____
If Check2.Value = 1 Then
If mptus.Text = "" Then
MsgBox "Lütfen MP tus Giriniz", vbDefaultButton1, "Dikkat"
Check2.Value = 0
Else
If mplımıt.Text = "" Then
MsgBox "Lütfen MP Limitinizi Giriniz", vbDefaultButton1, "Dikkat"
Check2.Value = 0
Else
If mplımıt.Text > mpt.Text Then
Tuş yolla(mptus.Text)
End If
End If
End If
End If
End Sub
Link Kodu:
Timer3.Timer()
hpt.Text = ReadLong(ko + HP)
mpt.Text = ReadLong(ko + MP)
Link Kodu:
Simdi Buttonların Kodları
Command1_Click ' Başlatma Buttonu
Timer1.Enabled = True
Timer2.Enabled = True
Link Kodu:
Command2_Click ' Durdurma Buttonu
Timer1.Enabled = False
Timer2.Enabled = False
'gerekli bileşenler yüklenir.
Option Explicit
Public Declare Function EnumProcessModules Lib "PSAPI.DLL" (ByVal hProcess As Long, ByRef lphModule As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
Public Declare Function GetModuleFileNameExA Lib "PSAPI.DLL" (ByVal hProcess As Long, ByVal hModule As Long, ByVal ModuleName As String, ByVal nSize As Long) As Long
Public Declare Function GetModuleInformation Lib "PSAPI.DLL" (ByVal hProcess As Long, ByVal hModule As Long, lpmodinfo As MODULEINFO, ByVal cb As Long) As Long
Public Declare Function GetTickCount Lib "kernel32" () As Long
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 Declare Function WriteProcessMem Lib "kernel32" Alias "WriteProcessMemory" (ByVal hProcess As Long, ByVal lpBaseAddress As Any, ByRef lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Public Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public KO_TITLE As String
Public KO_HANDLE As Long
Public KO_PID As Long
Public Const PROCESS_ALL_ACCESS = &H1F0FFF
Public HP As Long
Public MP As Long
Public Atack As Long
Public ko As Long
Public KO_PTR_CHR As Long
Public DINPUT_Handle As Long
Public DINPUT_lpBaseOfDLL As Long
Public DINPUT_SizeOfImage As Long
Public DINPUT_EntryPoint As Long
Public DINPUT_KEYDMA As Long
Public DINPUT_K_1 As Long
Public DINPUT_K_2 As Long
Public DINPUT_K_3 As Long
Public DINPUT_K_4 As Long
Public DINPUT_K_5 As Long
Public DINPUT_K_6 As Long
Public DINPUT_K_7 As Long
Public DINPUT_K_8 As Long
Public DINPUT_K_Z As Long
Public DINPUT_K_C As Long
Public DINPUT_K_S As Long
Public Type MODULEINFO
lpBaseOfDLL As Long
SizeOfImage As Long
EntryPoint As Long
End Type
' dll inject komutları
Public Function HookDI8() As Boolean
Dim Ret As Long
Dim lmodinfo As MODULEINFO
DINPUT_Handle = 0
DINPUT_Handle = FindModuleHandle("dinput8.dll")
Ret = GetModuleInformation(KO_HANDLE, DINPUT_Handle, lmodinfo, Len(lmodinfo))
If Ret <> 0 Then
With lmodinfo
DINPUT_EntryPoint = .EntryPoint
DINPUT_lpBaseOfDLL = .lpBaseOfDLL
DINPUT_SizeOfImage = .SizeOfImage
End With
Else
Exit Function
End If
SetupDInput
HookDI8 = True
End Function
Public Function FindModuleHandle(ModuleName As String) As Long
Dim hModules(1 To 256) As Long
Dim BytesReturned As Long
Dim ModuleNumber As Byte
Dim TotalModules As Byte
Dim FileName As String * 128
Dim ModName As String
EnumProcessModules KO_HANDLE, hModules(1), 1024, BytesReturned
TotalModules = BytesReturned / 4
For ModuleNumber = 1 To TotalModules
GetModuleFileNameExA KO_HANDLE, hModules(ModuleNumber), FileName, 128
ModName = Left(FileName, InStr(FileName, Chr(0)) - 1)
If UCase(Right(ModName, Len(ModuleName))) = UCase(ModuleName) Then
FindModuleHandle = hModules(ModuleNumber)
End If
Next
End Function
Sub SetupDInput()
DINPUT_KEYDMA = FindDInputKeyPtr
If DINPUT_KEYDMA <> 0 Then
DINPUT_K_1 = DINPUT_KEYDMA + 2
DINPUT_K_2 = DINPUT_KEYDMA + 3
DINPUT_K_3 = DINPUT_KEYDMA + 4
DINPUT_K_4 = DINPUT_KEYDMA + 5
DINPUT_K_5 = DINPUT_KEYDMA + 6
DINPUT_K_6 = DINPUT_KEYDMA + 7
DINPUT_K_7 = DINPUT_KEYDMA + 8
DINPUT_K_8 = DINPUT_KEYDMA + 9
DINPUT_K_Z = DINPUT_KEYDMA + 44
DINPUT_K_C = DINPUT_KEYDMA + 46
DINPUT_K_S = DINPUT_KEYDMA + 31
End If
End Sub
Function FindDInputKeyPtr() As Long
Dim pBytes() As Byte
Dim pSize As Long
Dim x As Long
pSize = DINPUT_SizeOfImage
ReDim pBytes(1 To pSize)
ReadByteArray DINPUT_lpBaseOfDLL, pBytes, pSize
For x = 1 To pSize - 10
If pBytes(x) = &H57 And pBytes(x + 1) = &H6A And pBytes(x + 2) = &H40 And pBytes(x + 3) = &H33 And pBytes(x + 4) = &HC0 And pBytes(x + 5) = &H59 And pBytes(x + 6) = &HBF Then
FindDInputKeyPtr = Val("&H" & IIf(Len(Hex(pBytes(x + 10))) = 1, "0" & Hex(pBytes(x + 10)), Hex(pBytes(x + 10))) & IIf(Len(Hex(pBytes(x + 9))) = 1, "0" & Hex(pBytes(x + 9)), Hex(pBytes(x + 9))) & IIf(Len(Hex(pBytes(x + )) = 1, "0" & Hex(pBytes(x + ), Hex(pBytes(x + )) & IIf(Len(Hex(pBytes(x + 7))) = 1, "0" & Hex(pBytes(x + 7)), Hex(pBytes(x + 7))))
Exit For
End If
Next
End Function
' Buraya ben yolla yazdım sizde istediğinizi yaza bilir siniz.
'ama prejedeki Bütün Yolla yazan yerleri değiştirmelisiniz.
Function yolla(pKey As String) As Long
pKey = Strings.UCase(pKey)
Select Case pKey
Case "S"
yolla = DINPUT_K_S
Case "Z"
yolla = DINPUT_K_Z
Case "1"
yolla = DINPUT_K_1
Case "2"
yolla = DINPUT_K_2
Case "3"
yolla = DINPUT_K_3
Case "4"
yolla = DINPUT_K_4
Case "5"
yolla = DINPUT_K_5
Case "6"
yolla = DINPUT_K_6
Case "7"
yolla = DINPUT_K_7
Case "8"
yolla = DINPUT_K_8
Case "C"
yolla = DINPUT_K_C
End Select
End Function
Sub WriteByte(Addr As Long, pVal As Byte)
Dim pbw As Long
WriteProcessMem KO_HANDLE, Addr, pVal, 1, pbw
End Sub
Sub ReadByteArray(Addr As Long, pmem() As Byte, pSize As Long)
Dim Value As Byte
ReDim pmem(1 To pSize) As Byte
ReadProcessMem KO_HANDLE, Addr, pmem(1), pSize, 0&
End Sub
' Buraya ben TUS yazdım sizde istediğinizi yaza bilir siniz.
'ama prejedeki Bütün TUS yazan yerleri değiştirmelisiniz.
Sub Tuş(pKey As Long, Optional pTimeMS As Long = 50)
WriteByte pKey, 128
f_Sleep pTimeMS, True
WriteByte pKey, 0
End Sub
Sub f_Sleep(pMS As Long, Optional pDoevents As Boolean = False)
Dim pTime As Long
pTime = GetTickCount
Do While pMS + pTime > GetTickCount
If pDoevents = True Then DoEvents
Loop
End Sub
' knight online Pencere komutları
Sub kohafıza()
KO_TITLE = "Knight OnLine Client"
GetWindowThreadProcessId FindWindow(vbNullString, KO_TITLE), KO_PID
KO_HANDLE = OpenProcess(PROCESS_ALL_ACCESS, False, KO_PID)
If KO_PID <> 0 Then
Else
MsgBox "KnightOnline açık değil!!!", vbDefaultButton1, "Dikkat"
End
End If
KO_PTR_CHR = &HB6D39C 'Karakter Pointer
HP = &H594
MP = &H93C
Atack = &H88
KO_TITLE = "Knight OnLine Client"
ko = ReadLong(KO_PTR_CHR)
End Sub
Public Function ReadLong(Addr As Long) As Long '4 byte lık değer okur
Dim Value As Long
ReadProcessMem KO_HANDLE, Addr, Value, 4, 0&
ReadLong = Value
End Function
Bakın simdi 6 adet text Ekleyin,1adet combo box ekleyin 3 adette timer ekleyin
Text1in ismi hpt ,Text2nin ismi hplımıt , text3un ismi hptus , text4un ismi mpt,text 5inismi mplımıt , text6nın ismide mptus olsun
comboboxun ismide ComboSKİL1 olsun
iki adet button ekleyin
Private Sub Timer1_Timer()
Link Kodu:
If ComboSKİL1.Text = "1" Then
Tuş yolla("1")
Tuş yolla("z")
End If
If ComboSKİL1.Text = "2" Then
Tuş yolla("2")
Tuş yolla("z")
End If
If ComboSKİL1.Text = "3" Then
Tuş yolla("3")
Tuş yolla("z")
End If
If ComboSKİL1.Text = "4" Then
Tuş yolla("4")
Tuş yolla("z")
End If
If ComboSKİL1.Text = "5" Then
Tuş yolla("5")
Tuş yolla("z")
End If
If ComboSKİL1.Text = "6" Then
Tuş yolla("6")
Tuş yolla("z")
End If
If ComboSKİL1.Text = "7" Then
Tuş yolla("7")
Tuş yolla("z")
End If
If ComboSKİL1.Text = "8" Then
Tuş yolla("8")
Tuş yolla("z")
End If
End Sub
Link Kodu:
Timer2.Timer()
'___HP______
If Check2.Value = 1 Then
If hptus.Text = "" Then
MsgBox "Lütfen HP tus Giriniz", vbDefaultButton1, "Dikkat"
Check2.Value = 0
Else
If hplımıt.Text = "" Then
MsgBox "Lütfen HP Limitinizi Giriniz", vbDefaultButton1, "Dikkat"
Check2.Value = 0
Else
If hplımıt.Text > hpt.Text Then
Tuş yolla(hptus.Text)
End If
End If
End If
End If
'________MP_____
If Check2.Value = 1 Then
If mptus.Text = "" Then
MsgBox "Lütfen MP tus Giriniz", vbDefaultButton1, "Dikkat"
Check2.Value = 0
Else
If mplımıt.Text = "" Then
MsgBox "Lütfen MP Limitinizi Giriniz", vbDefaultButton1, "Dikkat"
Check2.Value = 0
Else
If mplımıt.Text > mpt.Text Then
Tuş yolla(mptus.Text)
End If
End If
End If
End If
End Sub
Link Kodu:
Timer3.Timer()
hpt.Text = ReadLong(ko + HP)
mpt.Text = ReadLong(ko + MP)
Link Kodu:
Simdi Buttonların Kodları
Command1_Click ' Başlatma Buttonu
Timer1.Enabled = True
Timer2.Enabled = True
Link Kodu:
Command2_Click ' Durdurma Buttonu
Timer1.Enabled = False
Timer2.Enabled = False