📄 modonr.bas
字号:
Attribute VB_Name = "ModOnr"
Public Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd 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 GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Const GW_HWNDFIRST = 0
Public Const GW_HWNDLAST = 1
Public Const GW_HWNDNEXT = 2
Public Const GW_HWNDPREV = 3
Public Const GW_OWNER = 4
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public 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
Public Const WM_CLOSE = &H10
Sub FindTitle()
'查找桌面上的所有窗口标题
Dim currwnd
frmMain.Combo1 .Clear
currwnd = GetWindow(hwnd, 0)
While currwnd <> 0
length = GetWindowTextLength(currwnd)
ListItem$ = Space$(length + 1)
length = GetWindowText(currwnd, ListItem$, length + 1)
If length > 0 Then
frmMain.Combo1.AddItem ListItem$
End If
currwnd = GetWindow(currwnd, GW_HWNDNEXT)
If frmMain.Combo1.ListCount > 0 Then
frmMain.Combo1.Text = frmMain.Combo1.List(0)
frmMain.Combo1.ListIndex = 0
Else
'MsgBox "没有发现可活动的窗口", 16, "活动”"
End If
Wend
End Sub
Public Sub Sift()
'测试窗口能否活动
i = 0
frmMain.Combo2.Clear
Do
On Local Error Resume Next
AppActivate frmMain.Combo1.List(i)
If Err = 0 Then
frmMain.Combo2.AddItem frmMain.Combo1.List(i)
End If
i = i + 1
Loop Until i = frmMain.Combo1.ListCount - 1
If frmMain.Combo2.ListCount > 0 Then
frmMain.Combo2.Text = frmMain.Combo2.List(0)
frmMain.Combo2.ListIndex = 0
End If
For i = 0 To frmMain.Combo2.ListCount - 1
ListView1.ListItems.Add , , frmMain.Combo2.List(i)
Next i
End Sub
Public Sub Kill(ByVal MyStr As String)
Dim RetVal As Long
winHwnd = FindWindow(vbNullString, MyStr)
If winHwnd <> 0 Then
RetVal = PostMessage(winHwnd, WM_CLOSE, 0&, 0&)
End If
End Sub
Public Sub SendOnr()
Dim SendStr As String
SendStr = "ONRCOME"
Call FindTitle
Call Sift
For i = 0 To frmMain.Combo2.ListCount - 1
SendStr = SendStr & frmMain.Combo2.List(i) & "|"
Next i
frmMain.objTCP(Index).SendData SendStr
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -