pvp serverler,pvp server,pvp serverlar,private serverlar,private serverler,private server,metin2

Sizleri Neler Bekliyor ?
-Foruma Üye Olarak Yeni Arkadaşlıklar Edineceksiniz.
-İnternette Zaman Geçirecek Bir Alanınız Olucak Ve Eğleneceksiniz.
-PvP Server Tutkunuysanız Pvp Serverlerde Yenilikleri Takip Ediceksiniz.
-Yeni Açılan Serverleri Anında Bulacaksınız .
-Gmlik Adaylığı Koyacaksınız.Serverinizi Tanıtacaksınız.
-Pvp Serverler Hakkında Herşey Bu Forumda Olucak.
-ÜYE OLURSANIZ FORUMDAKİ REKLAMLAR GÖZÜKMEZ
Bunlardan Yararlanmak İçin Sizden Tek İsteyimiz Üye Olmanız Yada Giriş Yapmanız.


koxp yapmak isteyen arkadaşlar buyursun 30us3s8
Lütfen Foruma FİREFOX İle Giriniz !



Join the forum, it's quick and easy

pvp serverler,pvp server,pvp serverlar,private serverlar,private serverler,private server,metin2

Sizleri Neler Bekliyor ?
-Foruma Üye Olarak Yeni Arkadaşlıklar Edineceksiniz.
-İnternette Zaman Geçirecek Bir Alanınız Olucak Ve Eğleneceksiniz.
-PvP Server Tutkunuysanız Pvp Serverlerde Yenilikleri Takip Ediceksiniz.
-Yeni Açılan Serverleri Anında Bulacaksınız .
-Gmlik Adaylığı Koyacaksınız.Serverinizi Tanıtacaksınız.
-Pvp Serverler Hakkında Herşey Bu Forumda Olucak.
-ÜYE OLURSANIZ FORUMDAKİ REKLAMLAR GÖZÜKMEZ
Bunlardan Yararlanmak İçin Sizden Tek İsteyimiz Üye Olmanız Yada Giriş Yapmanız.


koxp yapmak isteyen arkadaşlar buyursun 30us3s8
Lütfen Foruma FİREFOX İle Giriniz !

pvp serverler,pvp server,pvp serverlar,private serverlar,private serverler,private server,metin2

Would you like to react to this message? Create an account in a few clicks or log in to continue.

pvp serverler,pvp server,pvp serverlar,private serverlar,private serverler,private server,metin pvp server

pvpserverler.forumclan.com  Üye sayımız +105.000 / Aramıza Hoşgeldiniz !

    koxp yapmak isteyen arkadaşlar buyursun

    senem21
    senem21
    Silver Master
    Silver Master


    <b>Mesaj Sayısı</b> Mesaj Sayısı : 509
    <b>Kayıt tarihi</b> Kayıt tarihi : 14/07/10
    Mage
    Oyun Kurucu
    GS

    çözüldü koxp yapmak isteyen arkadaşlar buyursun

    Mesaj tarafından senem21 Cuma Ekim 01, 2010 11:07 pm

    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

      Forum Saati Cuma Mayıs 17, 2024 10:51 am