实例介绍
【实例简介】
【实例截图】
【核心代码】
VERSION 5.00
Begin VB.Form Form1
Caption = "Spy "
ClientHeight = 4575
ClientLeft = 120
ClientTop = 450
ClientWidth = 7590
Icon = "Form1.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 4575
ScaleWidth = 7590
StartUpPosition = 2 '屏幕中心
Begin VB.PictureBox Picture2
Appearance = 0 'Flat
BackColor = &H80000005&
ForeColor = &H80000008&
Height = 270
Left = 2520
ScaleHeight = 240
ScaleWidth = 4905
TabIndex = 19
Top = 4200
Width = 4935
End
Begin VB.TextBox 坐标RGB
Appearance = 0 'Flat
Height = 270
Left = 960
TabIndex = 17
Top = 4200
Width = 1455
End
Begin VB.TextBox 类名关联
Appearance = 0 'Flat
Height = 270
Left = 960
TabIndex = 15
Top = 2520
Width = 6495
End
Begin VB.TextBox 进程句柄
Appearance = 0 'Flat
Height = 270
Left = 960
TabIndex = 13
Top = 3840
Width = 6495
End
Begin VB.TextBox 句柄路径
Appearance = 0 'Flat
Height = 855
Left = 960
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 11
Top = 2880
Width = 6495
End
Begin VB.TextBox 句柄关联
Appearance = 0 'Flat
Height = 270
Left = 960
TabIndex = 9
Top = 2160
Width = 6495
End
Begin VB.TextBox 句柄内容
Appearance = 0 'Flat
Height = 855
Left = 960
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 7
Top = 1200
Width = 6495
End
Begin VB.TextBox 句柄标题
Appearance = 0 'Flat
Height = 270
Left = 960
TabIndex = 5
Top = 840
Width = 6495
End
Begin VB.TextBox 坐标句柄
Appearance = 0 'Flat
Height = 270
Left = 960
TabIndex = 3
Top = 480
Width = 5775
End
Begin VB.TextBox 鼠标坐标
Appearance = 0 'Flat
Height = 270
Left = 960
TabIndex = 1
Top = 120
Width = 5775
End
Begin VB.PictureBox Picture1
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H80000005&
ForeColor = &H80000008&
Height = 645
Left = 6840
ScaleHeight = 615
ScaleWidth = 615
TabIndex = 0
Top = 120
Width = 645
End
Begin VB.Label Label9
Caption = "坐标 RGB:"
Height = 255
Left = 120
TabIndex = 18
Top = 4245
Width = 855
End
Begin VB.Label Label8
Caption = "类名关联:"
Height = 255
Left = 120
TabIndex = 16
Top = 2565
Width = 855
End
Begin VB.Label Label7
Caption = "进程句柄:"
Height = 255
Left = 120
TabIndex = 14
Top = 3885
Width = 855
End
Begin VB.Label Label6
Caption = "句柄路径:"
Height = 255
Left = 120
TabIndex = 12
Top = 2925
Width = 855
End
Begin VB.Label Label5
Caption = "句柄关联:"
Height = 255
Left = 120
TabIndex = 10
Top = 2205
Width = 855
End
Begin VB.Label Label4
Caption = "句柄内容:"
Height = 255
Left = 120
TabIndex = 8
Top = 1245
Width = 855
End
Begin VB.Label Label3
Caption = "句柄标题:"
Height = 255
Left = 120
TabIndex = 6
Top = 885
Width = 855
End
Begin VB.Label Label2
Caption = "坐标句柄:"
Height = 255
Left = 120
TabIndex = 4
Top = 525
Width = 855
End
Begin VB.Label Label1
Caption = "鼠标坐标:"
Height = 255
Left = 120
TabIndex = 2
Top = 165
Width = 855
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function SetCursor Lib "user32" (ByVal hCursor As Long) As Long
'设置鼠标形状
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Type POINTAPI
x As Long
y As Long
End Type
'取鼠标坐标
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
'坐标句柄
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
'取某窗体标题
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_GETTEXT = &HD
Private Const WM_GETTEXTLENGTH = &HE
'取某窗体文本框内容
Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
'根据子句柄取得主窗体句柄
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
'根据句柄取进程路径
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpclassname As String, ByVal nMaxCount As Long) As Long
'取窗体类名
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
'Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
'Private Type POINTAPI
'x As Long
'y As Long
'End Type
'获取RGB值
Private Sub GetRGB(ByVal Col As Long, ByRef r As Long, ByRef g As Long, ByRef b As Long) '转化为RGB
r = Col Mod 256
g = ((Col And &HFF00&) \ 256&) Mod 256&
b = (Col And &HFF0000) \ 65536
End Sub
Public Function 获取文本(ByVal JB As Long) As String
On Error GoTo 出错处理:
Dim a() As Byte
Dim b As Long
b = SendMessage(JB, WM_GETTEXTLENGTH, 0, 0)
ReDim a(1 To b) As Byte
Call SendMessage(JB, WM_GETTEXT, ByVal b 1, a(1))
获取文本 = StrConv(a, vbUnicode)
Exit Function
出错处理:
获取文本 = ""
End Function
Public Function 获取类名(ByVal JB As Long) As String
On Error GoTo 出错处理:
Dim leiming As String
leiming = Space(255)
GetClassName JB, leiming, 255
获取类名 = leiming
Exit Function
出错处理:
获取类名 = ""
End Function
Public Function 获取RGB值(ByVal x As Long, ByVal y As Long) As String
On Error GoTo 出错处理:
Dim hdc As Long
Dim Col As Long
Dim r As Long
Dim g As Long
Dim b As Long
hdc = GetDC(0)
cor = GetPixel(hdc, x, y)
GetRGB cor, r, g, b
ReleaseDC Me.hwnd, hdc
获取RGB值 = r & "," & g & "," & b
Exit Function
出错处理:
获取RGB值 = "240,240,240"
End Function
Private Sub Form_Load()
Picture1.Picture = Me.Icon
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Picture1.Tag = "1"
Picture1.Picture = LoadPicture("")
SetCursor Me.Icon
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Picture1.Tag = ""
Picture1.Picture = Me.Icon
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If Picture1.Tag = "1" Then
Dim MouseZB As POINTAPI
GetCursorPos MouseZB
鼠标坐标.Text = MouseZB.x & "," & MouseZB.y
坐标句柄.Text = WindowFromPoint(MouseZB.x, MouseZB.y)
Dim GetText As String
GetText = Space(255)
GetWindowText CLng(坐标句柄.Text), GetText, 255
句柄标题.Text = GetText
句柄内容.Text = 获取文本(CLng(坐标句柄.Text))
Dim a As Long
句柄关联.Text = 坐标句柄.Text
类名关联.Text = 获取类名(CLng(坐标句柄.Text))
a = GetParent(CLng(坐标句柄.Text))
Do While a <> 0
句柄关联.Text = 句柄关联.Text & "\" & a
类名关联.Text = 类名关联.Text & "\" & 获取类名(a)
a = GetParent(a)
Loop
Dim PID As Long
GetWindowThreadProcessId CLng(坐标句柄.Text), PID
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")
Set colProcesses = objWMIService.ExecQuery("SELECT * FROM Win32_Process")
For Each objprocess In colProcesses
If objprocess.processid = PID Then
句柄路径.Text = objprocess.ExecutablePath
进程句柄.Text = PID
End If
Next
坐标RGB.Text = 获取RGB值(MouseZB.x, MouseZB.y)
Picture2.BackColor = RGB(Split(坐标RGB.Text, ",")(0), Split(坐标RGB.Text, ",")(1), Split(坐标RGB.Text, ",")(2))
End If
End Sub
好例子网口号：伸出你的我的手 — 分享！
小贴士
感谢您为本站写下的评论，您的评论对其它用户来说具有重要的参考价值，所以请认真填写。
- 类似“顶”、“沙发”之类没有营养的文字，对勤劳贡献的楼主来说是令人沮丧的反馈信息。
- 相信您也不想看到一排文字/表情墙，所以请不要反馈意义不大的重复字符，也请尽量不要纯表情的回复。
- 提问之前请再仔细看一遍楼主的说明，或许是您遗漏了。
- 请勿到处挖坑绊人、招贴广告。既占空间让人厌烦，又没人会搭理，于人于己都无利。
关于好例子网
本站旨在为广大IT学习爱好者提供一个非营利性互相学习交流分享平台。本站所有资源都可以被免费获取学习研究。本站资源来自网友分享，对搜索内容的合法性不具有预见性、识别性、控制性，仅供学习研究，请务必在下载后24小时内给予删除，不得用于其他任何用途，否则后果自负。基于互联网的特殊性，平台无法对用户传输的作品、信息、内容的权属或合法性、安全性、合规性、真实性、科学性、完整权、有效性等进行实质审查；无论平台是否已进行审查，用户均应自行承担因其传输的作品、信息、内容而可能或已经产生的侵权或权属纠纷等法律责任。本站所有资源不代表本站的观点或立场，基于网友分享，根据中国法律《信息网络传播权保护条例》第二十二与二十三条之规定，若资源存在侵权或相关问题请联系本站客服人员，点此联系我们。关于更多版权及免责申明参见 版权及免责申明
网友评论
我要评论