My VB project

[akson]

I'm a vb newbie ~"~
Hotkey : Alt+V Alt+G
::::::::::::::::::::::::::::::::::::::::::::Notice ::::::::::::::::::::::::::::::::::::::::::::
Timer1.Interval 1000
Timer2.Interval 0~XXXXX
Timer3.Interval 300
Timer4.Interval 100
::::::::::::::::::::::::::::::::::::::::::::End::: ::::::::::::::::::::::::::::::::::::::::::::

Option Explicit '宣告變數與定義開始

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Const WM_SetHotKey = &H32
Private Const HotKey_Ext = &H8

Private Type TpInt
aint As Integer
End Type

Private Type Tp2Bt
lByte As Byte
hByte As Byte
End Type

Private ti As TpInt
Private tb As Tp2Bt
'上面這一段宣告熱鍵用

Dim base As Long '全局基址
Dim base1c As Long '動態基址
Dim chbase As Long '人物基址
Dim envbase As Long '環境基址
'Dim petbase As Long '寵物基址
'Dim pethp As Long '寵物HP
'Dim pethpmax As Long '寵物HPmax
Dim hpadr As Long 'HP
Dim mpadr As Long 'MP
Dim hpmax As Long 'HPm@x
Dim mpmax As Long 'MPm@x
Dim engv As Long '元氣
Dim tclass As Long '修真期
'Dim atkdist As Single '攻擊距離
'Dim sdist As Long '法術攻擊距離
Dim hpcool As Long '紅水冷卻時間
Dim mpcool As Long '籃水冷卻時間
Dim cytimeloop As Long 'cytime計數
Dim cytime(1 To 2) As Long '循環次數
Dim f1time As Long 'f1循環時間
Dim f2time As Long 'f2循環時間
Dim f3time As Long 'f3循環時間
Dim k1per As Long 'HP%數
Dim k2per As Long 'MP%數
Dim hwd As Long
Dim pid As Long
Dim hProcess As Long

Private Sub Form_Load() '程式開啟時就執行的段落

Dim rtn As Long
rtn = GetWindowLong(Me.hwnd, GWL_EXSTYLE) '取的窗口原先樣式
rtn = rtn Or WS_EX_LAYERED '使窗體添加上新的樣式WS_EX_LAYERED
SetWindowLong Me.hwnd, GWL_EXSTYLE, rtn ' 把新的樣式賦予窗体
SetLayeredWindowAttributes Me.hwnd, 0, 235, LWA_ALPHA '180為設置透明度 越小透明度大

Dim wParam As Long
tb.hByte = MOD_CONTROL ' 高位元組( 可為或多個值)
tb.lByte = vbKeyO ' 低位元組( Virtual-Key code )
LSet ti = tb ' LSet 陳述式 : 將一使用者自訂型態變數複製到另一使用者自訂型態變數。
wParam = CLng(ti.aint) ' 參數

Select Case SendMessage(hwnd, WM_SetHotKey, wParam, 0)
Case 1
Debug.Print "指定 HotKey 成功!"
Case 2
Debug.Print "跟其它視窗 HotKey 重複!"
Case Else
Debug.Print "指定 HotKey 失敗!"
End Select

hwd = FindWindow("ElementClient Window", "Element Client")

If hwd = 0 Then
MsgBox "未啟動遊戲,進入遊戲後執行本工具", vbOKOnly, "提示"
Unload Form1
End
End If
GetWindowThreadProcessId hwd, pid
hProcess = OpenProcess(PROCESS_ALL_ACCESS Or PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, False, pid)
If hProcess = 0 Then
'MsgBox "進入遊戲後執行本工具", vbOKOnly, "提示"
Unload Form1
End
End If

WriteProcessMemory hProcess, ByVal &H451806, 1, 1, 0& '無限跳
WriteProcessMemory hProcess, ByVal &H4057D0, 235, 1, 0& '無限視野
WriteProcessMemory hProcess, ByVal &H6F0410, 144, 1, 0& '6表情
CloseHandle hProcess
End Sub

