Visual Basic, .NET, ASP, VBA, VBScript
 
  Библиотека кодов  
  Интернет/Почта/Сеть  
     
  Запрещение запуска дополнительных окон IE  
  Данный пример запретит запуск дополнительных окон броузера ИнтернетЭксплорер. Этот пример хорош для борьбы с рекламными окошками, запускаемыми автоматически на тех или иных сайтах.

Что делает пример: 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
 
     
  VBNet online (всего: 51585)  
 

Логин:

Пароль:

Регистрация, забыли пароль?


В чате сейчас человек
 
     
  VBNet рекомендует  
   
     
  Лучшие материалы  
 
ActiveX контролы (112)
Hitman74_Library (36119)
WindowsXPControls (20739)
FlexGridPlus (19374)
DSMAniGifControl (18295)
FreeButton (15157)
Примеры кода (546)
Parol (18027)
Passworder (9299)
Screen saver (7654)
Kerish AI (5817)
Folder_L (5768)
Статьи по VB (136)
Мое второе впечатление... (11236)
VB .NET: дорога в будущее (11161)
Основы SQL (9225)
Сообщения Windows в Vi... (8788)
Классовая теория прогр... (8619)
 
     
Техническая поддержка MTW-хостинг | © Copyright 2002-2011 VBNet.RU | Пишите нам