找回密码
 注册帐号
查看: 2097|回复: 14

[源码分享] 发个vb写的源码.并代个人学习找下基址。要是我违反了。帮我删除帖子吧

[复制链接]
发表于 2010-7-10 11:41:35 | 显示全部楼层 |阅读模式
本帖最后由 ksp169 于 2010-7-10 11:43 编辑

模块代码:
Option Explicit
Public Const MAX_TOOLTIP As Integer = 64
Public Const NIF_ICON = &H2
Public Const NIF_MESSAGE = &H1
Public Const NIF_TIP = &H4
Public Const NIM_ADD = &H0
Public Const NIM_DELETE = &H2
Public Const WM_MOUSEMOVE = &H200
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP = &H205
Public Const WM_RBUTTONDBLCLK = &H206
Public Const SW_RESTORE = 9
Public Const SW_HIDE = 0
Public nfIconData As NOTIFYICONDATA
Public Type NOTIFYICONDATA
cbSize As Long
hWnd As Long
uID As Long
uFlags As Long
uCallbackMessage As Long
hIcon As Long
szTip As String * MAX_TOOLTIP
End Type
Public Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long

工程代码:
Option Explicit
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 ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vkey As Long) As Integer
Private Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
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
Private Const PROCESS_ALL_ACCESS = &H1F0FFF '参数决定了对进程的存储权限,使用完全控制
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'延迟函数
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long


Private Type RECT
          Left As Long
          Top As Long
          Right As Long
          Bottom As Long
End Type
Private Type POINTAPI
          X As Long
          Y As Long
End Type

Private Const HWND_TOPMOST = -1
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const HWND_TOP = 0
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_SHOWWINDOW = &H40
'==========================================以上为隐藏代码===========
'-----------------------窗体中--------------------------
Dim WindowTop, WindowLeft

Dim hwd As Long ' 储存 FindWindow 函数返回的句柄
Dim pid As Long '存放进程ID
Dim hProcess As Long '存放进程句柄
Dim t As Long '时间
Dim t1 As Long '时间1
Dim hp As Long
Dim mp As Long
Dim hp1 As Long
Dim mp1 As Long
Dim s As Long
Private Const SW_HIDE = 0
Private Const SW_HOW = 1
Dim mz(16) As Byte

Private Sub Command1_Click()
If Command1.Caption = "隐藏游戏" Then
ShowWindow hwd, SW_HIDE
Command1.Caption = "显示游戏"
ElseIf Command1.Caption = "显示游戏" Then
ShowWindow hwd, SW_HOW
Command1.Caption = "隐藏游戏"
End If
End Sub
Private Sub Command2_Click()
Timer1.Enabled = False

End Sub
Private Sub Form_Load()
hwd = FindWindow(vbNullString, "sro_client") ' 取得进程标识符
If hWnd = 0 Then
Label1.Caption = "丝路未运行"
Else
Label1.Caption = "游戏已运行"
End If
GetWindowThreadProcessId hwd, pid '获取进程标识符
hProcess = OpenProcess(PROCESS_ALL_ACCESS, 0, pid) '将进程标识符做为参数,返回目标进程PID的句柄,得到此句柄后即可对目标进行读写操,PROCESS_ALL_ACCESS表示完全控制,权限最大
If hProcess = 0 Then
Label2.Caption = "使用工具失败"
Else
Label2.Caption = "可以使用工具"
SetWindowPos Me.hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_SHOWWINDOW Or SWP_NOMOVE Or SWP_NOSIZE
End If
End Sub

Private Sub Timer1_Timer()
If GetAsyncKeyState(vbKeyF11) Then Timer2.Enabled = True

If GetAsyncKeyState(vbKeyF12) Then Timer2.Enabled = False
End Sub
Function WindowStyle()
'以下把程序放入System Tray====================================System Tray Begin
With nfIconData
.hWnd = Me.hWnd
.uID = Me.Icon
.uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
.uCallbackMessage = WM_MOUSEMOVE
.hIcon = Me.Icon.Handle
'定义鼠标移动到托盘上时显示的Tip
.szTip = "已最小化到托盘" & vbNullChar
.cbSize = Len(nfIconData)
End With
Call Shell_NotifyIcon(NIM_ADD, nfIconData)
'=============================================================System Tray End
Me.Hide
End Function

Private Sub Form_Resize()
WindowTop = Me.Top
WindowLeft = Me.Left
If Me.WindowState = 1 Then
WindowStyle
End If
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim lMsg As Single
lMsg = X / Screen.TwipsPerPixelX
Select Case lMsg
Case WM_LBUTTONDBLCLK '双击左键显示窗体,要改成其他的看模块里的定义
ShowWindow Me.hWnd, SW_RESTORE
Me.Top = WindowTop
Me.Left = WindowLeft
Call Shell_NotifyIcon(NIM_DELETE, nfIconData)
Me.SetFocus
Case WM_RBUTTONUP '在托盘图标上点右键显示菜单
PopupMenu f00 '菜单名称为F00,做菜单时你可以改成别的,这里也得改成相应的
End Select
End Sub

Private Sub F01_Click()
ShowWindow Me.hWnd, SW_RESTORE
Me.Top = WindowTop
Me.Left = WindowLeft
Call Shell_NotifyIcon(NIM_DELETE, nfIconData)
End Sub