Private Sub Check1_Click()
If Check1.Value = 1 Then 'F1打勾的話
Timer2.Enabled = True 'timer2計時器才啟動
Else
Timer2.Enabled = False
End If
End Sub

Private Sub Check9_Click()
hProcess = OpenProcess(PROCESS_ALL_ACCESS Or PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, False, pid)
If Check9.Value = 1 Then
If hProcess Then
WriteProcessMemory hProcess, ByVal &H459E1D, 235, 1, 0& '法術距離
End If
Else
If Check9.Value = 0 Then
If hProcess Then
WriteProcessMemory hProcess, ByVal &H459E1D, 117, 1, 0& '回復正常
End If
End If
End If
CloseHandle hProcess
End Sub


Private Sub Command1_Click()
hProcess = OpenProcess(PROCESS_ALL_ACCESS Or PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, False, pid)
If Command1.Caption = "飛天" Then
If hProcess Then
WriteProcessMemory hProcess, ByVal chbase + &H650, 43024, 2, 0& '開啟飛行
Command1.Caption = "關飛"
End If
Else
If Command1.Caption = "關飛" Then
If hProcess Then
WriteProcessMemory hProcess, ByVal chbase + &H650, 43008, 2, 0& '關閉飛行
Command1.Caption = "飛天"
End If
End If
End If
CloseHandle hProcess
End Sub
Private Sub Command2_Click()
hProcess = OpenProcess(PROCESS_ALL_ACCESS Or PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, False, pid)
If Command2.Caption = "穿牆" Then
If hProcess Then
WriteProcessMemory hProcess, ByVal &H4051C4, 192, 1, 0& '穿牆
Command2.Caption = "關穿"
End If
Else
If Command2.Caption = "關穿" Then
If hProcess Then
WriteProcessMemory hProcess, ByVal &H4051C4, 193, 1, 0& '關閉穿牆
Command2.Caption = "穿牆"
End If
End If
End If
CloseHandle hProcess
End Sub

Private Sub Command3_Click()
hProcess = OpenProcess(PROCESS_ALL_ACCESS Or PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, False, pid)
If Command3.Caption = "隱藏" Then
If hProcess Then
WriteProcessMemory hProcess, ByVal &H421368, 235, 1, 0& '隱藏建築
Command3.Caption = "關隱"
End If
Else
If Command3.Caption = "關隱" Then
If hProcess Then
WriteProcessMemory hProcess, ByVal &H421368, 117, 1, 0& '關閉隱藏
Command3.Caption = "隱藏"
End If
End If
End If
CloseHandle hProcess
End Sub


Private Sub Command4_Click()
'Form2.Show 1
MsgBox "使用說明︰" & vbCrLf & "所有按鍵後面的空格為輸入秒數用打勾前必須先輸入數字" & vbCrLf & "只有F1秒數範圍1-65.5,預設1.4秒一次,其餘按鍵秒數為整數。" & vbCrLf & "F2.F3預設每25分鐘(1500秒)/30秒按一次(可以更改)" & vbCrLf & "若開F1則其他按鍵不適合用連續技" & vbCrLf & "使用過多按鍵時間點偶爾會相衝突造成某單一功能單次失效,謹慎搭配使用" & vbCrLf & "逃學威龍具備無限跳、無限視野、6表情、小號入仙魔須從萬流紅藍陣進入" & vbCrLf & "增加法術距離多6米需要自己抓距離超過會放技能失敗" & vbCrLf & "空中不減攻擊&補血勾選後需要移動一小步才會生效" & vbCrLf & "Ctrl+O可以呼叫程式, ALT+V開關飛天穿牆, ALT+G開關隱藏", vbOKOnly, "逃學威龍III for v.111(TW)"
End Sub

