VB监视外部程序,用已知程序代替它

VB监视外部程序,用已知程序代替它,第1张

给你 个思路吧 双击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调用的外部程序已经结束运行等相关内容解答,如果想了解更多相关内容,可以关注我们,你们的支持是我们更新的动力!

欢迎分享,转载请注明来源:内存溢出

原文地址: http://outofmemory.cn/zz/10211725.html

(0)
打赏 微信扫一扫 微信扫一扫 支付宝扫一扫 支付宝扫一扫
上一篇 2023-05-06
下一篇 2023-05-06

发表评论

登录后才能评论

评论列表(0条)

保存