Private Sub F02_Click()
Call Shell_NotifyIcon(NIM_DELETE, nfIconData)
End
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
'退出程序时删除托盘图标
Call Shell_NotifyIcon(NIM_DELETE, nfIconData)
End Sub
Private Sub Timer2_Timer()

ReadProcessMemory hProcess, ByVal &HE6CC94, s, 4, 0&
ReadProcessMemory hProcess, ByVal s + &H450, mp, 4, 0&
ReadProcessMemory hProcess, ByVal s + &H454, hp, 4, 0&
ReadProcessMemory hProcess, ByVal s + &H114, mz(0), 16, 0&
ReadProcessMemory hProcess, ByVal s + &H45C, hp1, 4, 0&
ReadProcessMemory hProcess, ByVal s + &H458, mp1, 4, 0&
Label4.Caption = hp & "/" & hp1
Label3.Caption = mp & "/" & mp1
Label5.Caption = StrConv(mz, vbUpperCase)

End Sub

Private Sub Timer3_Timer()
Dim p As POINTAPI
      Dim f As RECT
      GetCursorPos p    '得到MOUSE位置
      GetWindowRect Me.hWnd, f      '得到窗体的位置
      If Me.WindowState <> 1 Then
          If p.X > f.Left And p.X < f.Right And p.Y > f.Top And p.Y < f.Bottom Then
          'MOUSE 在窗体上
              If Me.Top < 0 Then
                  Me.Top = -10
                  Me.Show
              ElseIf Me.Left < 0 Then
                  Me.Left = -10
                  Me.Show
              ElseIf Me.Left + Me.Width >= Screen.Width Then
                  Me.Left = Screen.Width - Me.Width + 10
                  Me.Show
              End If
   
          Else
              If f.Top <= 4 Then
                  Me.Top = 40 - Me.Height
              ElseIf f.Left <= 4 Then
                  Me.Left = 40 - Me.Width
              ElseIf Me.Left + Me.Width >= Screen.Width - 4 Then
                  Me.Left = Screen.Width - 40
              End If
          End If
      End If
End Sub
 楼主| 发表于 2010-7-10 17:47:24 | 显示全部楼层
没人看得懂vb么?在此想寻一朋友会找游戏数据基址的。看到这个就头痛。太难找了。坐标都需要计算工式。我郁闷.
发表于 2010-8-1 00:08:16 | 显示全部楼层
想寻一朋友会找游戏数据基址的。
发表于 2010-8-1 01:13:06 | 显示全部楼层
我完全看 不懂!!VB是 什么 来 的 ?
发表于 2010-8-1 09:33:30 | 显示全部楼层
我也不知道什么是vb 帮补了你 不好意思楼主
发表于 2010-8-1 09:52:38 | 显示全部楼层
ReadProcessMemory hProcess, ByVal &HE6CC94, s, 4, 0&
ReadProcessMemory hProcess, ByVal s + &H450, mp, 4, 0&
ReadProcessMemory hProcess, ByVal s + &H454, hp, 4, 0&
ReadProcessMemory hProcess, ByVal s + &H114, mz(0), 16, 0&
ReadProcessMemory hProcess, ByVal s + &H45C, hp1, 4, 0&
ReadProcessMemory hProcess, ByVal s + &H458, mp1, 4, 0&


这段包含基址 信息 比较重要
发表于 2010-8-1 11:48:58 | 显示全部楼层
虽然那段比较重要,但这几个基址只需寻找一次遍历一次全有了,而其他重要的东西都没人说,问下坐标的基址与人物基址是一个么?
发表于 2010-8-3 10:58:12 | 显示全部楼层
应该是一个,但是坐标偏移好像要麻烦很多。
这游戏人物基址相当好找,但有用信息不多。
发表于 2010-10-2 20:21:38 | 显示全部楼层
说的什么都不懂
回复 支持 反对

使用道具 举报

发表于 2011-1-5 15:41:40 | 显示全部楼层
你这个是全部代码吗?窗口怎么设计的
回复 支持 反对

使用道具 举报

发表于 2011-1-5 22:01:46 | 显示全部楼层
英语不及格 因为我爱国

看懂了中间的汉字

回复 支持 反对

使用道具 举报

发表于 2011-1-5 23:15:38 | 显示全部楼层
我很想学 但是看的我眼花  哈哈
回复 支持 反对

使用道具 举报

发表于 2011-1-22 18:57:42 | 显示全部楼层
才学VB需要交流,开群呀
回复 支持 反对

使用道具 举报

发表于 2011-1-23 19:34:04 | 显示全部楼层
basic,不如学习c语言
回复 支持 反对

使用道具 举报

发表于 2011-1-24 22:25:41 | 显示全部楼层
C还没入门的..VB先凑合下.
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 注册帐号

本版积分规则

QQ|Archiver|手机版|小黑屋|依人网络官方网站 ( 陕ICP备19025998号-1 )

GMT+8, 2024-5-3 11:40 , Processed in 0.053989 second(s), 16 queries .

Powered by Discuz! X3.5

© 2001-2023 Discuz! Team.

快速回复 返回顶部 返回列表