Private Sub Command5_Click()
hProcess = OpenProcess(PROCESS_ALL_ACCESS Or PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, False, pid)
If Command5.Caption = "飛穿" Then
If hProcess Then
WriteProcessMemory hProcess, ByVal chbase + &H650, 43024, 2, 0& '開啟飛穿
WriteProcessMemory hProcess, ByVal &H4051C4, 192, 1, 0& '穿牆
Command5.Caption = "關閉"
End If
Else
If Command5.Caption = "關閉" Then
If hProcess Then
WriteProcessMemory hProcess, ByVal chbase + &H650, 43008, 2, 0& '關閉飛穿
WriteProcessMemory hProcess, ByVal &H4051C4, 193, 1, 0& '關閉穿牆
Command5.Caption = "飛穿"
End If
End If
End If
CloseHandle hProcess
End Sub

Private Sub Command6_Click()
hProcess = OpenProcess(PROCESS_ALL_ACCESS Or PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, False, pid)
If Command6.Caption = "飛隱" Then
If hProcess Then
WriteProcessMemory hProcess, ByVal chbase + &H650, 43024, 2, 0& '開啟飛隱
WriteProcessMemory hProcess, ByVal &H421368, 235, 1, 0& '隱藏建築
Command6.Caption = "關閉"
End If
Else
If Command6.Caption = "關閉" Then
If hProcess Then
WriteProcessMemory hProcess, ByVal &H421368, 117, 1, 0& '關閉隱藏
Wait (1000)
WriteProcessMemory hProcess, ByVal chbase + &H650, 43008, 2, 0& '關閉飛隱
Command6.Caption = "飛隱"
End If
End If
End If
CloseHandle hProcess
End Sub

Private Sub Timer1_Timer() '一秒刷新一次
f1time = Val(Key1time.Text) '讀取功能鍵時間(次數)
f2time = Val(Key2time.Text)
f3time = Val(Key3time.Text)
k1per = Val(Key1per.Text) '讀HP%數
k2per = Val(Key2per.Text) '讀MP%數
Timer2.Interval = f1time * 1000 '設置F1按鍵時間
Dim name_temp As Long
Dim name(31) As Byte
hProcess = OpenProcess(PROCESS_ALL_ACCESS Or PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, False, pid)
If hProcess Then
ReadProcessMemory hProcess, ByVal &H962C84, base, 4, 0& '全局基址
ReadProcessMemory hProcess, ByVal base + &H1C, base1c, 4, 0& '動態基址
ReadProcessMemory hProcess, ByVal base1c + &H20, chbase, 4, 0& '人物基址
ReadProcessMemory hProcess, ByVal base1c + &H8, envbase, 4, 0& '環境基址
ReadProcessMemory hProcess, ByVal chbase + &H464, hpadr, 4, 0& 'HP
ReadProcessMemory hProcess, ByVal chbase + &H468, mpadr, 4, 0& 'MP
ReadProcessMemory hProcess, ByVal chbase + &H478, engv, 4, 0& '元氣
ReadProcessMemory hProcess, ByVal chbase + &H494, hpmax, 4, 0& 'HPmax
ReadProcessMemory hProcess, ByVal chbase + &H498, mpmax, 4, 0& 'MPmax
ReadProcessMemory hProcess, ByVal chbase + &H988, hpcool, 4, 0& '紅水冷卻時間
ReadProcessMemory hProcess, ByVal chbase + &H990, mpcool, 4, 0& '籃水冷卻時間
ReadProcessMemory hProcess, ByVal chbase + &H460, tclass, 4, 0& '修真基址
'ReadProcessMemory hProcess, ByVal chbase + &H4C4, atkdist, 4, 0& '物攻距離
ReadProcessMemory hProcess, ByVal chbase + &H5F0, name_temp, 4, 0& '人物ID
ReadProcessMemory hProcess, ByVal name_temp, name(0), 32, 0&

If tclass < 23 Then
WriteProcessMemory hProcess, ByVal chbase + &H460, 22, 4, 0& '修真基址為天仙
Else
WriteProcessMemory hProcess, ByVal chbase + &H460, 32, 4, 0& '修真基址為魔尊
End If

CloseHandle hProcess
End If
Form1.Caption = name

For cytimeloop = 1 To 2
cytime(cytimeloop) = cytime(cytimeloop) + 1 ' "各"功能鍵計數每秒+1
Next

