Duyuruyu Kapat

Linkleri Görmek İçin Reklamları TIKLAYIN

Linkleri İndirmek İçin Reklama TIKLAYIN

Vb6 Ko Oyuna Baglanma Oto Kutu ( Peri ) Source Ve Modul

'Kurallara Aykırı Konular' forumunda ForumDC.ORG Development tarafından 11 Haziran 2018 tarihinde açılan konu

  1. Merhaba Arkadaşlar Kendimce Ugraşlarım ve Araştırmalarım sonucu Oyuna Baglanmayı VS Oto Kutu ( Peri ) Yapmayı Başardım Bir Kaç Şey Daha Var Fakat Onları Daha Sonra Vericem Amacım Şu Herşeyi Hali Hazırda Almamanız Çünkü Böyle Oldumu Kopyala Yapıştır İle Bile Millet Kendini Coder Zannediyor
    Ben Gibi Şaka Bir Yana Bir Zamanlar Çalarak Yaptıgım Ç almaktan Kastım Başkalarının Paylaşımlarını Editleyim Veya Kopyala Yapıştır Yaparak Farklı Bir Form Üzerinden Kullanıp Sahte Coder Oldum Bu Utanç Verici Ama Ders Alınması Gereken Bir Konu
    Çünkü Forumun İlk Girişinde Bir Söz İle Karşılaşıyorsunuz


    "Çok fazla hedef koyarsan, en önemlisini ıskalarsın."

    Ben Bu Şekilde Kafası Karışık Bir Şekilde Yaptım Ve Hata Oldugunu Anlayıp Biraz Araştırma İle Bilgi Eksikligi Olsa Bile
    Başarabildim Şimdi Bu Başarımı Sizlerle Paylaşmak İstedim
    Şuanda Çalışan Source Ve Modüllerdir Arkadaşlar

    Hepinize Başarılar


    Kod:
    Private Sub Command1_Click()
    OffsetleriYükle
    AttachKO
    Form1.Caption = CharName
    End Sub
    Modül
    Kod:
    Public Enum enSW
    SW_HIDE = 0
    SW_NORMAL = 1
    SW_MAXIMIZE = 3
    SW_MINIMIZE = 6
    End Enum

    Public Type PROCESS_INFORMATION
    hProcess As Long
    hThread As Long
    dwProcessId As Long
    dwThreadId As Long
    End Type

    Public Type STARTUPINFO
    cb As Long
    lpReserved As String
    lpDesktop As String
    lpTitle As String
    dwX As Long
    dwY As Long
    dwXSize As Long
    dwYSize As Long
    dwXCountChars As Long
    dwYCountChars As Long
    dwFillAttribute As Long
    dwFlags As Long
    wShowWindow As Integer
    cbReserved2 As Integer
    lpReserved2 As Byte
    hStdInput As Long
    hStdOutput As Long
    hStdError As Long
    End Type

    Public Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Long
    End Type

    Public Enum enPriority_Class
    NORMAL_PRIORITY_CLASS = &H20
    IDLE_PRIORITY_CLASS = &H40
    HIGH_PRIORITY_CLASS = &H80
    End Enum
    Public 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
    Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
    Public Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, lpProcessAttributes As Any, lpThreadAttributes As Any, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) 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 WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
    Public Declare Function GetCurrentProcessId Lib "kernel32" () 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 VirtualFreeEx Lib "kernel32" (ByVal hProcess As Long, lpAddress As Any, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long
    Public 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
    Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Public Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
    Public Declare Function SetActiveWindow Lib "User32.dll" (ByVal hWnd As Long) As Long
    Public Declare Function GetMailslotInfo Lib "kernel32" (ByVal hMailSlot As Long, lpMaxMessageSize As Long, lpNextSize As Long, lpMessageCount As Long, lpReadTimeout As Long) As Long
    Public Declare Function SetForegroundWindow Lib "User32.dll" (ByVal hWnd As Long) As Long
    Public Declare Function CreateMailslot Lib "kernel32" Alias "CreateMailslotA" (ByVal lpName As String, ByVal nMaxMessageSize As Long, ByVal lReadTimeout As Long, lpSecurityAttributes As Any) As Long
    Public Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Long) As Long
    Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
    Public Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
    Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

    Public Const MEM_RESERVE As Long = &H2000&
    Public Const STARTF_USESHOWWINDOW = &H1
    Public Const PROCESS_ALL_ACCESS = &H1F0FFF
    Public Const THREAD_ALL_ACCESS = &H1F0FFF
    Public Const MEM_COMMIT = &H1000
    Public Const MEM_RELEASE = &H8000&
    Public Const PAGE_READWRITE = &H4&
    Public Const INFINITE = &HFFFF

    Dim KutuAç, Kutununİçi, kutuiçi1oku, kutuiçi2oku, kutuiçi3oku, kutuiçi4oku, kutuiçi5oku, kutuiçi6oku, kutuid, BoxID As Long
    Dim kutu1id As Long
    Dim kutu2id As Long
    Dim kutu3id As Long

    Public BytesAddr As Long
    Public FuncPtr As Long
    Public ByteMob_Base As Long
    Public RecvHandle As Long
    Public KO_HANDLE As Long
    Public KO_WindowHandle As Long
    Public KO_ADR_CHR As Long
    Public KO_ADR_DLG As Long
    Public KO_PID As Long
    Public packetbytes As Long
    Public codebytes As Long
    Public zMobName As String, zMobZ As Long, zMobID As String
    Public ItemLevel As Long
    Public BankadakiItemler(191) As String
    Public ItemIntID(41) As String
    Public Süre As Long
    Public ID(14) As String
    ' 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_SEND_PTR As Long
    Public KO_SND_PACKET As Long

    'Clientten Seçmeler


    Public KO_PERI_TAK As Long

    ' Offsetler
    Public KO_OFF_SWIFT As Long
    Public KO_OFF_CLASS As Long
    Public KO_OFF_ID 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_MX As Long
    Public KO_OFF_MY As Long
    Public KO_OFF_MZ As Long
    Public KO_OFF_Go1 As Long
    Public KO_OFF_GoX As Long
    Public KO_OFF_GoY As Long
    Public KO_OFF_Go2 As Long
    Public KO_OFF_ZONE As Long
    Public KO_OFF_NATION As Long
    Public KO_OFF_WH As Long
    Public KO_OFF_CHAT As Long
    Public KO_RECVHK As Long
    Public KO_RCVHKB As Long
    Public KO_RCVHKB1 As Long
    Public KO_RCVHKB2 As Long
    Public KO_RCVHKB3 As Long
    Public KO_RECVHK1 As Long
    Public KO_RECVHK2 As Long
    Public KO_RECVHK3 As Long
    Public Const KO_OTO_LOGIN_PTR As Long = &HDD1FF0
    Public Const KO_OTO_LOGIN_ADR1 As Long = &H4D7480
    Public Const KO_OTO_LOGIN_ADR2 As Long = &H4D0950
    Public Const KO_OTO_LOGIN_ADR3 As Long = &H4D0410
    Public Const KO_OTO_LOGIN_ADR4 As Long = &H4D3700

    Public Const KO_BYPASS_ADR1 As Long = &H9A0F91
    Public Const KO_BYPASS_ADR2 As Long = &H4BAF8C
    Public Const KO_BYPASS_ADR3 As Long = &H4BAFA2
    Public Const KO_BYPASS_ADR4 As Long = &H4BAFB1
    Public Function AttachKO()
    KO_ADI = Form1.Text1.Text
    If Form1.Text1.Text <> vbNullString And FindWindow(vbNullString, Form1.Text1) <> 0 Then
    GetWindowThreadProcessId FindWindow(vbNullString, KO_ADI), KO_PID
    KO_HANDLE = OpenProcess(THREAD_ALL_ACCESS, False, KO_PID)
    MSName = "\\.\mailslot\ByhOxic" & Hex(GetTickCount)
    MSHandle = EstablishMailSlot(MSName)
    If KO_HANDLE = 0 Then MsgBox "handle 0": Exit Function
    KO_ADR_CHR = LongOku(KO_PTR_CHR)
    KO_ADR_DLG = LongOku(KO_PTR_DLG)
    OtoSND
    Form1.Command1.Enabled = False
    End If
    End Function
    Public Sub OtoSND()
    Dim EAXval As Byte
    Select Case ByteOku(KO_SEND_PTR)
    Case &H16: EAXval = 0
    Case &H17: EAXval = 1
    Case &H14: EAXval = 2
    Case &H15: EAXval = 3
    Case &H12: EAXval = 4
    Case &H13: EAXval = 5
    Case &H10: EAXval = 6
    Case &H1E: EAXval = 8
    Case &H11: EAXval = 7
    Case &H1F: EAXval = 9
    End Select
    KO_SND_FNC = LongOku(LongOku(KO_PTR_PKT) + (EAXval * 4) + &H4008C)
    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
    Function OffsetleriYükle()
    ' Pointerler
    KO_SEND_PTR = &H4997B0
    KO_PTR_CHR = &HE41CB0
    KO_PTR_DLG = &HE28BA0
    KO_PTR_PKT = &HE28B6C
    KO_SND_FNC = &H4997B0
    KO_SND_PACKET = KO_PTR_PKT + &HC5
    KO_SND_PACKET2 = KO_PTR_PKT + &HC5

    KO_PERI_TAK = &H57A630
    KO_OFF_CHAT = &HE2AB60
    KO_OFF_NAME = &H688
    KO_OFF_ID = &H680
    KO_OFF_MOB = &H644
    KO_OFF_WH = &H6C0
    KO_OFF_MAXHP = &H6B8
    KO_OFF_HP = &H6BC
    KO_OFF_MAXMP = &HB5C
    KO_OFF_MP = &HB60
    KO_OFF_EXP = &HB78
    KO_OFF_MAXEXP = &HB70
    KO_OFF_NATION = &H6A8
    KO_OFF_CLASS = &H6B0
    KO_OFF_LVL = &H6B4
    KO_OFF_ZONE = &HC00
    KO_OFF_X = &HD8
    KO_OFF_Y = &HE0
    KO_OFF_Z = &HDC
    KO_OFF_Go1 = &HF90
    KO_OFF_GoX = &HF9C
    KO_OFF_GoY = &HFA4
    KO_OFF_Go2 = &H3F0
    KO_OFF_MX = KO_OFF_GoX
    KO_OFF_MY = KO_OFF_GoY
    KO_OFF_MZ = &HFA0
    End Function
    Public Function ConvHEX2ByteArray(pStr As String, pByte() As Byte)
    On Error Resume Next
    Dim i As Long
    Dim J As Long
    ReDim pByte(1 To Len(pStr) / 2)
    J = LBound(pByte) - 1
    For i = 1 To Len(pStr) Step 2
    J = J + 1
    pByte(J) = CByte("&H" & Mid(pStr, i, 2))
    Next
    End Function
    Public Function InjectPatch(addr As Long, pStr As String)
    Dim pBytes() As Byte
    ConvHEX2ByteArray pStr, pBytes
    WriteProcessMem KO_HANDLE, addr, pBytes(LBound(pBytes)), UBound(pBytes) - LBound(pBytes) + 1, 0&
    End Function


    Public Function ReadLong(addr As Long) As Long 'read a 4 byte value
    Dim Value As Long
    ReadProcessMem KO_HANDLE, addr, Value, 4, 0&
    ReadLong = Value
    End Function
    Public Function ReadFloat(addr As Long) As Long 'read a float value
    On Error Resume Next
    Dim Value As Single
    ReadProcessMem KO_HANDLE, addr, Value, 4, 0&
    ReadFloat = Value
    End Function
    Public Function WriteFloat(addr As Long, Val As Single) 'write a float value
    WriteProcessMem KO_HANDLE, addr, Val, 4, 0&
    End Function
    Public Function WriteLong(addr As Long, Val As Long) ' write a 4 byte value
    WriteProcessMem KO_HANDLE, addr, Val, 4, 0&
    End Function
    Public Function WriteByte(addr As Long, Val As Byte) ' write a 1 byte value
    WriteProcessMem KO_HANDLE, addr, Val, 1, 0&
    End Function
    Public Function WriteByteArray(pAddy As Long, pmem() As Byte, pSize As Long)
    WriteProcessMem KO_HANDLE, pAddy, pmem(LBound(pmem)), pSize, 0&
    End Function
    Function KarakterX()
    KarakterX = ReadFloat(KO_ADR_CHR + KO_OFF_X)
    End Function
    Function KarakterY()
    KarakterY = ReadFloat(KO_ADR_CHR + KO_OFF_Y)
    End Function
    Function KarakterZ()
    KarakterZ = ReadFloat(KO_ADR_CHR + KO_OFF_Z)
    End Function

    Function CharX()
    CharX = ReadFloat(KO_ADR_CHR + KO_OFF_X)
    End Function
    Function CharY()
    CharY = ReadFloat(KO_ADR_CHR + KO_OFF_Y)
    End Function
    Function CharZ()
    CharZ = ReadFloat(KO_ADR_CHR + KO_OFF_Z)
    End Function
    Function MobX() As Long
    MobX = ReadFloat(ReadLong(ReadLong(KO_PTR_DLG) + &H404) + &H7C)
    End Function

    Function MobY() As Long
    MobY = ReadFloat(ReadLong(ReadLong(KO_PTR_DLG) + &H404) + &H84)
    End Function

    Function MobZ() As Long
    MobZ = ReadFloat(ReadLong(ReadLong(KO_PTR_DLG) + &H404) + &H80)
    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 Sub FindHook1(MailSlotName As String)
    Dim KO_RECVHK As Long, KO_RCVHKB As Long
    KO_RECVHK = LongOku(LongOku(KO_PTR_DLG - &H14)) + &H8
    KO_RCVHKB = LongOku(KO_RECVHK)
    Debug.Print Hex(KO_RECVHK) & "//" & Hex(KO_RCVHKB)
    recvHook MailSlotName, KO_RCVHKB, KO_RECVHK
    End Sub
    Sub recvHook(MailSlotName As String, RecvFunction As Long, RecvBase As Long)
    Dim KO_MSLOT As Long, KO_RCVHK As Long, pHook As String, ph() As Byte
    KO_MSLOT = writeMailSlot(MailSlotName)
    If KO_MSLOT <= 0 Then Exit Sub: MsgBox "memory could not be opened!", vbCritical
    KO_RCVHK = VirtualAllocEx(KO_HANDLE, 0, 1024, MEM_COMMIT, PAGE_READWRITE)
    If KO_RCVHK <= 0 Then Exit Sub: MsgBox "memory could not be opened!", vbCritical

    pHook = "558BEC83C4F8538B450883C0048B108955FC8B4D0883C1088B018945F8FF75FCFF75F8E8" & AlignDWORD(getCallDiff(KO_RCVHK + &H23, KO_MSLOT)) & "83C4088B0D" & AlignDWORD(KO_PTR_DLG - &H14) & "FF750CFF7508B8" & AlignDWORD(RecvFunction) & "FFD05B59595DC20800"
    Hex2Byte pHook, ph
    ByteDizisiYaz KO_RCVHK, ph, UBound(ph) - LBound(ph) + 1

    pHook = AlignDWORD(KO_RCVHK)
    Hex2Byte pHook, ph
    ByteDizisiYaz RecvBase, ph, UBound(ph) - LBound(ph) + 1
    End Sub
    Function writeMailSlot(MailSlotName As String) As Long
    Dim KO_MSLOT As Long, pHook As String, p() As Byte, ph() As Byte, CF As Long, WF As Long, CH As Long
    KO_MSLOT = VirtualAllocEx(KO_HANDLE, 0, 1024, MEM_COMMIT, PAGE_READWRITE)
    If KO_MSLOT <= 0 Then Exit Function: MsgBox "memory could not be opened!", vbCritical
    CF = GetProcAddress(GetModuleHandle("kernel32.dll"), "CreateFileA")
    WF = GetProcAddress(GetModuleHandle("kernel32.dll"), "WriteFile")
    CH = GetProcAddress(GetModuleHandle("kernel32.dll"), "CloseHandle")
    Debug.Print Hex(KO_MSLOT)
    Hex2Byte StringToHex(MailSlotName), p
    ByteDizisiYaz KO_MSLOT + &H400, p, UBound(p) - LBound(p) + 1
    pHook = "558BEC83C4F433C08945FC33D28955F86A0068800000006A036A006A01680000004068" & AlignDWORD(KO_MSLOT + &H400) & "E8" & AlignDWORD(getCallDiff(KO_MSLOT + &H27, CF)) & "8945F86A008D4DFC51FF750CFF7508FF75F8E8" & AlignDWORD(getCallDiff(KO_MSLOT + &H3E, WF)) & "8945F4FF75F8E8" & AlignDWORD(getCallDiff(KO_MSLOT + &H49, CH)) & "8BE55DC3" '&H49
    Hex2Byte pHook, ph
    ByteDizisiYaz KO_MSLOT, ph, UBound(ph) - LBound(ph) + 1
    writeMailSlot = KO_MSLOT
    End Function
    Public Function getCallDiff(Source As Long, Destination As Long) As Long
    Dim Diff As Long
    Diff = 0
    If Source > Destination Then
    Diff = Source - Destination
    If Diff > 0 Then getCallDiff = &HFFFFFFFB - Diff
    Else
    getCallDiff = Destination - Source - 5
    End If
    End Function
    Function Paket(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 YürüXY(X As Single, Y As Single) As Boolean
    If CInt(CharX) = CInt(X) And CInt(CharY) = CInt(Y) Then YürüXY = True: Exit Function
    WriteLong KO_ADR_CHR + KO_OFF_Go2, 2
    WriteFloat KO_ADR_CHR + KO_OFF_MX, X
    WriteFloat KO_ADR_CHR + KO_OFF_MY, Y
    WriteLong KO_ADR_CHR + KO_OFF_Go1, 1
    YürüXY = False: Exit Function
    End Function
    Public Function SpeedHack(XKor As Integer, YKor As Integer) As Boolean
    If CInt(CharX) = XKor And CInt(CharY) = YKor Then SpeedHack = True: Exit Function
    'SeksClub
    Dim FarkX As Long, FarkY As Long
    Dim ZıplaX As Integer, ZıplaY As Integer, i As Integer
    FarkX = XKor - CharX
    FarkY = YKor - CharY
    ZıplaX = 2
    ZıplaY = 2
    If CharX = XKor And CharY = YKor Then
    Exit Function
    End If
    For i = 1 To 5
    If FarkX = -1 * i Or FarkX = i Then
    ZıplaX = 1
    ElseIf FarkY = -1 * i Or FarkY = i Then
    ZıplaY = 1
    End If
    Next i
    Dim oAnkiX As Long, oAnkiY As Long
    oAnkiX = CharX
    oAnkiY = CharY
    If FarkX <> 0 Or FarkY <> 0 Then
    If FarkX < 0 Then
    WriteFloat ReadLong(KO_PTR_CHR) + KO_OFF_X, CharX - ZıplaX
    ElseIf FarkX > 0 Then
    WriteFloat ReadLong(KO_PTR_CHR) + KO_OFF_X, CharX + ZıplaX
    End If
    If FarkY < 0 Then
    WriteFloat ReadLong(KO_PTR_CHR) + KO_OFF_Y, CharY - ZıplaY
    ElseIf FarkY > 0 Then
    WriteFloat ReadLong(KO_PTR_CHR) + KO_OFF_Y, CharY + ZıplaY
    End If
    Dim RetX As Long, RetY As Long
    RetX = CharX
    RetY = CharY
    Paket "06" & AlignDWORD(CInt(oAnkiX) * 10, 4) & AlignDWORD(CInt(oAnkiY) * 10, 4) & AlignDWORD(CInt(CharZ) * 10, 4) & "2D0003" & AlignDWORD(CInt(RetX) * 10, 4) & AlignDWORD(CInt(RetY) * 10, 4) & AlignDWORD(CInt(CharZ) * 10, 4)
    End If
    SpeedHack = False
    End Function
    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 ReadString(ByVal pAddy As Long, ByVal LSize As Long) As String
    On Error Resume Next
    Dim Value As Byte
    Dim tex() As Byte
    On Error Resume Next
    If LSize = 0 Then
    Exit Function
    Else
    ReDim tex(1 To LSize)
    ReadProcessMem KO_HANDLE, pAddy, tex(1), LSize, 0&
    ReadString = StrConv(tex, vbUnicode)
    End If
    End Function
    Function AlignDWORD(Dec As Long, Optional Length As Long = 8) As String

    Dim DTH As String
    DTH = Hex(Dec)
    Select Case Len(Hex(Dec))
    Case 1
    AlignDWORD = Strings.Left("0" & DTH & "000000", Length)
    Case 2
    AlignDWORD = Strings.Left(DTH & "000000", Length)
    Case 3
    AlignDWORD = Strings.Left(Strings.Mid(DTH, 2, 2) & "0" & Strings.Left(DTH, 1) & "0000", Length)
    Case 4
    AlignDWORD = Strings.Left(Strings.Mid(DTH, 3, 2) & Strings.Left(DTH, 2) & "0000", Length)
    Case 5
    AlignDWORD = Strings.Left(Strings.Mid(DTH, 4, 2) & Strings.Mid(DTH, 2, 2) & "0" & Strings.Left(DTH, 1), Length) & "00"
    Case 6
    AlignDWORD = Strings.Left(Strings.Mid(DTH, 5, 2) & Strings.Mid(DTH, 3, 2) & Strings.Left(DTH, 2) & "00", Length)
    Case 7
    AlignDWORD = Strings.Left(Strings.Mid(DTH, 6, 2) & Strings.Mid(DTH, 4, 2) & Strings.Mid(DTH, 2, 2) & "0" & Strings.Left(DTH, 1), Length)
    Case 8
    AlignDWORD = Strings.Left(Strings.Mid(DTH, 7, 2) & Strings.Mid(DTH, 5, 2) & Strings.Mid(DTH, 3, 2) & Strings.Left(DTH, 2), Length)
    End Select
    End Function
    Function CharName()
    If ReadLong(ReadLong(KO_PTR_CHR) + &H698) > 15 Then
    CharName = ReadString(ReadLong(ReadLong(KO_PTR_CHR) + &H688), ReadLong(ReadLong(KO_PTR_CHR) + &H698))
    Else
    CharName = ReadString(ReadLong(KO_PTR_CHR) + &H688, ReadLong(ReadLong(KO_PTR_CHR) + &H698))
    End If
    End Function
    Function CharDC()
    CharDC = ReadLong(ReadLong(KO_PTR_PKT) + &H40064)
    End Function
    Public Function oyunukapa()
    On Error Resume Next
    Ret& = TerminateProcess(KO_HANDLE, 0&)
    End Function
    Function CharHP()
    CharHP = ReadLong(KO_ADR_CHR + KO_OFF_HP)
    End Function
    Function CharMaxHP()
    CharMaxHP = ReadLong(KO_ADR_CHR + KO_OFF_MAXHP)
    End Function
    Function CharMP()
    CharMP = ReadLong(KO_ADR_CHR + KO_OFF_MP)
    End Function
    Function CharMaxMP()
    CharMaxMP = ReadLong(KO_ADR_CHR + KO_OFF_MAXMP)
    End Function
    Function MobID()
    MobID = Strings.Mid(AlignDWORD(ReadLong(ReadLong(KO_PTR_CHR) + KO_OFF_MOB)), 1, 4)
    End Function
    Function MobLID()
    MobLID = ReadLong(KO_ADR_CHR + KO_OFF_MOB)
    End Function
    Public Function Pause(ByVal delay As Single)
    delay = Timer + delay
    Do
    DoEvents
    Sleep 1
    Loop While delay > Timer
    End Function
    Public Function HexItemID(ByVal Slot As Integer) As String
    Dim Offset, X, offset3, offset4 As Long
    Dim Base, Sonuc As Long
    Offset = ReadLong(KO_ADR_DLG + &H1B4)
    Offset = ReadLong(Offset + (&H20C + (4 * Slot)))

    Sonuc = ReadLong(ReadLong(Offset + &H68)) + ReadLong(ReadLong(Offset + &H6C))
    HexItemID = Strings.Mid(AlignDWORD(Sonuc), 1, 8)
    End Function
    Public Function LongItemID(ByVal Slot As Integer) As Long
    Dim Offset, X, offset3, offset4 As Long
    Dim Base, Sonuc As Long
    Offset = ReadLong(KO_ADR_DLG + &H1B4)
    Offset = ReadLong(Offset + (&H20C + (4 * Slot)))

    LongItemID = ReadLong(ReadLong(Offset + &H68)) + ReadLong(ReadLong(Offset + &H6C))

    End Function
    Function GetItemCountInInv(ByVal Slot As Integer) As Long
    Dim Offset, Offset2 As Long
    Offset = ReadLong(KO_ADR_DLG + &H1B4)
    Offset = ReadLong(Offset + (&H20C + (4 * Slot)))
    Offset2 = ReadLong(Offset + &H70)
    GetItemCountInInv = Offset2
    End Function
    Function GetItemCount() As Integer
    Dim ItemIDAdr As Long
    Dim ItemCount As Integer
    ItemCount = 0
    Dim n As Integer
    For n = 14 To 41
    ItemIDAdr = ReadLong(KO_ADR_DLG + &H1B4)
    ItemIDAdr = ReadLong(ItemIDAdr + (&H20C + (4 * (n))))
    ItemIDAdr = ReadLong(ItemIDAdr + &H68)
    ItemIDAdr = ReadLong(ItemIDAdr)
    If ItemIDAdr > 0 Then
    ItemCount = ItemCount + 1
    End If
    Next
    GetItemCount = ItemCount
    End Function
    Function SCKontrol() As Boolean
    If GetItemCountInInv(41) <= 26 Then
    SCKontrol = False
    Else
    SCKontrol = True
    End If
    End Function
    Function KarakterID()
    KarakterID = Strings.Mid(AlignDWORD(ReadLong(ReadLong(KO_PTR_CHR) + KO_OFF_ID)), 1, 4)
    End Function
    Function SınıfBul() As Long
    SınıfBul = ReadLong(ReadLong(KO_PTR_CHR) + KO_OFF_CLASS)
    End Function
    Function JobBul() As String
    If SınıfBul = 201 Or SınıfBul = 205 Or SınıfBul = 206 Or SınıfBul = 101 Or SınıfBul = 105 Or SınıfBul = 106 Then
    JobBul = "Warrior"
    End If
    If SınıfBul = 202 Or SınıfBul = 207 Or SınıfBul = 208 Or SınıfBul = 102 Or SınıfBul = 107 Or SınıfBul = 108 Then
    JobBul = "Rogue"
    End If
    If SınıfBul = 203 Or SınıfBul = 209 Or SınıfBul = 210 Or SınıfBul = 103 Or SınıfBul = 109 Or SınıfBul = 110 Then
    JobBul = "Mage"
    End If
    If SınıfBul = 204 Or SınıfBul = 211 Or SınıfBul = 212 Or SınıfBul = 104 Or SınıfBul = 111 Or SınıfBul = 112 Then
    JobBul = "Priest"
    End If
    End Function
    Function DüşmanID()
    DüşmanID = Strings.Mid(AlignDWORD(ReadLong(ReadLong(KO_PTR_CHR) + KO_OFF_MOB)), 1, 4)
    End Function
    Function FormatHex(strHex As String, inLength As Integer)
    On Error Resume Next
    Dim newHex As String
    Dim ZeroSpaces As Integer
    ZeroSpaces = inLength - Len(strHex) '1
    newHex = String(ZeroSpaces, "0") + strHex
    Select Case Len(newHex)
    Case 2
    newHex = Left(newHex, 2)
    Case 4
    newHex = Right(newHex, 2) & Left(newHex, 2)
    Case 6
    newHex = Right(newHex, 2) & Mid(newHex, 3, 2) & Left(newHex, 2)
    Case 8
    newHex = Right(newHex, 2) & Mid(newHex, 5, 2) & Mid(newHex, 3, 2) & Left(newHex, 2)
    Case Else
    End Select
    FormatHex = newHex
    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
    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 MobUzaklıK() As Long
    On Error Resume Next
    If MobID = "FFFF" Then MobUzaklıK = 255: Exit Function
    MobUzaklıK = Sqr((MobX - KarakterX) ^ 2 + (MobY - KarakterY) ^ 2)
    End Function
    Function MerkezeUzaklık() As Long
    On Error Resume Next
    If MobID = "FFFF" Then MerkezeUzaklık = 255: Exit Function
    MerkezeUzaklık = Sqr((MobX - Label1.Caption) ^ 2 + (MobY - Label2.Caption) ^ 2)
    End Function
    Public Function StringToHex(ByVal StrToHex As String) As String
    Dim strTemp, strReturn As String, 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
    Public Sub PartyAt(ad As String)
    Dim a As String
    a = Strings.Mid$(AlignDWORD(Len(ad)), 1, 2)
    Paket "2f03" + a + "00" + StringToHex(ad)
    Paket "2f01" + a + "00" + StringToHex(ad)
    End Sub
    Function ReadByte(pAddy As Long) As Byte
    Dim Value As Byte
    ReadProcessMem KO_HANDLE, pAddy, Value, 1, 0&
    ReadByte = Value
    End Function
    Public Function LongOku(addr As Long) As Long
    Dim Value As Long
    ReadProcessMem KO_HANDLE, addr, Value, 4, 0&
    LongOku = Value
    End Function
    Public Function LongYaz(addr As Long, Val As Long)
    WriteProcessMem KO_HANDLE, addr, Val, 4, 0&
    End Function
    Public Function ByteYaz(addr As Long, pval As Byte)
    Dim pbw As Long
    WriteProcessMem KO_HANDLE, addr, pval, 1, pbw
    End Function
    Public Function FloatOku(addr As Long) As Long
    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)
    WriteProcessMem KO_HANDLE, addr, Val, 4, 0&
    End Function
    Public Sub HookBul()
    Dim HookIndex As Integer, TmpAddr As Long
    TmpAddr = ReadLong(ReadLong(KO_PTR_DLG)) + &H8
    KO_RECVHK = TmpAddr + (HookIndex * 4)
    KO_RCVHKB = ReadLong(KO_RECVHK)
    End Sub
    Function ExecuteRemoteCode(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
    ExecuteRemoteCode = 0
    If FuncPtr = 0 Then
    FuncPtr = VirtualAllocEx(KO_HANDLE, 0, 1024, MEM_COMMIT, PAGE_READWRITE)
    End If
    If FuncPtr <> 0 Then
    WriteByteArray FuncPtr, pCode, UBound(pCode) - LBound(pCode) + 1
    hThread = CreateRemoteThread(ByVal KO_HANDLE, SE, 0, ByVal FuncPtr, 0&, 0&, ThreadID)
    If hThread Then
    WaitForSingleObject hThread, INFINITE
    ExecuteRemoteCode = ThreadID
    End If
    End If
    CloseHandle hThread
    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
    Private Function CheckForMessages(Handle As Long, MessageCount As Long)
    Dim lMsgCount As Long, lNextMsgSize As Long
    CheckForMessages = False
    GetMailslotInfo Handle, ByVal 0&, lNextMsgSize, lMsgCount, ByVal 0&
    MessageCount = lMsgCount
    CheckForMessages = True
    End Function
    Private Function ReadMessage(Handle As Long, MailMessage As String, MessagesLeft As Long)
    Dim lBytesRead As Long, lNextMsgSize As Long, lpBuffer As String
    ReadMessage = False
    Call GetMailslotInfo(Handle, ByVal 0&, lNextMsgSize, MessagesLeft, ByVal 0&)
    If MessagesLeft > 0 And lNextMsgSize <> MAILSLOT_NO_MESSAGE Then
    lBytesRead = 0
    lpBuffer = String$(lNextMsgSize, Chr$(0))
    Call ReadFile(Handle, ByVal lpBuffer, Len(lpBuffer), lBytesRead, ByVal 0&)
    If lBytesRead <> 0 Then
    MailMessage = Left(lpBuffer, lBytesRead)
    ReadMessage = True
    Call GetMailslotInfo(Handle, ByVal 0&, lNextMsgSize, MessagesLeft, ByVal 0&)
    End If
    End If
    End Function
    Sub DispatchMailSlot(Handle As Long)
    Dim MsgCount As Long, rc As Long, MessageBuffer As String, code, PacketType As String
    Dim BoxID2, BoxID, ItemID1, ItemID2, ItemID3, ItemID4, RecAl1, RecAl2, RecAl4, RecAl3 As Long
    MsgCount = 1
    Do While MsgCount <> 0
    rc = CheckForMessages(Handle, MsgCount)
    If CBool(rc) And MsgCount > 0 Then
    If ReadMessage(Handle, MessageBuffer, MsgCount) Then
    code = MessageBuffer
    On Error Resume Next
    Select Case Asc(Left(MessageBuffer, 1))
    Case Else
    End Select
    End If
    End If
    Loop
    End Sub

    Function periaç()
    Dim pCode() As Byte
    ConvHEX2ByteArray ("608B0D" + AlignDWORD(KO_PTR_CHR) + "6A006858BFB929B8" + AlignDWORD(KO_PERI_TAK) + "FFD061C3"), pCode
    ExecuteRemoteCode pCode, True
    End Function
    Function KanatTak()
    Dim pCode() As Byte
    If Form1.KanatTakCombo.Text = 1 Then
    ConvHEX2ByteArray ("608B0D" + AlignDWORD(KO_PTR_CHR) + "6A0068" + AlignDWORD(Form1.KanatTakCombo.ItemData(0)) + "B8" + AlignDWORD(KO_PERI_TAK) + "FFD061C3"), pCode
    End If
    If Form1.KanatTakCombo.Text = 2 Then
    ConvHEX2ByteArray ("608B0D" + AlignDWORD(KO_PTR_CHR) + "6A0068" + AlignDWORD(Form1.KanatTakCombo.ItemData(1)) + "B8" + AlignDWORD(KO_PERI_TAK) + "FFD061C3"), pCode
    End If
    If Form1.KanatTakCombo.Text = 3 Then
    ConvHEX2ByteArray ("608B0D" + AlignDWORD(KO_PTR_CHR) + "6A0068" + AlignDWORD(Form1.KanatTakCombo.ItemData(2)) + "B8" + AlignDWORD(KO_PERI_TAK) + "FFD061C3"), pCode
    End If
    If Form1.KanatTakCombo.Text = 4 Then
    ConvHEX2ByteArray ("608B0D" + AlignDWORD(KO_PTR_CHR) + "6A0068" + AlignDWORD(Form1.KanatTakCombo.ItemData(3)) + "B8" + AlignDWORD(KO_PERI_TAK) + "FFD061C3"), pCode
    End If
    If Form1.KanatTakCombo.Text = 5 Then
    ConvHEX2ByteArray ("608B0D" + AlignDWORD(KO_PTR_CHR) + "6A0068" + AlignDWORD(Form1.KanatTakCombo.ItemData(4)) + "B8" + AlignDWORD(KO_PERI_TAK) + "FFD061C3"), pCode
    End If
    If Form1.KanatTakCombo.Text = 6 Then
    ConvHEX2ByteArray ("608B0D" + AlignDWORD(KO_PTR_CHR) + "6A0068" + AlignDWORD(Form1.KanatTakCombo.ItemData(5)) + "B8" + AlignDWORD(KO_PERI_TAK) + "FFD061C3"), pCode
    End If
    If Form1.KanatTakCombo.Text = 7 Then
    ConvHEX2ByteArray ("608B0D" + AlignDWORD(KO_PTR_CHR) + "6A0068" + AlignDWORD(Form1.KanatTakCombo.ItemData(6)) + "B8" + AlignDWORD(KO_PERI_TAK) + "FFD061C3"), pCode
    End If
    If Form1.KanatTakCombo.Text = 8 Then
    ConvHEX2ByteArray ("608B0D" + AlignDWORD(KO_PTR_CHR) + "6A0068" + AlignDWORD(Form1.KanatTakCombo.ItemData(7)) + "B8" + AlignDWORD(KO_PERI_TAK) + "FFD061C3"), pCode
    End If
    If Form1.KanatTakCombo.Text = 9 Then
    ConvHEX2ByteArray ("608B0D" + AlignDWORD(KO_PTR_CHR) + "6A0068" + AlignDWORD(Form1.KanatTakCombo.ItemData(8)) + "B8" + AlignDWORD(KO_PERI_TAK) + "FFD061C3"), pCode
    End If
    If Form1.KanatTakCombo.Text = 10 Then
    ConvHEX2ByteArray ("608B0D" + AlignDWORD(KO_PTR_CHR) + "6A0068" + AlignDWORD(Form1.KanatTakCombo.ItemData(9)) + "B8" + AlignDWORD(KO_PERI_TAK) + "FFD061C3"), pCode
    End If
    If Form1.KanatTakCombo.Text = 11 Then
    ConvHEX2ByteArray ("608B0D" + AlignDWORD(KO_PTR_CHR) + "6A0068" + AlignDWORD(Form1.KanatTakCombo.ItemData(10)) + "B8" + AlignDWORD(KO_PERI_TAK) + "FFD061C3"), pCode
    End If
    If Form1.KanatTakCombo.Text = 12 Then
    ConvHEX2ByteArray ("608B0D" + AlignDWORD(KO_PTR_CHR) + "6A0068" + AlignDWORD(Form1.KanatTakCombo.ItemData(11)) + "B8" + AlignDWORD(KO_PERI_TAK) + "FFD061C3"), pCode
    End If
    If Form1.KanatTakCombo.Text = 13 Then
    ConvHEX2ByteArray ("608B0D" + AlignDWORD(KO_PTR_CHR) + "6A0068" + AlignDWORD(Form1.KanatTakCombo.ItemData(12)) + "B8" + AlignDWORD(KO_PERI_TAK) + "FFD061C3"), pCode
    End If
    If Form1.KanatTakCombo.Text = 14 Then
    ConvHEX2ByteArray ("608B0D" + AlignDWORD(KO_PTR_CHR) + "6A0068" + AlignDWORD(Form1.KanatTakCombo.ItemData(13)) + "B8" + AlignDWORD(KO_PERI_TAK) + "FFD061C3"), pCode
    End If
    If Form1.KanatTakCombo.Text = 15 Then
    ConvHEX2ByteArray ("608B0D" + AlignDWORD(KO_PTR_CHR) + "6A0068" + AlignDWORD(Form1.KanatTakCombo.ItemData(14)) + "B8" + AlignDWORD(KO_PERI_TAK) + "FFD061C3"), pCode
    End If
    ExecuteRemoteCode pCode, True
    End Function
    Public Sub üstte(TheForm As Form, SetOnTop As Boolean, X As Long)
    SetWindowPos TheForm.hWnd, X - 2, 0, 0, 0, 0, 2 Or 1
    End Sub

    Peri Kodu
    Kod:
    Private Sub chperi_Click()
    If chperi.Value = 1 Then
    periaç
    ByteYaz (LongOku(LongOku(KO_PTR_CHR) + &H58)) + &H5C4, 1
    ByteYaz (LongOku(LongOku(KO_PTR_CHR) + &H58)) + &H5C6, 1
    ByteYaz (LongOku(LongOku(KO_PTR_CHR) + &H58)) + &H5C7, 1
    Else
    ByteYaz (LongOku(LongOku(KO_PTR_CHR) + &H58)) + &H5C4, 0
    ByteYaz (LongOku(LongOku(KO_PTR_CHR) + &H58)) + &H5C6, 0
    ByteYaz (LongOku(LongOku(KO_PTR_CHR) + &H58)) + &H5C7, 0
    End If
    End Sub

    Arkadaşlar Bu Şekilde Paylaştım Umarım İşinize Yaramıştır

    Aradıgım Bir Kaç Olay Var Yardımcı Olacak Arkadaşlara Şimdiden Teşekkür Ederim
    Oto Z Ve Skill Atma Yöntemini Anlatmanızıı İstemiyoruz Fakat Bir Yol Yordam Gösterilirse Sevinirim
    Linkleri Görüntüleyebilmek için

    Linkleri Görmek İçin Lütfen Kayıt OL Veya Giriş Yapın

    Veya

    Linkleri Görmek İçin Lütfen Kayıt OL Veya Giriş Yapın

    eğer kayıtlı iseniz

    Linkleri Görmek İçin Lütfen Kayıt OL Veya Giriş Yapın

    Yapın Eğer Kayıt Olduysanız ve Bu Yazıyı Hala Görüyorsanız Üyeliğinizi Aktifleştirmeyi Unutmuşsunuz !...
    Konumu İncelermisiniz

    Kaynak:

    Linkleri Görmek İçin Lütfen Kayıt OL Veya Giriş Yapın

     

Bu Sayfayı Paylaş