给你 个思路吧 双击Aexe时在注册表中建立一个键値0,并修改这个値=这个値+1,判断这个値<4时候立即关闭A窗口,而打开Bexe程序。等于4时候当Aexe第四次被打开时,不关闭A窗口,也不打开Bexe程序。
关键点就是保存Aexe的启动次数,可以是 *** 作注册表也可以是ini文件、txt文件,还可以追加到Aexe或者Bexe的末尾,常用于软件注册
’‘新建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
可以使用while循环查看是否结束
Private Function MyShell(ByVal cmd As String, Optional AppStyle As VbAppWinStyle = vbNormalFocus)
Dim RetVal As Long
RetVal = Shell(cmd, AppStyle)
Do While IsRunning(RetVal)
DoEvents
Loop
'执行完毕
End Function
调用!!!
MyShell "c:\1exe", vbHide
以上就是关于VB监视外部程序,用已知程序代替它全部的内容,包括:VB监视外部程序,用已知程序代替它、VB获取外部程序的窗体信息、如何知道VB调用的外部程序已经结束运行等相关内容解答,如果想了解更多相关内容,可以关注我们,你们的支持是我们更新的动力!
欢迎分享,转载请注明来源:内存溢出
评论列表(0条)