If cytime(1) > f2time Then '從0開始每秒+1的計數大於功能鍵讀取的時間次數
If Check2.Value = 1 Then '若F2按鍵有打勾
'SendKeys "{F2}"
PostMessage hwd, WM_KEYdown, &H71, 0
PostMessage hwd, WM_KEYUP, &H71, 0
End If
cytime(1) = 0 '計數歸0達到正確秒數間隔功能
End If

If cytime(2) > f3time Then
If Check3.Value = 1 Then
'SendKeys "{F3}"
PostMessage hwd, WM_KEYdown, &H72, 0
PostMessage hwd, WM_KEYUP, &H72, 0
End If
cytime(2) = 0
End If

If Check4.Value = 1 Then
If engv > 199 Then '元氣值大於199
'SendKeys "{F4}"大絕/高爆
PostMessage hwd, WM_KEYdown, &H73, 0
PostMessage hwd, WM_KEYUP, &H73, 0
End If
End If

If Check5.Value = 1 Then
'SendKeys "{F5}"自動撿物
PostMessage hwd, WM_KEYdown, &H74, 0
PostMessage hwd, WM_KEYUP, &H74, 0
End If

If Check8.Value = 1 Then
If engv > 299 Then '元氣值大於299(三顆燈)
'SendKeys "{F8}"仙魔爆
PostMessage hwd, WM_KEYdown, &H77, 0
PostMessage hwd, WM_KEYUP, &H77, 0
End If
End If

End Sub

Private Sub Timer2_Timer()
'SendKeys "{F1}"
PostMessage hwd, WM_KEYdown, &H70, 0
PostMessage hwd, WM_KEYUP, &H70, 0
End Sub

Private Sub Timer3_Timer()
If Check6.Value = 1 Then
If mpadr < mpmax * k2per * 0.01 Then 'MP小於%數轉換後的值
If mpcool < 1 Then
'SendKeys "{F6}"喝藍水
PostMessage hwd, WM_KEYdown, &H75, 0
PostMessage hwd, WM_KEYUP, &H75, 0
Wait (800) '延遲時間避免出現物品冷卻
End If
End If
End If

If Check7.Value = 1 Then
If hpadr < hpmax * k1per * 0.01 Then 'HP小於%數轉換後的值
If hpcool < 1 Then
'SendKeys "{F7}"喝紅水
PostMessage hwd, WM_KEYdown, &H76, 0
PostMessage hwd, WM_KEYUP, &H76, 0
Wait (800)
End If
End If
End If

hProcess = OpenProcess(PROCESS_ALL_ACCESS Or PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, False, pid)

If Check11.Value = 1 Then
If hProcess Then
WriteProcessMemory hProcess, ByVal &H44B829, 127, 1, 0& '空中不減傷
WriteProcessMemory hProcess, ByVal &H44B82D, 0, 1, 0& '空中不減傷
End If
Else
If Check11.Value = 0 Then
If hProcess Then
WriteProcessMemory hProcess, ByVal &H44B829, 126, 1, 0& '回復正常
WriteProcessMemory hProcess, ByVal &H44B82D, 192, 1, 0& '回復正常
End If
End If
End If
End Sub

Private Sub Timer4_Timer()
Dim r As Integer
Dim i As Integer
Dim v As String
Dim g As String
Dim s As String
v = "V" 'Hotkey V
g = "G" 'Hotkey G
s = ""
For i = 0 To 255
r = GetAsyncKeyState(i)
If r <> 0 Then s = s & i & ","
Next i

hProcess = OpenProcess(PROCESS_ALL_ACCESS Or PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, False, pid)
If s = "18," & Asc(v) & ",164," Then '判斷有無同時按ctrl alt
If Command5.Caption = "飛穿" Then
If hProcess Then
WriteProcessMemory hProcess, ByVal chbase + &H650, 43024, 2, 0& '開啟飛穿
WriteProcessMemory hProcess, ByVal &H4051C4, 192, 1, 0& '穿牆
Command5.Caption = "關閉"
End If
Else
If Command5.Caption = "關閉" Then
If hProcess Then
WriteProcessMemory hProcess, ByVal chbase + &H650, 43008, 2, 0& '關閉飛穿
WriteProcessMemory hProcess, ByVal &H4051C4, 193, 1, 0& '關閉穿牆
Command5.Caption = "飛穿"
End If
End If
End If
End If

