| |
Данный пример запретит запуск дополнительных
окон броузера ИнтернетЭксплорер. Этот пример
хорош для борьбы с рекламными окошками,
запускаемыми автоматически на тех или иных
сайтах.
Что делает пример: 1) программа при запуске
определяет количество запущенных окон
InternetExplorer'а. 2) во время работы программа проводит
мониторинг запущенных процессов, 3) и если
запущено очередное окно Internet Explorer'а программа
его закроет.
Ну а кнопка вам понадобится, если вы захотите
отключить/снова включить процесс мониторинга.
Пример подробно описан, но... на английском
языке.
Установите на форме компонент Label,
компонент Timer и CommandButton. Также в
этом примере вам понадобится дополнительный
модуль.
'КОД МОДУЛЯ:
Public Type WI
TitleBarText As String
TitleBarLen As Integer
hWnd As Long
End Type
Public Declare Function GetWindowTextLength Lib "user32.dll" Alias
"GetWindowTextLengthA" (ByVal hWnd As Long) As Long
Public Declare Function EnumWindows Lib "user32.dll" (ByVal lpEnumFunc As Long,
ByVal lParam As Long) As Long
Public Declare Function GetWindowText Lib "user32.dll" Alias
"GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal nMaxCount
As Long) As Long
Public WinNum As Integer 'holds the number of windows examined
Public CurrentWindows(299) As WI 'holds information about all of the currently open
windows
Public Function EnumWindowsProc(ByVal hWnd As Long, ByVal lParam As Long) As Long
Dim WinInfo As WI 'holds information about the window currently being examined
Dim retval As Long 'holds the return value
Dim X As Integer
WinInfo.TitleBarLen = GetWindowTextLength(hWnd) + 1 'find the length of the title bar text
of the window currently being examined
If WinInfo.TitleBarLen > 0 And Len(hWnd) > 1 Then 'if the title bar text of the
window currently being examined is at least one character long AND the window's handle is
> 1
WinInfo.TitleBarText = Space(WinInfo.TitleBarLen) 'initialize the variable that will hold
the title bar text
retval = GetWindowText(hWnd, WinInfo.TitleBarText, WinInfo.TitleBarLen) 'retreive the
title bar text of the window currently being examined
WinInfo.hWnd = hWnd 'holds the value of this window's handle
CurrentWindows(WinNum).hWnd = WinInfo.hWnd 'store this window's handle in the current
windows array
CurrentWindows(WinNum).TitleBarText = WinInfo.TitleBarText 'store this window's title bar
text in the current windows array
WinNum = WinNum + 1 'increment the window counter
End If
EnumWindowsProc = 1 'continue enumeration of windows
End Function
'КОД ФОРМЫ
Option Explicit
Private 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
Private Const WM_CLOSE = &H10
Dim ExistingIEWindows(49) As Long 'holds the handles of all of the currently existing IE
windows (50 max)
Dim Flash As Integer 'holds the value that determines if the status text should flash
Private Sub Command1_Click()
If Command1.Caption = "Отключить мониторинг" Then
Timer1.Enabled = False
Command1.Caption = "Включить мониторинг"
Else
Timer1.Enabled = True
End If
End Sub
Private Sub Form_Load()
Timer1.Interval = 100
Command1.Caption = "Отключить мониторинг"
Dim X As Integer 'loop variable
Label1.Caption = "Initializing..."
Flash = 0
For X = 0 To 49 'reset/initialize the existing IE windows array
ExistingIEWindows(X) = 0
Next
Call GetExistingIEWindows
End Sub
Private Sub GetExistingIEWindows() 'this sub checks to see if any IE windows are currently
open, and "remembers" them if so.
Dim retval As Long 'holds the return value
Dim X As Integer, Y As Integer 'loop variables
Label1.Caption = "Examining currently active system windows..."
WinNum = 0 'initialize number of windows to zero
For X = 0 To 199 'reset/initialize the current windows array
CurrentWindows(X).hWnd = 0
CurrentWindows(X).TitleBarLen = 0
CurrentWindows(X).TitleBarText = ""
Next
retval = EnumWindows(AddressOf EnumWindowsProc, 0) 'enumerate all open windows
Y = 0
For X = 0 To WinNum - 1 'for each window that is currently open
If InStr(1, CurrentWindows(X).TitleBarText, "Microsoft Internet Explorer",
vbTextCompare) > 0 Then 'if this window is an IE window...
Label1.Caption = "Storing IE window handle..."
ExistingIEWindows(Y) = CurrentWindows(X).hWnd 'add this window to the list of existing IE
windows
Y = Y + 1
End If
Next
If Y > 0 Then 'if any of the existing system windows are IE windows
Label1.Caption = "Enabling popup monitoring..."
Timer1.Enabled = True 'enable the timer that checks for any new IE windows
Label1.Caption = "Monitoring for new IE windows..."
Else 'if none of the existing system windows are IE windows
Label1.Caption = "No IE windows found!"
MsgBox "There are currently no IE windows open!" & vbLf & vbLf &
"Please start Internet Explorer before running this program.", vbExclamation +
vbOKOnly, "Error" 'if no IE windows are found, display an error message
End 'exit this program
End If
End Sub
Private Sub Timer1_Timer()
Dim retval As Long 'holds the return value
Dim X As Integer, Y As Integer 'loop variables
Dim KillCount As Integer 'holds the value that determines if the current window should be
killed
WinNum = 0 'initialize number of windows to zero
For X = 0 To 199 'reset/initialize the current windows array
CurrentWindows(X).hWnd = 0
CurrentWindows(X).TitleBarLen = 0
CurrentWindows(X).TitleBarText = ""
Next
retval = EnumWindows(AddressOf EnumWindowsProc, 0) 'enumerate all open windows
For X = 0 To WinNum - 1 'for each window that is currently open
If InStr(1, CurrentWindows(X).TitleBarText, "Microsoft Internet Explorer",
vbTextCompare) > 0 Then 'if this window is an IE window...
KillCount = 0
For Y = 0 To 49
If ExistingIEWindows(Y) <> 0 Then 'if array value holds a valid handle
If ExistingIEWindows(Y) = CurrentWindows(X).hWnd Then 'if the window currently being
examined matches any of the existing IE windows
KillCount = KillCount + 1 'increment
End If
End If
Next
If KillCount = 0 Then 'if an IE window that did not previously exist was found
retval = PostMessage(CurrentWindows(X).hWnd, WM_CLOSE, ByVal CLng(0), ByVal CLng(0)) 'post
the window close message to the newly created IE window's message queue
End If
End If
Next
Flash = Flash + 1 'increment the flash value
If Flash = 5 Then 'make the status label flash every 0.5 seconds
Flash = 0
If Label1.Visible = True Then
Label1.Visible = False
Else
Label1.Visible = True
End If
End If
End Sub
|
|