Bu Foruma yaptığınız ilk ziyaretiniz ise, Lütfen öncelikle Yardım kriterlerini okuyunuz.Forumumuzda bilgi alışverişinde bulunabilmeniz için öncelikle Kayıt olmalısınız.
Üye olmayanlar Forumumuzdan hiçbir şekilde aktivite uygulayamaz, Mesaj yazamaz, Konu açamaz, Eklenti indiremez. Forumumuzu tam anlamıylakullanmak için Üye olabilirsiniz..

Koxp Yapım Dersleri | direct dinput ,kısayol tuşu,OTO HP MP |

Önceki başlık Sonraki başlık Aşağa gitmek

Koxp Yapım Dersleri | direct dinput ,kısayol tuşu,OTO HP MP |

Mesaj tarafından ReD Bir Salı Ağus. 24, 2010 10:04 pm

Ders 1 : Direct
Dinput

Birtane Virsual Basic 6 projesi açın ve
bir modul ekleyin.
Driect8.dll Link:
Örnek
Proje:
Modülün
içersine şunları yazın.

Kod:
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 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 +
8))) = 1, "0" & Hex(pBytes(X + 8)), Hex(pBytes(X + 8))) &
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 ko()
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
End Sub




'Forma 1 adet combobox,1 adet checkbox
, 1 adet de timer (intervali 1 olsun) ekleyin Ve kodları formun kod
kısmına yapıştırın.
'Form Kodları

Kod:
Private Sub
Check1_Click()
If Check1.Value = 1 Then
Check1.Caption = "DURDUR"
Timer1.Enabled
= True

End If
If Check1.Value = 0 Then
Check1.Caption =
"BAŞLAT"
Timer1.Enabled = False
End If
End Sub

Private
Sub Form_Load()
ko ' knight pencere isim leri yüklenir
HookDI8 '
Driect dinput komutları yüklenir.
Timer1.Interval = "1"
Timer1.Enabled
= False
End Sub

Private Sub Timer1_Timer()
'Ben karışık
olmasın diye comboBoxsun Text'i ile secenek yapıyorum.
If Combo1.Text
= "1" Then
Tuş yolla("1")
Tuş yolla("z")
End If
If
Combo1.Text = "2" Then
Tuş yolla("2")
Tuş yolla("z")
End If
If
Combo1.Text = "3" Then
Tuş yolla("3")
Tuş yolla("z")
End If
If
Combo1.Text = "4" Then
Tuş yolla("4")
Tuş yolla("z")
End If
If
Combo1.Text = "5" Then
Tuş yolla("5")
Tuş yolla("z")
End If
If
Combo1.Text = "6" Then
Tuş yolla("6")
Tuş yolla("z")
End If
If
Combo1.Text = "7" Then
Tuş yolla("7")
Tuş yolla("z")
End If
If
Combo1.Text = "8" Then
Tuş yolla("8")
Tuş yolla("z")
End If
End
Sub




Ders 2 : Kısayol Tuşu

'Projeyi açıyoruz.Form a 1 adet timer ekliyoruz.
'Formun
kod kısmına şunları yapıştırıyoruz.

Kod:
Private Declare
Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
'burada
tuşlarımızı tanımlıyoruz.

Private Const VK_F1= &H70 'F1
tuşunu tanımladık Başka tuşlarda ekleyebilirsinz.

Private Sub
Form_Load()
Timer1.Interval = 1
End Sub

Private Sub
Timer1_Timer()
If GetAsyncKeyState(VK_F1) Then ' eğer F1 e basılırsa
alttaki komutu çalıştır.
Msgbox "F1 e basıldı" 'Buraya kendi
komutunuzu ekleyebilirsiniz.
End If ' koşulumuzu bitiriyoruz.
End
Sub



Proje
Link:

BAZI TUŞ KODLARI
Tuş kodlarını eklerken
başındaki 0x yerine &H koyun hepsini tektek yazacaktım ama uun
sürer.
örnek:VK_NUMPAD7 0x67 ise projenize eklerken
Private Const
VK_NUMPAD7 =&H67 olarak ekleyin

Kod:
VK_NUMPAD7 0x67
VK_BACK 0x08
VK_NUMPAD8
0x68 VK_TAB 0x09
VK_NUMPAD9
0x69 VK_RETURN 0x0D
VK_MULTIPLY
0x6A VK_SHIFT 0x10
VK_ADD
0x6B VK_CONTROL 0x11
VK_SEPARATOR
0x6C VK_MENU 0x12
VK_SUBTRACT
0x6D VK_PAUSE 0x13
VK_DECIMAL
0x6E VK_CAPITAL 0x14
VK_DIVIDE
0x6F VK_ESCAPE 0x1B
VK_F1
0x70 VK_SPACE 0x20
VK_F2
0x71 VK_END 0x23
VK_F3
0x72 VK_HOME 0x24
VK_F4
0x73 VK_LEFT 0x25
VK_F5
0x74 VK_UP 0x26
VK_F6
0x75 VK_RIGHT 0x27
VK_F7
0x76 VK_DOWN 0x28
VK_F8
0x77 VK_PRINT 0x2A
VK_F9
0x78 VK_SNAPSHOT 0x2C
VK_F10
0x79 VK_INSERT 0x2D
VK_F11
0x7A VK_DELETE 0x2E
VK_F12
0x7B VK_LWIN 0x5B
VK_NUMLOCK
0x90 VK_RWIN 0x5C
VK_SCROLL
0x91 VK_NUMPAD0 0x60
VK_LSHIFT
0xA0 VK_NUMPAD1 0x61
VK_RSHIFT
0xA1 VK_NUMPAD2 0x62
VK_LCONTROL
0xA2 VK_NUMPAD3 0x63
VK_RCONTROL
0xA3 VK_NUMPAD4 0x64
VK_LMENU
0xA4 VK_NUMPAD5 0x65
VK_RMENU
0xA5 VK_NUMPAD6 0x66



Ders 3 : Oto Hp Oto Mp

Anlatması biraz
karışık oldugundan projeyi koyuyorum.
Link:ders3.rar

Ders3 : Oto Hp Oto Mp "Linki Görmek İçin Konuya Yorum
Yazınız"


[Resimleri görebilmek için üye olun veya giriş yapın.]
avatar
ReD
Forum Kurucusu
Forum Kurucusu

Mesaj Sayısı : 3038
Kayıt tarihi : 23/01/10
Leader Poınt : 11635
Nerden : Nereye =)

Kullanıcı profilini gör http://pvpserver.1talk.net

Sayfa başına dön Aşağa gitmek

Önceki başlık Sonraki başlık Sayfa başına dön

- Similar topics

 
Bu forumun müsaadesi var:
Bu forumdaki mesajlara cevap veremezsiniz