If s = "18," & Asc(g) & ",164," Then '判斷有無同時按ctrl alt
If Command3.Caption = "隱藏" Then
If hProcess Then
WriteProcessMemory hProcess, ByVal &H421368, 235, 1, 0& '隱藏建築
Command3.Caption = "關隱"
End If
Else
If Command3.Caption = "關隱" Then
If hProcess Then
WriteProcessMemory hProcess, ByVal &H421368, 117, 1, 0& '關閉隱藏
Command3.Caption = "隱藏"
End If
End If
End If
End If

End Sub


'for v.111 (TW)

[akson]

::::::::::::::::::::::::::::::::::::::::::::Module 1::::::::::::::::::::::::::::::::::::::::::::

Option Explicit

Public Type POINTAPI
x As Long
y As Long
End Type

Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Public Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Public Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long
Public Declare Function timeGetTime Lib "winmm.dll" () As Long
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Public Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent 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 FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Public Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId 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 CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Declare Function ReadProcessMemory Lib "kernel32.dll" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, ByRef lpBuffer As Any, ByVal nSize As Long, ByRef lpNumberOfBytesWritten As Long) As Long
Public Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Declare Function PostMessageByNum& Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long)
Declare Function PostMessageByString& Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String)
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function GlobalAddAtom Lib "kernel32" Alias "GlobalAddAtomA" (ByVal lpString As String) As Integer
Public Declare Function GetForegroundWindow Lib "user32" () As Long
Public Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public 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
Public Const HWND_TOPMOST = -1
Public Const HWND_NOTOPMOST = -2
Public Declare Function GetPrivateProfileString& Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String)
Public Declare Function WritePrivateProfileString& Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpString As String, ByVal lpFileName As String)
Public Declare Function GetCurrentProcess Lib "kernel32" () As Long
Declare Function RegisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer

Public Const WM_KEYdown = &H100
Public Const WM_KEYUP = &H101
Public Const GWL_EXSTYLE = (-20)
Public Const WS_EX_LAYERED = &H80000
Public Const WS_EX_TRANSPARENT = &H20&
Public Const LWA_ALPHA = &H2&
Public Const WS_EX_APPWINDOW = &H40000
Public Const PROCESS_ALL_ACCESS = &H1F0FFF
Public Const PROCESS_VM_OPERATION = &H8&
Public Const PROCESS_VM_READ = &H10&
Public Const PROCESS_VM_WRITE = &H20&
Public Const VK_F1 = &H70
Public Const VK_F2 = &H71
Public Const VK_F3 = &H72
Public Const VK_F4 = &H73
Public Const VK_F5 = &H74
Public Const VK_F6 = &H75
Public Const VK_F7 = &H76
Public Const VK_F8 = &H77
Public Const VK_F9 = &H78
Public Const VK_F10 = &H79
Public Const VK_F11 = &H8A
Public Const VK_F12 = &H8B
Public Const VK_1 = &H31
Public Const VK_2 = &H32
Public Const VK_3 = &H33
Public Const VK_4 = &H34
Public Const VK_5 = &H35
Public Const VK_6 = &H36
Public Const MOD_ALT = &H1
Public Const MOD_CONTROL = &H2
Public Const MOD_SHIFT = &H4

Public Function Wait(mtime As Long) As Long
If mtime = 0 Then Wait = 0: Exit Function
Dim Savetime As Double
Savetime = timeGetTime '記下開始的時間
DoEvents
While timeGetTime < Savetime + mtime '循環等待
DoEvents '轉讓控制權,以便讓操作系統處理其他的事件.
Sleep 1
Wend
Wait = 1
End Function

[god op wor]

what the kamsudnya gan???

[Red_Shark]

@_@
maybe you should post the exe file.

[dedesayang]

wew... bahasa apaan itu om...

[incyberz]

hahaa ... VBers juga neh ... ngikut rusakin kode ah .... ^_^