标题:学习VB查找窗体句柄源代码.
取消只看楼主
taihongbo
Rank: 1
来 自:山东临沂
等 级:新手上路
帖 子:127
专家分:0
注 册:2004-11-15
 问题点数:0 回复次数:3 
学习VB查找窗体句柄源代码.
很早之前自己的一个小东西。利用万人迷自动发短信,这里使用了查找窗体句柄的功能,然后利用SendMessage
向窗体的TEXT控件写,执行command按钮等操作。

gbCancel = True
Dim nCHILD As Long

Dim lParent As Long
Dim tTempStr As String * 256

Dim nA00 As Long
Dim nA01 As Long
Dim nA02 As Long
Dim nA03 As Long
Dim nA04 As Long
Dim nA05 As Long
Dim lHwnd As Long
Dim lResult As Long
Dim cCaption As String

Dim tTempStr0 As String * 256
Dim tTempStr1 As String * 256
Dim tTempStr2 As String * 256

Dim cOkTest As String
cCaption = Space(120)
nA00 = Val(Me.Text1(0).Text) '窗体
nA01 = Val(Me.Text1(1).Text) '
nA02 = Val(Me.Text1(2).Text)
nA03 = Val(Me.Text1(3).Text)
'---------------------------------------------------------
lHwnd = nA00
lResult = SendMessage(lHwnd, WM_GETTEXT, Len(cCaption), ByVal cCaption)
cCaption = StripTerminator(cCaption)
If cCaption = "短信息发送" Then
If nA00 = 0 Or nA01 = 0 Or nA02 = 0 Or nA03 = 0 Then
Call Msg_Stop("参数设置不完整!!!")
Else
'---------------------------------------
lHwnd = nA01
cCaption = Me.Text2.Text
lResult = SendMessage(lHwnd, WM_SETTEXT, 0, ByVal cCaption) '手机号码
lHwnd = nA02
cCaption = Me.Text3.Text
lResult = SendMessage(lHwnd, WM_SETTEXT, 0, ByVal cCaption) '短信内容
lHwnd = nA03
lResult = PostMessage(lHwnd, WM_LBUTTONDOWN, 0, 0) '发送
lResult = PostMessage(lHwnd, WM_LBUTTONUP, 0, 0) '发送
'---------------------------------------
DoEvents
lstWindows.Clear
nCHILD = FindWindow(vbNullString, "发 送")
Do While nCHILD = 0
nCHILD = FindWindow(vbNullString, "发 送")
'---------------------------------------------------有Information表示异常
If FindWindow(vbNullString, "Information") > 0 Then
Exit Sub
End If
'---------------------------------------------------有Information表示异常
Loop
nCHILD = GetWindow(nCHILD, GW_CHILD)
Do While nCHILD <> 0 '如果有子窗口
lHwnd = nCHILD
If List1.List(0) <> Capt(0) & Hex(lHwnd) Then
lResult = GetClassName(lHwnd, tTempStr0, 255)
lResult = GetWindowText(lHwnd, tTempStr1, 255)
If Me.Option1.Value Then
cOkTest = "否(&N)"
Else
cOkTest = "是(&Y)"
End If
If Left(tTempStr1, InStr(tTempStr1, vbNullChar) - 1) = cOkTest Then
lstWindows.AddItem Capt(0) & Hex(lHwnd)
lstWindows.AddItem Capt(1) & Left(tTempStr0, InStr(tTempStr0, vbNullChar) - 1)
lstWindows.AddItem Capt(2) & Left(tTempStr1, InStr(tTempStr1, vbNullChar) - 1)
End If
End If
nCHILD = GetWindow(nCHILD, GW_HWNDNEXT) '取得下一个兄弟窗口的句柄
Loop
DoEvents
lHwnd = Val("&H" & Mid(lstWindows.List(0), 11))
lResult = PostMessage(lHwnd, WM_LBUTTONDOWN, 0, 0) '确认
lResult = PostMessage(lHwnd, WM_LBUTTONUP, 0, 0) '确认
DoEvents
If Me.Option2.Value Then '发送
lstWindows.Clear
nCHILD = FindWindow(vbNullString, "Information") '查找发送成功
Do While nCHILD = 0
nCHILD = FindWindow(vbNullString, "Information")
Loop
nCHILD = GetWindow(nCHILD, GW_CHILD)
Do While nCHILD <> 0 '如果有子窗口
lHwnd = nCHILD
If List1.List(0) <> Capt(0) & Hex(lHwnd) Then
lResult = GetClassName(lHwnd, tTempStr0, 255)
lResult = GetWindowText(lHwnd, tTempStr1, 255)
cOkTest = "OK"
If Left(tTempStr1, InStr(tTempStr1, vbNullChar) - 1) = cOkTest Then
lstWindows.AddItem Capt(0) & Hex(lHwnd)
lstWindows.AddItem Capt(1) & Left(tTempStr0, InStr(tTempStr0, vbNullChar) - 1)
lstWindows.AddItem Capt(2) & Left(tTempStr1, InStr(tTempStr1, vbNullChar) - 1)
End If
End If
nCHILD = GetWindow(nCHILD, GW_HWNDNEXT) '取得下一个兄弟窗口的句柄
Loop
DoEvents
lHwnd = Val("&H" & Mid(lstWindows.List(0), 11))
lResult = PostMessage(lHwnd, WM_LBUTTONDOWN, 0, 0) 'OK
lResult = PostMessage(lHwnd, WM_LBUTTONUP, 0, 0) 'OK
End If
DoEvents
'---------------------------------------
lHwnd = nA01
lResult = SendMessage(lHwnd, WM_SETTEXT, 0, ByVal "") '手机号码
lHwnd = nA02
lResult = SendMessage(lHwnd, WM_SETTEXT, 0, ByVal "") '短信内容
'---------------------------------------
End If
Else
Call Msg_Stop("短信发送主窗体没有打开!!!")
End If
搜索更多相关主题的帖子: 源代码 句柄 窗体 学习 
2007-07-09 09:01
taihongbo
Rank: 1
来 自:山东临沂
等 级:新手上路
帖 子:127
专家分:0
注 册:2004-11-15
得分:0 

