如何用VB做一个刷屏器

首先你要查找所有窗口标题 
Dim key, bs1, bs2, kb 

Sub FindTitle() 

'查找桌面上的所有窗口标题 

Dim currwnd As Integer 

Combo1.Clear 

currwnd = GetWindow(hwnd, GW_HWNDFIRST) 

While currwnd <> 0 

length = GetWindowTextLength(currwnd) 

listitem$ = Space$(length + 1) 

length = GetWindowText(currwnd, listitem$, length + 1) 

If length > 0 Then 

Combo1.AddItem listitem$ 

End If 

currwnd = GetWindow(currwnd, GW_HWNDNEXT) 

If Combo1.ListCount > 0 Then 

Combo1.Text = Combo1.List(0) 

Combo1.ListIndex = 0 

Else 

'MsgBox "没有发现可活动的窗口", 16, "活动" 

End If 
DoEvents 
Wend 
If Combo1.ListCount > 0 Then 

Combo1.Text = Combo1.List(0) 

Combo1.ListIndex = 0 

Else 

MsgBox "没有发现可活动的窗口", 16, "活动" 

End If 
End Sub 


－－－－－－ 
测试窗口能否活动 

Sub Sift() 

'测试窗口能否活动 

i = 0 

Combo2.Clear 

Do 

On Local Error Resume Next 

AppActivate Combo1.List(i) 

If Err = 0 Then 

Combo2.AddItem Combo1.List(i) 

End If 

i = i + 1 

Loop Until i = Combo1.ListCount - 1 

AppActivate Form1.Caption 

If Combo2.ListCount > 0 Then 

Combo2.Text = Combo2.List(0) 

Combo2.ListIndex = 0 

Else 

MsgBox "没有发现可活动窗口", 16, "活动" 

End If 

End Sub 

制作一个模块 
Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long 

Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long 
Declare Function inigetstr Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long 
Declare Function iniwritestr Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long 
Declare Function SetWindowPos& Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) 
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long 
Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long 
'Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) 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 

Global wb As String 
'--------- 

Option Explicit 

Public OldWindowProc As Long 
Public TheForm As Form 
Public TheMenu As Menu 

Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long 
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long 
Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long 
Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer 

Public Const WM_USER = &H400 
Public Const WM_LBUTTONUP = &H202 
Public Const WM_MBUTTONUP = &H208 
Public Const WM_RBUTTONUP = &H205 
Public Const TRAY_CALLBACK = (WM_USER + 1001&) 
Public Const GWL_WNDPROC = (-4) 
Public Const GWL_USERDATA = (-21) 
Public Const NIF_ICON = &H2 
Public Const NIF_TIP = &H4 
Public Const NIM_ADD = &H0 
Public Const NIF_MESSAGE = &H1 
Public Const NIM_MODIFY = &H1 
Public Const NIM_DELETE = &H2 
Public Const SPI_SCREENSAVERRUNNING = 97& 
Public Type NOTIFYICONDATA 
    cbSize As Long 
    hwnd As Long 
    uID As Long 
    uFlags As Long 
    uCallbackMessage As Long 
    hIcon As Long 
    szTip As String * 64 
End Type 

Private TheData As NOTIFYICONDATA 
' ********************************************* 
' The replacement window proc. 
' ********************************************* 
Public Function NewWindowProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long 
    If Msg = TRAY_CALLBACK Then 
        ' The user clicked on the tray icon. 
        ' Look for click events. 
        If lParam = WM_LBUTTONUP Then 
            ' On left click, show the form. 
            If TheForm.WindowState = vbMinimized Then _ 
                TheForm.WindowState = 0 
            TheForm.SetFocus 
            Exit Function 
        End If 
        If lParam = WM_RBUTTONUP Then 
            ' On right click, show the menu. 
            TheForm.PopupMenu TheMenu 
            Exit Function 
        End If 
    End If 
     
    ' Send other messages to the original 
    ' window proc. 
    NewWindowProc = CallWindowProc( _ 
        OldWindowProc, hwnd, Msg, _ 
        wParam, lParam) 
End Function 
' ********************************************* 
' Add the form's icon to the tray. 
' ********************************************* 
Public Sub AddToTray(frm As Form, mnu As Menu) 
    ' ShowInTaskbar must be set to False at 
    ' design time because it is read-only at 
    ' run time. 

    ' Save the form and menu for later use. 
    Set TheForm = frm 
    Set TheMenu = mnu 
     
    ' Install the new WindowProc. 
    OldWindowProc = SetWindowLong(frm.hwnd, _ 
        GWL_WNDPROC, AddressOf NewWindowProc) 
     
    ' Install the form's icon in the tray. 
    With TheData 
        .uID = 0 
        .hwnd = frm.hwnd 
        .cbSize = Len(TheData) 
        .hIcon = frm.Icon.Handle 
        .uFlags = NIF_ICON 
        .uCallbackMessage = TRAY_CALLBACK 
        .uFlags = .uFlags Or NIF_MESSAGE 
        .cbSize = Len(TheData) 
    End With 
    Shell_NotifyIcon NIM_ADD, TheData 
End Sub 
' ********************************************* 
' Remove the icon from the system tray. 
' ********************************************* 
Public Sub RemoveFromTray() 
    ' Remove the icon from the tray. 
    With TheData 
        .uFlags = 0 
    End With 
    Shell_NotifyIcon NIM_DELETE, TheData 
     
    ' Restore the original window proc. 
    SetWindowLong TheForm.hwnd, GWL_WNDPROC, _ 
        OldWindowProc 
End Sub 
' ********************************************* 
' Set a new tray tip. 
' ********************************************* 
Public Sub SetTrayTip(tip As String) 
    With TheData 
        .szTip = tip & vbNullChar 
        .uFlags = NIF_TIP 
    End With 
    Shell_NotifyIcon NIM_MODIFY, TheData 
End Sub 
' ********************************************* 
' Set a new tray icon. 
' ********************************************* 
Public Sub SetTrayIcon(pic As Picture) 
    ' Do nothing if the picture is not an icon. 
    If pic.Type <> vbPicTypeIcon Then Exit Sub 

    ' Update the tray icon. 
    With TheData 
        .hIcon = pic.Handle 
        .uFlags = NIF_ICON 
    End With 
    Shell_NotifyIcon NIM_MODIFY, TheData 
End Sub 




Public Sub AllowKeys(bParam As Boolean) 

Dim lRetVal As Long, bOld As Boolean 

lRetVal = SystemParametersInfo(SPI_SCREENSAVERRUNNING, bParam, bOld, 0&) 

End Sub 

－－－－－－－－ 
其他的一些具体操作可以按照你自己的思路来