modonr.bas

来自「关于WINSOCK控件基本编程的例程,提供电子邮件例程」· BAS 代码 · 共 78 行

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