Dim gbCancel As Boolean
Private Type POINTAPI
x As Long
Y As Long
End Type

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 GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long '获取鼠标指针的当前位置

Private Declare Function WindowFromPoint Lib "user32" _
(ByVal xPoint As Long, ByVal yPoint As Long) As Long '返回包含了指定点的窗口的句柄。忽略屏蔽、隐藏以及透明窗口

Private Declare Function GetParent Lib "user32" (ByVal hwnd 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 GetWindowText Lib "user32" Alias "GetWindowTextA" _
(ByVal hwnd As Long, ByVal lpString As String, _
ByVal cch As Long) As Long '取得一个窗体的标题(caption)文字,或者一个控件的内容(在vb里使用:使用vb窗体或控件的caption或text属性)

Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd 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 Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" _
(ByVal hwnd 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 PostMessage Lib "user32" Alias "PostMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long


Private Const WM_SETTEXT = &HC
Private Const WM_GETTEXT = &HD
Private Const WM_COMMAND = &H111
Private Const VK_RETURN = &HD
Private Const VK_LBUTTON = &H1
Private Const VK_RBUTTON = &H2
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const GW_HWNDFIRST = 0

Private Const GW_CHILD = 5
Private Const LVA_ALIGNLEFT = &H1
Private Const LVM_ARRANGE = &H1016
Private Const GW_HWNDNEXT = 2

Dim Capt(8)



淘宝 毛绒玩具 熊
jstbobo.taobao. com
久顺通啵啵玩具店
2007-07-09 09:01
taihongbo
Rank: 1
来 自:山东临沂
等 级:新手上路
帖 子:127
专家分:0
注 册:2004-11-15
得分:0 
感兴趣的朋友到这里 http://www.lshsoft.net/lshbbs/dispbbs.asp?boardID=23&ID=131&page=1 可以下载
安装万人迷短信发送软件,可以实现连续发送了。

淘宝 毛绒玩具 熊
jstbobo.taobao. com
久顺通啵啵玩具店
2007-07-09 09:04
taihongbo
Rank: 1
来 自:山东临沂
等 级:新手上路
帖 子:127
专家分:0
注 册:2004-11-15
得分:0 
[URL=http://www.]http://www.[/URL]

淘宝 毛绒玩具 熊
jstbobo.taobao. com
久顺通啵啵玩具店
2007-07-09 09:05



参与讨论请移步原网站贴子:https://bbs.bccn.net/thread-153886-1-1.html




关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.267609 second(s), 8 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved