1 Timer Aç İçine ; ( Enabled = False , İnvertal : 50 )

Dim nn As Long
On Error Resume Next
DispatchMailSlot

If UseAutoLoot = 1 Then
'If OpenNextBox = True Then
For nn = 1 To UBound(LootBox)
If LootBox(nn).BoxOpened = False And LootBox(nn).BoxID <> 0 Then
LootBox(nn).OpenTime = GetTickCount
'Debug.Print "Opening box..(" & LootBox(nn).BoxID & ")"
'OpenBox LootBox(nn).BoxID
LootBox(nn).BoxOpened = True
Exit For
End If
Next
Else
For nn = 1 To UBound(LootBox)
If LootBox(nn).BoxOpened = True And LootBox(nn).BoxID <> 0 Then
If (LootBox(nn).OpenTime + 2000) < GetTickCount Then
LootBox(nn).BoxID = 0
'Debug.Print "Removing box.."
' OpenNextBox = True
Exit For
End If
End If
Next
End If


1 Tamer Daha Aç İçine ; ( Enabled = False , İnvertal : 3 )

Dim MsgCount As Long
Dim rc As Long
Dim MessageBuffer As String
Dim pVal As Long
Dim Hp As Long
Dim maxhp As Long
Dim fullcode
Dim code
Dim sKey
Dim deger(1 To 20) As String, iza As Long
Dim dger11 As String
MsgCount = 1
Do While MsgCount <> 0
rc = CheckForMessages(MsgCount)

If CBool(rc) And MsgCount > 0 Then
If ReadMessage(MessageBuffer, MsgCount) Then
code = MessageBuffer
fullcode = Strings.Split(MessageBuffer, "")

Debug.Print Asc(Left(MessageBuffer, 1))
Select Case Asc(Left(MessageBuffer, 1))


Case 34


End Select
End If
End If


1 Check Aç İçine ;

If Check7.Value = 1 Then
UseAutoLoot = 1
Timer7.Enabled = True
Timer8.Enabled = False
Else
UseAutoLoot = 0
Timer7.Enabled = False
Timer8.Enabled = True

Oto Kutu Modulu Düzgün.

Option Explicit
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Public Const DIK_0 As Long = 1
Public Const DIK_1 As Long = 2
Public Const DIK_2 As Long = 3
Public Const DIK_3 As Long = 4
Public Const DIK_4 As Long = 5
Public Const DIK_5 As Long = 6
Public Const DIK_6 As Long = 7
Public Const DIK_7 As Long = 8
Public Const DIK_8 As Long = 9
Public Const DIK_9 As Long = 10
Public UseAutoLoot As Long
Public Const DIK_F1 As Long = &H3B
Public Const WIZ_MOVE = &H6
Public Const DIK_F2 As Long = 60
Public Const DIK_F3 As Long = &H3D
Public Const DIK_F4 As Long = &H3E
Public Const DIK_F5 As Long = &H3F
Public Const DIK_F6 As Long = &H40
Public Const DIK_F7 As Long = &H41
Public Const DIK_F8 As Long = &H42
Public Const DIK_Z As Long = &H2C
Public Const DIK_C As Long = &H2E
Public Const DIK_B As Long = &H30
Public Const DIK_R As Long = &H13
Public Const DIK_S As Long = &H1F
Public Const DIK_TAB As Long = 15
Public Const DIK_E As Long = &H12
Public Const DIK_X As Long = &H2D
Public Const KeybPtr As Long = &HB6FC5C
Public Const KO_DIKKEY As Long = &H26C
Private Const INFINITE = &HFFFF
Private Const MEM_COMMIT = &H1000
Private Const MEM_RELEASE = &H8000&
Private Const PAGE_READWRITE = &H4&
Public Const MAILSLOT_NO_MESSAGE As Long = (-1)
Public HexSözcük As String
Public Declare Function GetTickCount Lib "kernel32" () As Long 'apidir bunu ekle modulde yukarıya
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) 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
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Long) As Long
Private Declare Function CreateMailslot Lib "kernel32" Alias "CreateMailslotA" (ByVal lpName As String, ByVal nMaxMessageSize As Long, ByVal lReadTimeout As Long, lpSecurityAttributes As Any) As Long
Private Declare Function GetMailslotInfo Lib "kernel32" (ByVal hMailSlot As Long, lpMaxMessageSize As Long, lpNextSize As Long, lpMessageCount As Long, lpReadTimeout As Long) As Long
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) 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 FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare Function CreateRemoteThread Lib "kernel32" (ByVal hProcess As Long, lpThreadAttributes As SECURITY_ATTRIBUTES, ByVal dwStackSize As Long, lpStartAddress As Long, lpparameter As Any, ByVal dwCreationFlags As Long, lpThreadID As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function VirtualFreeEx Lib "kernel32" (ByVal hProcess As Long, lpAddress As Any, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long
Private Declare Function VirtualAllocEx Lib "kernel32" (ByVal hProcess As Long, ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function GetPrivateProfileSection Lib "kernel32" Alias "GetPrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileSection Lib "kernel32" Alias "WritePrivateProfileSectionA" (ByVal lpAppName As String, ByVal lPaketing As String, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lPaketing As Any, ByVal lpFileName As String) As Long
Public Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private 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 Sub Sleep Lib "kernel32" (ByVal dwMilliseconds 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 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 KO_ADI As String
Public KO_HANDLE As Long
Public KO_PID As Long
Public Klavye As Long
Public FuncPtr As Long
Public BytesAddr As Long
Public KO_ADR_CHR As Long
Public MsName
Public Hook
Public MSHandle
Public Const PROCESS_ALL_ACCESS = &H1F0FFF
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_B As Long
Public DINPUT_K_C As Long
Public DINPUT_K_S As Long
Public DINPUT_K_R As Long
Const HWND_TOPMOST = -1
Const HWND_NOTOPMOST = -2
Const SWP_NOMOVE As Long = &H2
Const SWP_NOSIZE As Long = &H1

' Pointerler
Public KO_PTR_CHR As Long
Public KO_PTR_PKT As Long
Public KO_PTR_DLG As Long
Public KO_SND_FNC As Long
Public KO_SND_PACKET As Long
Public KO_OFF_PARTY As Long
Public KO_KEY_PTR As Long
Public KO_SENDPTR As Long
' Offsetler
Public KO_OFF_SWIFT As Long
Public KO_OFF_CLASS As Long
Public KO_OFF_ID As Long
Public KO_OFF_ID2 As Long
Public KO_OFF_MOB As Long
Public KO_OFF_HP As Long
Public KO_OFF_MAXHP As Long
Public KO_OFF_MP As Long
Public KO_OFF_MAXMP As Long
Public KO_OFF_Y As Long
Public KO_OFF_X As Long
Public KO_OFF_Z As Long
Public KO_OFF_EXP As Long
Public KO_OFF_MAXEXP As Long
Public KO_OFF_LVL As Long
Public KO_OFF_PARA As Long
Public KO_OFF_MX As Long
Public LastBoxID As Long
Public KO_OFF_MY As Long
Public KO_OFF_MZ As Long
Public KO_OFF_HD As Long
Public KO_OFF_Go1 As Long
Public KO_OFF_GoX As Long
Public KO_RECVHK As Long
Public KO_RCVHKB As Long
Public KO_RCVFNC As Long
Public KO_OFF_GoY As Long
Public KO_OFF_Go2 As Long
Public KO_OFF_ZONE As Long
Public OpenNextBox As Boolean
' Party Offsetleri
Public PartyHP As Long
Public PartyMaxHP As Long
Public PartyID As Long
Public PartyLevel As Long
Public PartyClass As Long
Public PartyCure1 As Long
Public PartyCure2 As Long
Public PartyCure3 As Long
Public PartyCure4 As Long
Public PartySayısı As Long
Public PartyAdı As Long
Public PartyOffset As Long
Public PartyValue As Long
' Pet Offsetleri
Public KO_PET_ID As Long
Public KO_PET_OFFSET As Long
Public KO_PET_HP As Long
Public KO_PET_MaxHP As Long
Public KO_PET_MP As Long
Public KO_PET_MaxMP As Long
Public KO_PET_LWL As Long
Public Type MODULEINFO
lpBaseOfDLL As Long
SizeOfImage As Long
EntryPoint As Long
End Type
Public Sub KlavyeYükle()
Klavye = LongOku(KeybPtr + 0)
Klavye = Klavye + 620
End Sub
Function SolElDurabiltyOku() As Long
SolElDurabiltyOku = LongOku(LongOku(LongOku(KO_PTR_DLG) + &H2D4) + &HF0)
End Function
Function SağElDurabiltyOku() As Long
SağElDurabiltyOku = LongOku(LongOku(LongOku(KO_PTR_DLG) + &H2D4) + &HEC)
End Function
Function SolElRpr() As String
Dim a As Long
Dim b As Long
Dim c As Long
Dim d As String
a = ReadDoublePointer(KO_PTR_CHR, &H338, &H0)
b = ReadDoublePointer(KO_PTR_CHR, &H348, &H0)
c = a + b
d = AlignDWORD(c)
SolElRpr = d
End Function
Function SağElRpr() As String
Dim a As Long
Dim b As Long
Dim c As Long
Dim d As String
a = ReadDoublePointer(KO_PTR_CHR, &H33C, &H0)
b = ReadDoublePointer(KO_PTR_CHR, &H34C, &H0)
c = a + b
d = AlignDWORD(c)
SağElRpr = d
End Function
Public Sub PaketWolfVsVs(pStr As String)
Dim pBytes() As Byte
Hex2Byte pStr, pBytes
PaketGönder pBytes
End Sub

Function HexString(EvalString As String) As String
Dim intStrLen As Integer
Dim intLoop As Integer
Dim strHex As String

EvalString = Trim(EvalString)
intStrLen = Len(EvalString)
For intLoop = 1 To intStrLen
strHex = strHex & Hex(Asc(Mid(EvalString, intLoop, 1)))
Next
HexString = strHex
HexSözcük = strHex
End Function
Function HedefmobID()
Dim pPtr As Long
Dim GetMobID As String
Dim GetMBID As Long
pPtr = LongOku(KO_PTR_CHR)
GetMBID = LongOku(pPtr + KO_OFF_MOB)
GetMobID = AlignDWORD(GetMBID)
HedefmobID = Strings.Mid(GetMobID, 1, 4)
End Function
Function ReadDoublePointer(pointer As Long, Offset1 As Long, Offset2 As Long) As Long
Dim pPtrAdress1 As Long
Dim pPtrAdress2 As Long
pPtrAdress1 = LongOku(LongOku(pointer) + Offset1)
pPtrAdress2 = LongOku(pPtrAdress1 + Offset2)
ReadDoublePointer = pPtrAdress2
End Function


'/////////////////////////////////////////////////


Function FormatHex(strHex As String, inLength As Integer)
Dim newHex As String, byte1 As String, byte2 As String, byte3 As String, byte4 As String
Dim ZeroSpaces As Integer
ZeroSpaces = inLength - Len(strHex) '1
newHex = String(ZeroSpaces, "0") + strHex '0ABC
byte1 = Left(newHex, 2)
byte2 = Mid(newHex, 3, 2)
byte3 = Mid(newHex, 5, 2)
byte4 = Right(newHex, 2)
Select Case Len(newHex)
Case 2 '0A
newHex = byte1
Case 4 '0ABC
newHex = byte4 & byte1
Case 6 '000ABC
newHex = byte4 & byte2 & byte1
Case 8 '00000ABC
newHex = byte4 & byte3 & byte2 & byte1
Case Else
End Select
FormatHex = newHex
End Function
Public Sub SendK(ByVal Key As Long)
LongYaz Klavye + Key * 4, 1
Sleep (50)
LongYaz Klavye + Key * 4, 0
End Sub

Function KlavyeBas(Keys As Long)
Dim a, b, c As Long
Dim kb As Long
Dim kb2 As Long
kb = LongOku(KO_PTR_PKT - 4)
a = kb + KO_DIKKEY
LongYaz a + Keys * 4, 1
Sleep (50)
LongYaz a + Keys * 4, 0
End Function

Public Function LongOku(Addr As Long) As Long 'read a 4 byte value
Dim Value As Long
ReadProcessMem KO_HANDLE, Addr, Value, 4, 0&
LongOku = Value
End Function

Public Function FloatOku(Addr As Long) As Long 'read a float value
On Error Resume Next
Dim Value As Single
ReadProcessMem KO_HANDLE, Addr, Value, 4, 0&
FloatOku = Value
End Function

Public Function FloatYaz(Addr As Long, Val As Single) 'write a float value
WriteProcessMem KO_HANDLE, Addr, Val, 4, 0&
End Function

Public Function LongYaz(Addr As Long, Val As Long) ' write a 4 byte value
WriteProcessMem KO_HANDLE, Addr, Val, 4, 0&
End Function
Public Function AttachKO() As Boolean
Dim inject As Boolean
If FindWindow(vbNullString, KO_ADI) Then
MsName = "\\.\mailslot\ByS0x" & Hex(GetTickCount)
GetWindowThreadProcessId FindWindow(vbNullString, KO_ADI), KO_PID
KO_HANDLE = OpenProcess(PROCESS_ALL_ACCESS, False, KO_PID)
If KO_HANDLE = 0 Then
MsgBox ("Cannot get handle from KO(" & KO_PID & ").")
AttachKO = False
End If
Hook = HookDI8
If Hook = False Then
AttachKO = False
MsgBox "Dinput8.dll Yüklenemiyor.Koxpun Bulundupu Klasöre Dinput8.dll atiniz.", vbDefaultButton2, "Dikkat"
End If
MSHandle = EstablishMailSlot(MsName)
If MSHandle = 0 Then End
If KO_PID = 0 Then End
AttachKO = True
Else
MsgBox "Programın çalışabilmesi için oyunda olmanız gerekir.", vbDefaultButton1, "Dikkat"
End If
End Function
Public Function EstablishMailSlot(ByVal MailSlotName As String, Optional MaxMessageSize As Long = 0, Optional ReadTimeOut As Long = 50) As Long
EstablishMailSlot = CreateMailslot(MailSlotName, MaxMessageSize, ReadTimeOut, ByVal 0&)
End Function
Public Function HookDI8() As Boolean
Dim Ret As Long
Dim lmodinfo As MODULEINFO
DINPUT_Handle = 0

DINPUT_Handle = ModülHandleBul("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
DinputYükle
HookDI8 = True
End Function

Public Function ModülHandleBul(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
ModülHandleBul = hModules(ModuleNumber)
End If
Next
End Function

Sub DinputYükle()
DINPUT_KEYDMA = DinputAnahtarıBul
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_B = DINPUT_KEYDMA + 48
DINPUT_K_C = DINPUT_KEYDMA + 46
DINPUT_K_S = DINPUT_KEYDMA + 31
DINPUT_K_R = DINPUT_KEYDMA + 19
End If
End Sub

Function DinputAnahtarıBul() As Long
Dim PaketByte() As Byte
Dim psize As Long
Dim X As Long
psize = DINPUT_SizeOfImage
ReDim PaketByte(1 To psize)
SıraByteOku DINPUT_lpBaseOfDLL, PaketByte, psize
For X = 1 To psize - 10
If PaketByte(X) = &H57 And PaketByte(X + 1) = &H6A And PaketByte(X + 2) = &H40 And PaketByte(X + 3) = &H33 And PaketByte(X + 4) = &HC0 And PaketByte(X + 5) = &H59 And PaketByte(X + 6) = &HBF Then
DinputAnahtarıBul = Val("&H" & IIf(Len(Hex(PaketByte(X + 10))) = 1, "0" & Hex(PaketByte(X + 10)), Hex(PaketByte(X + 10))) & IIf(Len(Hex(PaketByte(X + 9))) = 1, "0" & Hex(PaketByte(X + 9)), Hex(PaketByte(X + 9))) & IIf(Len(Hex(PaketByte(X + 8))) = 1, "0" & Hex(PaketByte(X + 8)), Hex(PaketByte(X + 8))) & IIf(Len(Hex(PaketByte(X + 7))) = 1, "0" & Hex(PaketByte(X + 7)), Hex(PaketByte(X + 7))))
Exit For
End If
Next
End Function
Function BAS(pKey As String) As Long
pKey = Strings.UCase(pKey)
Select Case pKey
Case "S"
BAS = DINPUT_K_S
Case "Z"
BAS = DINPUT_K_Z
Case "b"
BAS = DINPUT_K_B
Case "1"
BAS = DINPUT_K_1
Case "2"
BAS = DINPUT_K_2
Case "3"
BAS = DINPUT_K_3
Case "4"
BAS = DINPUT_K_4
Case "5"
BAS = DINPUT_K_5
Case "6"
BAS = DINPUT_K_6
Case "7"
BAS = DINPUT_K_7
Case "8"
BAS = DINPUT_K_8
Case "C"
BAS = DINPUT_K_C
Case "R"
BAS = DINPUT_K_R
End Select
End Function

Sub ByteYaz(Addr As Long, pVal As Byte)
Dim pbw As Long
WriteProcessMem KO_HANDLE, Addr, pVal, 1, pbw
End Sub

Sub SıraByteOku(Addr As Long, pmem() As Byte, psize As Long)
Dim Value As Byte
On Error Resume Next
ReDim pmem(1 To psize) As Byte
ReadProcessMem KO_HANDLE, Addr, pmem(1), psize, 0&
End Sub
Function ByteOku(pAddy As Long, Optional pHandle As Long) As Byte
Dim Value As Byte
If pHandle <> 0 Then
ReadProcessMem pHandle, pAddy, Value, 1, 0&
Else
ReadProcessMem KO_HANDLE, pAddy, Value, 1, 0&
End If
ByteOku = Value
End Function
Sub Tuş(pKey As Long, Optional pTimeMS As Long = 50)
ByteYaz pKey, 128
f_Sleep pTimeMS, True
ByteYaz 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
Function AlignDWORD(pParam As Long) As String
Dim HiW As Integer
Dim LoW As Integer

Dim HiBHiW As Byte
Dim HiBLoW As Byte

Dim LoBHiW As Byte
Dim LoBLoW As Byte

HiW = HiWord(pParam)
LoW = LoWord(pParam)

HiBHiW = HiByte(HiW)
HiBLoW = HiByte(LoW)

LoBHiW = LoByte(HiW)
LoBLoW = LoByte(LoW)

AlignDWORD = IIf(Len(Hex(LoBLoW)) = 1, "0" & Hex(LoBLoW), Hex(LoBLoW)) & _
IIf(Len(Hex(HiBLoW)) = 1, "0" & Hex(HiBLoW), Hex(HiBLoW)) & _
IIf(Len(Hex(LoBHiW)) = 1, "0" & Hex(LoBHiW), Hex(LoBHiW)) & _
IIf(Len(Hex(HiBHiW)) = 1, "0" & Hex(HiBHiW), Hex(HiBHiW))
End Function
Function AlignDWORD8(pParam As Long) As String
Dim HiW As Integer
Dim LoW As Integer

Dim HiBHiW As Byte
Dim HiBLoW As Byte

Dim LoBHiW As Byte
Dim LoBLoW As Byte

HiW = HiWord(pParam)
LoW = LoWord(pParam)

HiBHiW = HiByte(HiW)
HiBLoW = HiByte(LoW)

LoBHiW = LoByte(HiW)
LoBLoW = LoByte(LoW)

AlignDWORD8 = IIf(Len(Hex(LoBLoW)) = 1, "0" & Hex(LoBLoW), Hex(LoBLoW)) & _
IIf(Len(Hex(HiBLoW)) = 1, "0" & Hex(HiBLoW), Hex(HiBLoW)) & _
IIf(Len(Hex(LoBHiW)) = 1, "0" & Hex(LoBHiW), Hex(LoBHiW)) & _
IIf(Len(Hex(HiBHiW)) = 1, "0" & Hex(HiBHiW), Hex(HiBHiW)) & _
IIf(Len(Hex(LoBLoW)) = 1, "0" & Hex(LoBLoW), Hex(LoBLoW)) & _
IIf(Len(Hex(HiBLoW)) = 1, "0" & Hex(HiBLoW), Hex(HiBLoW)) & _
IIf(Len(Hex(LoBHiW)) = 1, "0" & Hex(LoBHiW), Hex(LoBHiW)) & _
IIf(Len(Hex(HiBHiW)) = 1, "0" & Hex(HiBHiW), Hex(HiBHiW))
End Function

Public Function HiByte(ByVal wParam As Integer) As Byte
HiByte = (wParam And &HFF00&) \ (&H100)
End Function
Public Function LoByte(ByVal wParam As Integer) As Byte
LoByte = wParam And &HFF&
End Function

Function LoWord(DWord As Long) As Integer
If DWord And &H8000& Then '
LoWord = DWord Or &HFFFF0000
Else
LoWord = DWord And &HFFFF&
End If
End Function

Function HiWord(DWord As Long) As Integer
HiWord = (DWord And &HFFFF0000) \ &H10000
End Function
Function PaketGönder(pPacket() As Byte)
On Error Resume Next
Dim psize As Long
Dim pCode() As Byte

psize = UBound(pPacket) - LBound(pPacket) + 1
If BytesAddr = 0 Then
BytesAddr = VirtualAllocEx(KO_HANDLE, 0, 1024, MEM_COMMIT, PAGE_READWRITE)
End If
If BytesAddr <> 0 Then
ByteDizisiYaz BytesAddr, pPacket, psize
Hex2Byte "608B0D" & AlignDWORD(KO_PTR_PKT) & "68" & AlignDWORD(psize) & "68" & AlignDWORD(BytesAddr) & "BF" & AlignDWORD(KO_SND_FNC) & "FFD7C605" & AlignDWORD(KO_SND_PACKET) & "0061C3", pCode
UzaktanKodÇalıştır pCode, True
End If
VirtualFreeEx KO_HANDLE, BytesAddr, 0, MEM_RELEASE&
End Function
Function UzaktanKodÇalıştır(pCode() As Byte, Optional WaitExecution As Boolean = False) As Long
Dim hThread As Long, ThreadID As Long, Ret As Long
Dim SE As SECURITY_ATTRIBUTES

SE.nLength = Len(SE)
SE.bInheritHandle = False

UzaktanKodÇalıştır = 0
If FuncPtr = 0 Then
FuncPtr = VirtualAllocEx(KO_HANDLE, 0, 1024, MEM_COMMIT, PAGE_READWRITE)
End If
If FuncPtr <> 0 Then
ByteDizisiYaz FuncPtr, pCode, UBound(pCode) - LBound(pCode) + 1

hThread = CreateRemoteThread(ByVal KO_HANDLE, SE, 0, ByVal FuncPtr, 0&, 0&, ThreadID)
If hThread Then
Ret = WaitForSingleObject(hThread, INFINITE)
UzaktanKodÇalıştır = ThreadID
End If
CloseHandle hThread
Ret = VirtualFreeEx(KO_HANDLE, FuncPtr, 0, MEM_RELEASE)
End If
End Function
Public Function Hex2Byte(Paket As String, pByte() As Byte)
On Error Resume Next
Dim i As Long
Dim j As Long
ReDim pByte(1 To Len(Paket) / 2)

j = LBound(pByte) - 1
For i = 1 To Len(Paket) Step 2
j = j + 1
pByte(j) = CByte("&H" & Mid(Paket, i, 2))
Next
End Function
Public Function ByteDizisiYaz(pAddy As Long, pmem() As Byte, psize As Long)
WriteProcessMem KO_HANDLE, pAddy, pmem(LBound(pmem)), psize, 0&
End Function


Public Sub Paket(Paket As String)
Dim PaketByte() As Byte
Hex2Byte Paket, PaketByte
PaketGönder PaketByte
End Sub

Function SınıfBul() As Long
SınıfBul = LongOku(LongOku(KO_PTR_CHR) + KO_OFF_CLASS)
End Function

Function KarakterID()
KarakterID = Strings.Mid(AlignDWORD(LongOku(LongOku(KO_PTR_CHR) + KO_OFF_ID2)), 1, 4)
End Function

Function DüşmanID()
DüşmanID = Strings.Mid(AlignDWORD(LongOku(LongOku(KO_PTR_CHR) + KO_OFF_MOB)), 1, 4)
End Function

Function KarakterHP()
KarakterHP = LongOku(KO_ADR_CHR + KO_OFF_HP)
End Function

Function KarakterMaxHP()
KarakterMaxHP = LongOku(KO_ADR_CHR + KO_OFF_MAXHP)
End Function

Function KarakterMP()
KarakterMP = LongOku(KO_ADR_CHR + KO_OFF_MP)
End Function

Function KarakterMaxMP()
KarakterMaxMP = LongOku(KO_ADR_CHR + KO_OFF_MAXMP)
End Function


Function YazıOku(ByVal pAddy As Long, ByVal OtoSize As Boolean, Optional ByVal LSize As Long = 1) As String
Dim Value As Byte
Dim tex() As Byte
On Error Resume Next
If OtoSize = True Then
ReadProcessMem KO_HANDLE, pAddy, Value, 1, 0&
LSize = Value
ReDim tex(1 To LSize)
ReadProcessMem KO_HANDLE, pAddy, tex(1), LSize, 0&
YazıOku = StrConv(tex, vbUnicode)
Else
If LSize = 0 Then
MsgBox "Fazla Karakter içeriyor..", vbCritical, "Hata"
Exit Function
Else
ReDim tex(1 To LSize)
ReadProcessMem KO_HANDLE, pAddy, tex(1), LSize, 0&
YazıOku = StrConv(tex, vbUnicode)
End If
End If
End Function

Public Sub YukarıdaTut(TheForm As Form, SetOnTop As Boolean)
Dim lflag
If SetOnTop Then
lflag = HWND_TOPMOST
Else
lflag = HWND_NOTOPMOST
End If
SetWindowPos TheForm.hWnd, lflag, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
End Sub

Function DefterOku(e As String, f As String, g As String) As String
Dim sRet As String
sRet = String(255, Chr(0))
DefterOku = Left(sRet, GetPrivateProfileString(e, ByVal f$, "", sRet, Len(sRet), g))
End Function
Function DefterYaz(a As String, b As String, c As String, d) As Integer
Dim r
r = WritePrivateProfileString(a, b, c, d)
End Function

Function MobName() As String
Dim a As Long, b As Long, c As Long, d As Long
a = LongOku(LongOku(LongOku(LongOku(KO_PTR_DLG) + &H1B8) + &HD4) + &HC4) 'C4 1B8
b = LongOku(a + &H8) '&H8
c = LongOku(a + &HC) 'C
MobName = YazıOku(b, c)
End Function

Function KarakterX()
KarakterX = FloatOku(KO_ADR_CHR + KO_OFF_X)
End Function

Function KarakterY()
KarakterY = FloatOku(KO_ADR_CHR + KO_OFF_Y)
End Function

Function KarakterZ()
KarakterZ = FloatOku(KO_ADR_CHR + KO_OFF_Z)
End Function

Public Function DüşmanHP()
DüşmanHP = LongOku(LongOku(LongOku(LongOku(KO_PTR_DLG) + &H1B8) + &HC4) + &HEC)
End Function

Function DüşmanX()
DüşmanX = FloatOku(LongOku(LongOku(KO_PTR_DLG) + &H3D4) + &H48)
End Function

Function DüşmanY()
DüşmanY = FloatOku(LongOku(LongOku(KO_PTR_DLG) + &H3D4) + &H50)
End Function

Function DüşmanZ()
DüşmanZ = FloatOku(LongOku(LongOku(KO_PTR_DLG) + &H3D4) + &H4C)
End Function

Function DüşmanUzaklık()
DüşmanUzaklık = Fix((((DüşmanX - FloatOku(LongOku(KO_PTR_CHR) + &HB4)) * (DüşmanX - FloatOku(LongOku(KO_PTR_CHR) + &HB4)) + (DüşmanY - FloatOku(LongOku(KO_PTR_CHR) + &HBC)) * (DüşmanY - FloatOku(LongOku(KO_PTR_CHR) + &HBC))) ^ 0.5) / 4)
End Function
Public Function StringToHex(ByVal StrToHex As String) As String
Dim strTemp As String
Dim strReturn As String
Dim i As Long
For i = 1 To Len(StrToHex)
strTemp = Hex$(Asc(Mid$(StrToHex, i, 1)))
If Len(strTemp) = 1 Then strTemp = "0" & strTemp
strReturn = strReturn & strTemp
Next i
StringToHex = strReturn
End Function
Sub HookRecvPackets()
Dim CreateFileAADDR As Long, WriteFileADDR As Long, CloseHandleADDR As Long
Dim pBytesMSName() As Byte, pBytes() As Byte
Dim pStr As String, pStrKO_RECVFNC As String

CreateFileAADDR = FindDLLFunc("kernel32.dll", "CreateFileA")
WriteFileADDR = FindDLLFunc("kernel32.dll", "WriteFile")
CloseHandleADDR = FindDLLFunc("kernel32.dll", "CloseHandle")

KO_RCVFNC = VirtualAllocEx(KO_HANDLE, 0, 1024, MEM_COMMIT, PAGE_READWRITE)

pBytesMSName = StrConv(MsName, vbFromUnicode)
ByteDizisiYaz KO_RCVFNC + &H400, pBytesMSName, UBound(pBytesMSName) - LBound(pBytesMSName) + 1

pStr = AlignDWORD(CreateFileAADDR)
Hex2Byte pStr, pBytes
ByteDizisiYaz KO_RCVFNC + &H32A, pBytes, UBound(pBytes) - LBound(pBytes) + 1

pStr = AlignDWORD(WriteFileADDR)
Hex2Byte pStr, pBytes
ByteDizisiYaz KO_RCVFNC + &H334, pBytes, UBound(pBytes) - LBound(pBytes) + 1

pStr = AlignDWORD(CloseHandleADDR)
Hex2Byte pStr, pBytes
ByteDizisiYaz KO_RCVFNC + &H33E, pBytes, UBound(pBytes) - LBound(pBytes) + 1

pStr = AlignDWORD(KO_RCVHKB)
Hex2Byte pStr, pBytes
ByteDizisiYaz KO_RCVFNC + &H208, pBytes, UBound(pBytes) - LBound(pBytes) + 1

pStr = AlignDWORD(KO_RECVHK)
Hex2Byte pStr, pBytes
ByteDizisiYaz KO_RCVFNC + &H212, pBytes, UBound(pBytes) - LBound(pBytes) + 1

pStr = AlignDWORD(KO_RCVFNC)
Hex2Byte pStr, pBytes
ByteDizisiYaz KO_RCVFNC + &H21C, pBytes, UBound(pBytes) - LBound(pBytes) + 1

pStr = "52" + "890D" + AlignDWORD(KO_RCVFNC + &H320) + "8905" + AlignDWORD(KO_RCVFNC + &H3B6) + "8B4E04890d" + AlignDWORD(KO_RCVFNC + &H1F4) + "8B56088915" + AlignDWORD(KO_RCVFNC + &H1FE) + "81F9001000007D3E5068800000006A036A006A01680000004 068" + AlignDWORD(KO_RCVFNC + &H400) + "FF15" + AlignDWORD(KO_RCVFNC + &H32A) + "83F8FF741D506A0054FF35" + AlignDWORD(KO_RCVFNC + &H1F4) + "ff35" + AlignDWORD(KO_RCVFNC + &H1FE) + "50ff15" + AlignDWORD(KO_RCVFNC + &H334) + "ff15" + AlignDWORD(KO_RCVFNC + &H33E) + "8b0d" + AlignDWORD(KO_RCVFNC + &H320) + "8b05" + AlignDWORD(KO_RCVFNC + &H3B6) + "5aff25" + AlignDWORD(KO_RCVFNC + &H208)
Hex2Byte pStr, pBytes
ByteDizisiYaz KO_RCVFNC, pBytes, UBound(pBytes) - LBound(pBytes) + 1

pStrKO_RECVFNC = AlignDWORD(KO_RCVFNC)
Hex2Byte pStrKO_RECVFNC, pBytes
ByteDizisiYaz KO_RECVHK, pBytes, UBound(pBytes) - LBound(pBytes) + 1
End Sub
Sub DispatchMailSlot()
Dim MsgCount As Long
Dim rc As Long
Dim MessageBuffer As String
Dim pVal As Long
Dim Hp As Long
Dim maxhp As Long
Dim fullcode
Dim code
Dim sKey
Dim i As Integer
MsgCount = 1
Do While MsgCount <> 0
rc = CheckForMessages(MsgCount)

If CBool(rc) And MsgCount > 0 Then
If ReadMessage(MessageBuffer, MsgCount) Then
code = MessageBuffer
fullcode = Strings.Split(MessageBuffer, "")
On Error Resume Next

Debug.Print Asc(Left(MessageBuffer, 1))
Select Case Asc(Left(MessageBuffer, 1))

Dim deger(1 To 20) As String, iza As Long
Dim dger11 As String

Case WIZ_MOVE
On Error Resume Next
For iza = 1 To 20
deger(iza) = Hex2Val(Mid(MessageBuffer, iza, 1))
dger11 = dger11 & "" & (deger(iza))
Next

Case 35
If UseAutoLoot = 1 Then
pVal = Hex2Val(Mid(MessageBuffer, 4, 4))
sKey = "B" & pVal
OpenBox pVal
End If

Case 36
If UseAutoLoot = 1 Then
pVal = Hex2Val(Mid(MessageBuffer, 2, 4))
LootItem pVal

pVal = Hex2Val(Mid(MessageBuffer, 8, 4))
LootItem pVal

pVal = Hex2Val(Mid(MessageBuffer, 14, 4))
LootItem pVal

pVal = Hex2Val(Mid(MessageBuffer, 20, 4))
LootItem pVal

pVal = Hex2Val(Mid(MessageBuffer, 26, 4))
LootItem pVal

pVal = Hex2Val(Mid(MessageBuffer, 32, 4))
LootItem pVal
End If

End Select
End If
End If
Loop
End Sub
Public Function CheckForMessages(MessageCount As Long)
Dim lBytesRead As Long
Dim lmsgcount As Long
Dim lNextMsgSize As Long
Dim lpBuffer As String
CheckForMessages = False
GetMailslotInfo MSHandle, ByVal 0&, lNextMsgSize, lmsgcount, ByVal 0&
MessageCount = lmsgcount
CheckForMessages = True
End Function

Public Function ReadMessage(MailMessage As String, MessagesLeft As Long)
Dim lBytesRead As Long
Dim lNextMsgSize As Long
Dim lpBuffer As String
ReadMessage = False
Call GetMailslotInfo(MSHandle, ByVal 0&, lNextMsgSize, MessagesLeft, ByVal 0&)
If MessagesLeft > 0 And lNextMsgSize <> MAILSLOT_NO_MESSAGE Then
lBytesRead = 0
lpBuffer = String$(lNextMsgSize, Chr$(0))
Call ReadFile(MSHandle, ByVal lpBuffer, Len(lpBuffer), lBytesRead, ByVal 0&)
If lBytesRead <> 0 Then
MailMessage = Left(lpBuffer, lBytesRead)
ReadMessage = True
Call GetMailslotInfo(MSHandle, ByVal 0&, lNextMsgSize, MessagesLeft, ByVal 0&)
End If
End If
End Function
Function Handle()
GetWindowThreadProcessId FindWindow(vbNullString, KO_ADI), KO_PID
KO_HANDLE = OpenProcess(PROCESS_ALL_ACCESS, False, KO_PID)

If KO_PID <> 0 Then
Else
MsgBox "Programın Çalışabilmesi için oyunda olmanız gerekir."
End If
End Function



Sub OpenBox(pBoxID As Long)
Dim pStr As String
Dim pBytes() As Byte
If pBoxID <> 0 Then
pStr = "24" & AlignDWORD(pBoxID)
Hex2Byte pStr, pBytes
PaketGönder pBytes
LastBoxID = pBoxID
End If
OpenNextBox = False
End Sub

Sub LootItem(pItemID As Long)
Dim pStr As String
Dim pBytes() As Byte
Dim Tarih As Date
If pItemID <> " 0" Then
pStr = "26" & AlignDWORD(LastBoxID) & AlignDWORD(pItemID)
Hex2Byte pStr, pBytes
PaketGönder pBytes
End If
End Sub
Public Function Hex2Val(pStrHex As String) As Long
Dim TmpStr As String
Dim TmpHex As String
Dim i As Long
TmpStr = ""
For i = Len(pStrHex) To 1 Step -1
TmpHex = Hex(Asc(Mid(pStrHex, i, 1)))
If Len(TmpHex) = 1 Then TmpHex = "0" & TmpHex
TmpStr = TmpStr & TmpHex
Next
Hex2Val = CLng("&H" & TmpStr)
End Function
Function FindDLLFunc(pDLLName As String, pFuncName As String) As Long
Dim LoadAddr As Long
Dim ProcAddr As Long
Dim offset As Long
Dim RemoteAddr As Long

LoadAddr = LoadLibrary(pDLLName)
If LoadAddr = 0 Then End
ProcAddr = GetProcAddress(LoadAddr, pFuncName)
offset = ProcAddr - LoadAddr
FreeLibrary LoadAddr

RemoteAddr = ModülHandleBul(pDLLName)
Do While RemoteAddr = 0
RemoteAddr = ModülHandleBul(pDLLName)
DoEvents
Loop
FindDLLFunc = RemoteAddr + offset
End Function
Public Sub HookBul()
Dim hooks As Long
hooks = KO_PTR_DLG + &H84

Select Case ByteOku(hooks)
Case 8
KO_RCVHKB = &H7F4950
KO_RECVHK = &H9BEEDC
HookRecvPackets
Case 9
KO_RCVHKB = &H7F7160
KO_RECVHK = &H9BEEE0
HookRecvPackets
Case 10
KO_RCVHKB = &H7F98A0
KO_RECVHK = &H9BEEE4

HookRecvPackets
Case Else
KO_RCVHKB = &H7F3EC0
KO_RECVHK = &H9BCEDC
HookRecvPackets
End Select
End Sub

Function OffsetleriYükle()
KO_ADI = Form1.koisim.Text
' Pointerler
KO_PTR_CHR = &HC1EA90
KO_PTR_DLG = &HC1ED84
KO_PTR_PKT = &HC1ED50
KO_SND_FNC = &H475040
KO_SND_PACKET = KO_PTR_PKT + &HC1 ' PaketGönder Pointeri
KO_OFF_PARTY = &HC1ED70
KO_KEY_PTR = &HC1ED4C
KO_SENDPTR = &HC141E8
' Offsetler
KO_OFF_SWIFT = 1670
KO_OFF_MX = &HD44 ' Mause X Kordinat Pointeri
KO_OFF_MY = &HD4C ' Mause Y Kordinat Pointeri
KO_OFF_MZ = &HD48 ' Mause Z Kordinat Pointeri
KO_OFF_CLASS = &H5D8
KO_OFF_ID = &H5B3
KO_OFF_ID2 = &H5B4
KO_OFF_MOB = &H580
KO_OFF_HP = &H5E4
KO_OFF_MAXHP = &H5E0
KO_OFF_MP = &H9A8
KO_OFF_MAXMP = &H9A4
KO_OFF_Y = &HBC
KO_OFF_X = &HB4
KO_OFF_Z = &HB8
KO_OFF_Go1 = &HD38 ' Kordinata Git KO_OFF_MOVTYPE
KO_OFF_GoX = &HD44 ' Kordinata Git X
KO_OFF_GoY = &HD4C ' Kordinata Git Y
KO_OFF_Go2 = &H394 ' Kordinata Git KO_OFF_MVCHRTYP
KO_OFF_EXP = 2496
KO_OFF_MAXEXP = 2488
KO_OFF_LVL = &H5DC
KO_OFF_PARA = &H9B0
KO_OFF_ZONE = 2628
End Function
Public Sub SndFix()
LongYaz &HC141E8, &H73233F17


End SubEnd IfLoop



Buton İçine ;

OffsetleriYükle
If AttachKO = False Then
Exit Sub
End If
SndFix
KlavyeYükle
KO_ADR_CHR = LongOku(KO_PTR_CHR)
KO_ADR_dlg = LongOku(KO_PTR_DLG)
MSHandle = 0
MsName = "\\.\\mailslot\\BenjaminLines" & Hex(GetTickCount)
MSHandle = EstablishMailSlot(MsName)
If MSHandle = 0 Then End
Handle
HookBul



Command1.Enabled = False
Text1.Enabled = False



Bir Teşekkür Yeter .

___[ RAZOR 1965 adlı kişinin İmzası]_______________

abi türkçe bu sanırsam bende çalışcakmı bu kodlar acaba

+++++++++++++++++++

Denemeye Değer

___[ RAZOR 1965 adlı kişinin İmzası]_______________

Azda deil Baksana

ne kadar gereksiz kodlar yazmışsın

Emeğe Saygı

___[ RAZOR 1965 adlı kişinin İmzası]_______________

bi scoreden almıs oda eme saygı

Bi Scden Değil Kendi Scdem Aldım...

___[ RAZOR 1965 adlı kişinin İmzası]_______________

Hani Knight Online Yazıo Yanındada Yükle yazıo ya Onun Kodunu Yazarmısın Rica etsem..??

___[ ce'M oKaN adlı kişinin İmzası]_______________
[b] Teşekkürüde Esirgeme Artık..


GALATASARAY...

Dağda üç Beş Koyun Sürüsü
Tutturmuş Bir Kürdistan Türküsü
Eline Almış Bayrak Diye Bir Masa örtüsü
Satsan Beş Para Etmez Ne Dirisi Ne De ölüsü
Soyu Soysuz Olan Sensin Toprak Senin Neyine
İte Itlik Yapıp Kafa Tutma Beyine
Anlasa Dediğimi Sokaktaki Köpek Ağlar Haline
Duy Ulan Soysuz Ne Mutlu Türk'üm Diyene