求用VB编程控制外部程序的可行性和详细思路步骤

可以实现的

相当于做一个简单的按键精灵,

先通过窗口名字找到这个窗口获取窗口的句柄，然后设置该全窗口的区域,向该窗口发送鼠标信息和键盘信息,就可以模拟点击按钮，选着下拉菜单,以及输入文本的功能。

以下是一个示例:

Private Declare Function FindWindow Lib "user32 " Alias "FindWindowA " (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare Function GetWindow Lib "user32 " (ByVal hwnd As Long, ByVal wCmd As Long) As Long

Private Declare Function ClientToScreen Lib "user32" (ByVal hWnd As Long, lpPoint As POINTAPI) As Long

Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint 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

Private Const GW_HWNDNEXT = 2

Private Const GW_HWNDFIRST = 0

Private Declare Function SetWindowText Lib "user32 " Alias "SetWindowTextA " (ByVal hwnd As Long, ByVal lpString As String) As Long

Private Const GW_CHILD = 5

Private 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

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_SETTEXT = &HC

Private Const BN_CLICKED = 0

Private Const bm_click = &HF5

Private Const WM_SETFOCUS = &H7

Private Sub Command1_Click()

Dim h As Long, hChild As Long, i As Long

Dim str As String

’根据程序窗体的标题名字查找程序的句柄

h = FindWindow(vbNullString, "Test ") '得到程序

SendMessage hChild, WM_SETTEXT, 0, ByVal str ’设置文本

SendMessage h, WM_SETFOCUS, 0, 0 ‘设置焦点

SendMessage hChild, bm_click, 0, 0 '点击按钮

end sub

’获取指定的屏幕坐标上的控件的句柄

Private Sub PriCMouseHook_MouseMove(ByVal Button As Long, ByVal mX As Long, ByVal mY As Long)

'鼠标事件通知

Dim tmpStr As String 255, tmpI As Long, tmpJ As Long

Dim tmpStr2 As String

MeCaption = mX & ":" & mY '显示坐标

tmpI = WindowFromPoint(mX, mY)

labHwndCaption = tmpI '取得句柄

tmpJ = GetClassName(tmpI, tmpStr, Len(tmpStr) + 1) '获取类名

If tmpJ > 0 Then

labClassNameCaption = Mid(tmpStr, 1, tmpJ)

End If

If (Button And vbLeftButton) = 1 And InStr(1, labClassNameCaption, "listview", vbTextCompare) > 0 Then

'在这里判断下类名就不会有那个问题了,呵呵果然是注入的问题对别的类也去注入了:)

txtLVItemText = GetLVItemm(tmpI) '获取选中项内容

End If

End Sub

’‘新建Command1,Text1,List1

''窗体代码

Private Sub Command1_Click()

Dim FormName As String

FormName = Text1

Dim t As Long

Dim Hwd As Long

Dim FormHwd As Long

List1Clear

FormHwd = F_FindForm(FormName)

If FormHwd = 0 Then Exit Sub

S_GetAllCon (FormHwd)

For t = 1 To CollConCount

Hwd = CollConItem(t)

'''列出所有控件的句柄，类型，及内容

List1AddItem t & "" & Hwd & "" & F_GetClass(Hwd) & "" & F_GetText(Hwd)

Next

end sub

'''模块代码Fbas

Option Explicit

Public Enum E_ActionType

E_ActionType_None

E_ActionType_填入文本框

E_ActionType_点击按钮

E_ActionType_获取焦点

E_ActionType_填入组合框

E_ActionType_查找窗体

E_ActionType_手动暂停

E_ActionType_获取文本框

End Enum

Public Enum E_CID

E_CID_名称 = 1

E_CID_父窗体名称 = 2

E_CID_步骤类型 = 3

E_CID_控件ID = 4

E_CID_参数 = 5

End Enum

Public NowWindow As String

Public NowAction As Long

Public Pause As Boolean

Public TempStr As String

Public Arr()

'步骤名称

'步骤父窗体名称

'步骤动作 1 填入 2点击 3焦点

'控件ID

'步骤参数

Sub AddAction(Name As String, _

Optional Father As String, _

Optional Action As E_ActionType, _

Optional ID As Long, _

Optional Para As String)

ReDim Preserve Arr(0 To 10, 0 To UBound(Arr, 2) + 1)

Arr(1, UBound(Arr, 2)) = Name

Arr(2, UBound(Arr, 2)) = Father

Arr(3, UBound(Arr, 2)) = Action

Arr(4, UBound(Arr, 2)) = ID

Arr(5, UBound(Arr, 2)) = Para

End Sub

Function ExecuteAction() As Long

Dim Action As E_ActionType

Action = Arr(3, NowAction)

Dim FormName As String

Dim FormHwd As Long

Dim Hwd As Long

Dim ID As Long

Dim Para As String

If Action = E_ActionType_查找窗体 Then

FormName = Arr(5, NowAction)

If FF_FindForm(FormName) = 0 Then

MsgBox "未找到窗体:" & Arr(5, NowAction)

ExecuteAction = 0

Exit Function

End If

ExecuteAction = 1

End If

If Action = E_ActionType_填入文本框 Then

FormName = Arr(2, NowAction)

FormHwd = FF_FindForm(FormName)

If FormHwd = 0 Then

MsgBox "未找到父窗体:" & Arr(2, NowAction)

ExecuteAction = 0

Exit Function

End If

ID = Arr(4, NowAction)

Hwd = FF_FindByID(FormHwd, ID)

If Hwd = 0 Then

MsgBox "未找到控件ID:" & ID

ExecuteAction = 0

Exit Function

End If

Para = Arr(5, NowAction)

Call SendMessage(Hwd, WM_SETTEXT, 0, ByVal Para)

' If FF_GetText(Hwd) <> Para Then

' MsgBox "验证失败"

' ExecuteAction = 0

' Exit Function

' End If

' End If

ExecuteAction = 1

End If

If Action = E_ActionType_获取文本框 Then

FormName = Arr(2, NowAction)

FormHwd = FF_FindForm(FormName)

If FormHwd = 0 Then

MsgBox "未找到父窗体:" & Arr(2, NowAction)

ExecuteAction = 0

Exit Function

End If

ID = Arr(4, NowAction)

Hwd = FF_FindByID(FormHwd, ID)

If Hwd = 0 Then

MsgBox "未找到控件ID:" & ID

ExecuteAction = 0

Exit Function

End If

TempStr = FF_GetText(Hwd)

ExecuteAction = 1

End If

If Action = E_ActionType_点击按钮 Then

FormName = Arr(2, NowAction)

FormHwd = FF_FindForm(FormName)

If FormHwd = 0 Then

MsgBox "未找到父窗体:" & Arr(2, NowAction)

ExecuteAction = 0

Exit Function

End If

ID = Arr(4, NowAction)

Hwd = FF_FindByID(FormHwd, ID)

If Hwd = 0 Then

MsgBox "未找到控件ID:" & ID

ExecuteAction = 0

Exit Function

End If

'FF_Click (Hwd)

Call SendMessage(Hwd, BM_CLICK, 0, 0)

ExecuteAction = 1

End If

If Action = E_ActionType_手动暂停 Then

ExecuteAction = 2

End If

If Action = E_ActionType_获取焦点 Then

ExecuteAction = 2

End If

End Function

Function F_FindForm(Name As String, Optional Class As String = vbNullString, Optional Father As Long = 0, Optional Start As Long = 0) As Long

F_FindForm = FindWindowEx(Father, Start, Class, Name)

End Function

Function F_FindByID(Optional Father As Long = 0, Optional ID As Long = 1, Optional Class As String = vbNullString) As Long

Dim t As Long, p As Long

Dim Class1 As String 255

Dim Class2 As String

F_FindByID = 0

For t = CollConCount To 1 Step -1

CollConRemove t

Next

EnumChildWindows Father, AddressOf EnumChildWindowsProc, ByVal 0&

If Class = vbNullString Then '任意控件

If ID > CollConCount Then

F_FindByID = 0

Exit Function

End If

F_FindByID = CollConItem(ID)

Else '制定控件

p = 0

For t = 1 To CollConCount

Call GetClassNameA(CollConItem(t), Class1, 255)

Class2 = Replace(Class1, Chr(0), "")

If Class = Class2 Then p = p + 1

If p = ID Then

F_FindByID = CollConItem(t)

Exit Function

End If

Next

End If

End Function

Sub S_GetAllCon(Optional Father As Long = 0)

Dim t As Long, p As Long

For t = CollConCount To 1 Step -1

CollConRemove t

Next

EnumChildWindows Father, AddressOf EnumChildWindowsProc, ByVal 0&

End Sub

Function F_GetClass(Hwd As Long) As String

Dim Class1 As String 255

Call GetClassNameA(Hwd, Class1, 255)

F_GetClass = Replace(Class1, Chr(0), "")

End Function

Function F_GetText(Hwd As Long) As String

'Dim Text1 As String 2550

'Call GetWindowText(Hwd, Text1, 2550)

'F_GetText = Replace(Text1, Chr(0), "")

Dim Text1 As String 2550

Call SendMessage(Hwd, WM_GETTEXT, 2550, ByVal Text1)

F_GetText = Replace(Trim(Text1), Chr(0), "")

End Function

Function F_SetText(Hwd As Long, Str As String) As Long

'F_SetText = SetWindowText(Hwd, Str)

F_SetText = SendMessage(Hwd, WM_SETTEXT, 0, ByVal Str)

End Function

Function F_Click(Hwd As Long) As Long

'F_Click = SendMessage(Hwd, WM_LBUTTONDOWN, 0, 0)

'F_Click = SendMessage(Hwd, WM_LBUTTONUP, 0, 0)

'F_Click = SendMessage(Hwd, BM_CLICK, 0, 0)

'F_Click = SendMessage(Hwd, BM_CLICK, 0, 0)

'Call SendMessage(Hwd, BM_CLICK, 0, 0)

End Function

首先

你要定义下列的两个函数原形到模块中:

要在模块里定义:

Public

Declare

Function

GetNextWindow

Lib

"user32"

Alias

"GetWindow"

(ByVal

hwnd

As

Long,

ByVal

wFlag

As

Long)

As

Long

Public

Declare

Function

GetWindowText

Lib

"user32"

Alias

"GetWindowTextA"

(ByVal

hwnd

As

Long,

ByVal

lpString

As

String,

ByVal

cch

As

Long)

As

Long

Public

Declare

Function

FindWindowa

Lib

"user32"

Alias

"FindWindowA"

(ByVal

lpClassName

As

String,

ByVal

lpWindowName

As

String)

As

Long

Public

Declare

Function

GetForegroundWindow

Lib

"user32"

()

As

Long

Public

Declare

Function

SetWindowText

Lib

"user32"

Alias

"SetWindowTextA"

(ByVal

hwnd

As

Long,

ByVal

lpString

As

String)

As

Long

Public

Declare

Function

GetDlgItem

Lib

"user32"

(ByVal

hDlg

As

Long,

ByVal

nIDDlgItem

As

Long)

As

Long

然后在要获取句柄的地方

输入下列代码:

Dim

hwnd

As

Long

Dim

str1

As

String,

len1

As

Long

hwnd

=

FindWindowA("[这个窗口的类名(定义于RegisterClass中)]",

"[要获取句柄的标题栏名称]")

str1

=

Space(255)

'定义接收字串

GetWindowText

hwnd,

str1,

1024

Do

While

hwnd

<>

0

hwnd

=

GetNextWindow(hwnd,

2)

'只有2才表示找下一个窗口

len1

=

GetWindowText(hwnd,

str1,

Len(str1))

If

(InStr(1,

str1,

"API",

1)

>

0)

Then

Exit

Do

End

If

Loop

SetWindowText

hwnd,

"我把API阅读器的标题改变了"

hwnd

=

GetNextWindow(hwnd,

5)

'5表示子窗口

Do

While

hwnd

<>

0

hwnd

=

GetNextWindow(hwnd,

2)

'只有2才表示找下一个窗口

GetWindowText

hwnd,

str1,

Len(str1)

SetWindowText

hwnd,

"我改变了改钮2"

Loop

以上就是关于求用VB编程控制外部程序的可行性和详细思路步骤全部的内容，包括:求用VB编程控制外部程序的可行性和详细思路步骤、VB获取外部程序的窗体信息、VB怎么获取其它窗体句柄等相关内容解答，如果想了解更多相关内容，可以关注我们，你们的支持是我们更新的动力！