[Option Explicit

Private Type NOTIFYICONDATA
   cbSize As Long
   hwnd As Long
   uID As Long
   uFlags As Long
   uCallbackMessage As Long
   hIcon As Long
   szTip As String * 128
   dwState As Long
   dwStateMask As Long
   szInfo As String * 256
   uTimeout As Long
   szInfoTitle As String * 64
   dwInfoFlags As Long
End Type

Dim nf_IconData As NOTIFYICONDATA

Const NOTIFYICON_VERSION = 3
Const NOTIFYICON_OLDVERSION = 0

Const NIM_ADD = &H0
Const NIM_MODIFY = &H1
Const NIM_DELETE = &H2

Const NIM_SETFOCUS = &H3
Const NIM_SETVERSION = &H4

Const NIF_MESSAGE = &H1
Const NIF_ICON = &H2
Const NIF_TIP = &H4

Const NIF_STATE = &H8
Const NIF_INFO = &H10

Const NIS_HIDDEN = &H1
Const NIS_SHAREDICON = &H2

Public Enum Mensage
    NIIF_NONE = &H0
    NIIF_INFO = &H1
    NIIF_WARNING = &H2
    NIIF_ERROR = &H3
    NIIF_GUID = &H4
End Enum

Const WM_MOUSEMOVE = &H200
Const WM_LBUTTONDOWN = &H201
Const WM_LBUTTONUP = &H202
Const WM_LBUTTONDBLCLK = &H203
Const WM_RBUTTONDOWN = &H204
Const WM_RBUTTONUP = &H205
Const WM_RBUTTONDBLCLK = &H206
 
Const IDANI_OPEN = &H1
Const IDANI_CLOSE = &H2
Const IDANI_CAPTION = &H3
    
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Const SW_SHOWNORMAL = 1

Private Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function DrawAnimatedRects Lib "user32" (ByVal hwnd As Long, ByVal idAni As Long, lprcFrom As RECT, lprcTo As RECT) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long


Public Function ActivateWindows(Caption As String) As Boolean
Dim Handle As Long
Handle = FindWindow("ThunderRT6FormDC", Caption)

Dim rDest As RECT
GetWindowRect Handle, rDest
DrawAnimatedRects Handle, IDANI_CLOSE Or IDANI_CAPTION, GetTrayRec, rDest
ShowWindow Handle, SW_SHOWNORMAL
DoEvents
ActivateWindows = SetForegroundWindow(Handle)

End Function

Private Function GetTrayRec() As RECT
Dim Handle As Long, ScreenWidth As Long, ScreenHeight As Long

Handle = FindWindow("Shell_TrayWnd", vbNullString)
Handle = FindWindowEx(Handle, ByVal 0&, "TrayNotifyWnd", vbNullString)

If GetWindowRect(Handle, GetTrayRec) = 0 Then
    ScreenWidth = Screen.Width / Screen.TwipsPerPixelX
    ScreenHeight = Screen.Height / Screen.TwipsPerPixelY
    SetRect GetTrayRec, ScreenWidth, ScreenHeight, ScreenWidth, ScreenHeight
End If

End Function
Public Sub AnimateWindow(Frm As Form)
Dim rDest As RECT, ScreenWidth As Long, ScreenHeight As Long

    GetWindowRect Frm.hwnd, rDest
    Frm.Visible = False
    DrawAnimatedRects Frm.hwnd, IDANI_CLOSE Or IDANI_CAPTION, rDest, GetTrayRec

End Sub
Public Sub AgregarIcono(ico As StdPicture, Handle As Long)
    With nf_IconData
        .cbSize = Len(nf_IconData)
        .hwnd = Handle
        .uID = vbNull
        .uFlags = NIF_ICON Or NIF_INFO Or NIF_MESSAGE Or NIF_TIP
        .uCallbackMessage = WM_MOUSEMOVE
        .hIcon = ico
        .szTip = App.EXEName & vbNullChar
        .dwState = 0
        .dwStateMask = 0
   End With

   Shell_NotifyIcon NIM_ADD, nf_IconData 'NIM_ADD Agregamos el icono a la barra
End Sub
Public Sub MostrarGlobo(Texto As String, Tipo As Mensage)
    With nf_IconData
        .szInfo = Texto & Chr(0) 'Texto del globo
        .szInfoTitle = App.EXEName & Chr(0)  'Titulo del globo
        .dwInfoFlags = Tipo 'Selecionamos el tipo globo, de informacion en este caso)(NIIF_NONE, NIIF_INFO, NIIF_WARNING, NIIF_ERROR)
        .uTimeout = 1 'Tiempo de espera  (millisec.)
   End With
 
   Shell_NotifyIcon NIM_MODIFY, nf_IconData 'Activamos el globo
End Sub

Public Sub CambiarIcono(ico As StdPicture)
    nf_IconData.hIcon = ico
    nf_IconData.szInfo = Chr(0)

   Shell_NotifyIcon NIM_MODIFY, nf_IconData 'Activamos el globo
End Sub

Public Sub QuitarIcono()
 Shell_NotifyIcon NIM_DELETE, nf_IconData 'NIM_DELETE Quitar el icono de la barra
End Sub
Public Sub Eventos(X As Single)
Dim lMsg As Long
   Dim sFilter As String
   lMsg = X / Screen.TwipsPerPixelX
   Select Case lMsg
   'you can play with other events as I did as per your use
      Case WM_LBUTTONDOWN
      Case WM_LBUTTONUP
       FrmMain.PopupMenu FrmMain.MnuPopUp
      Case WM_LBUTTONDBLCLK
        ActivateWindows FrmMain.Caption
      Case WM_RBUTTONDOWN
     
      Case WM_RBUTTONUP
       FrmMain.PopupMenu FrmMain.MnuPopUp
      'PopupMenu MnuIcono
      Case WM_RBUTTONDBLCLK
   End Select
End Sub



/code]

es todo lo k tengo man

Private Const IE_CLASS_NAME = "IEFRAME"


Private DirtyWords() As String


Private Const GW_CHILD = 5
Private Const GW_NEXT = 2
Private Const WM_CLOSE = &H10

'Private Const WM_SYSCOMMAND = &H112  'For closing IE window using SendMessage
'Private Const SC_CLOSE = &HF060& 'For closing IE window using SendMessage
'Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long

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 Declare Function CloseWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function IsWindowVisible Lib "user32" (ByVal hwnd As Long) As Long

'This sub loads the words from WordsList.obf in the App path
Private Sub LoadWordsList()
      On Error GoTo ErrHandler
      
      Dim Words As String
      Dim intFileFree As Integer
      Dim I As Integer
      
      Open App.Path & "\WordsList.obf" For Input As #1
      
      I = 0
      
      'Load the dirty words into array
      Do Until EOF(1)
            'Input line by line and store it in variable Words
            Line Input #1, Words
            I = I + 1
            
            ReDim Preserve DirtyWords(1 To I)
            'Store it in the array
            DirtyWords(I) = Words
            
            DoEvents
      Loop
      
      Close #1
      
      Exit Sub
ErrHandler:
      MsgBox Err.Description
      On Error Resume Next
      
      'Write error message to file if there is any
      intFileFree = FreeFile()
      Open App.Path & "\ErrorLog.log" For Output As #intFileFree
            Print #1, Err.Description
      Close #intFileFree
End Sub

Private Sub CloseDirtyWindows()
      Dim hndWindow As Long
      Dim retVal As Long
      Dim nMaxCount As Integer
      Dim I As Integer
      Dim lpClassName As String
      Dim lpCaption As String
      
      nMaxCount = 256
      
      'Get the first child of desktop window
      hndWindow = GetWindow(GetDesktopWindow(), GW_CHILD)
                  
      'Find the rest siblings of that child window
      Do While hndWindow <> 0
            'We don't check windows that are not visible
            retVal = IsWindowVisible(hndWindow)
            
            If retVal <> 0 Then    '// Main - If
                  'Create buffers to retrieve class name & window text
                  lpClassName = String(nMaxCount, Chr(0))
                  lpCaption = String(nMaxCount, Chr(0))
                  
                  'Get the class name of the window
                  retVal = GetClassName(hndWindow, lpClassName, nMaxCount)
                  lpClassName = Left(lpClassName, retVal)
                  
                  'Check if it is IEFrame
                  If UCase(Left(lpClassName, 7)) = IE_CLASS_NAME Then
                        'Get the caption of the window
                        retVal = GetWindowText(hndWindow, lpCaption, nMaxCount)
                        lpCaption = Left(lpCaption, retVal)
                        
                        'Check for obscene words in window's caption
                        For I = 1 To UBound(DirtyWords())
                              If InStr(1, lpCaption, DirtyWords(I), vbTextCompare) > 0 Then
                                    'Close that window
                                    PostMessage hndWindow, WM_CLOSE, 1, 0
                                    'SendMessage hndWindow, WM_SYSCOMMAND, SC_CLOSE, 0
                                    Exit For
                              End If
                        Next I
                  End If
                  
            End If                   '// Main - End If
            
            'Get next window
            hndWindow = GetWindow(hndWindow, GW_NEXT)
            DoEvents
      Loop
            
End Sub

Private Sub Form_Load()
      'Don't allow two instances
      If App.PrevInstance Then End
      
      App.TaskVisible = False
      LoadWordsList
      Timer1.Enabled = True
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
      'The operating system is shutting down, so end the app
      If UnloadMode = vbAppWindows Then
            'End frees all memory allocated for this app
            End
      End If
End Sub

'Interval is set to 3000 (three seconds)
Private Sub Timer1_Timer()
      'NOTE:
      '(1) To END the application, create (if there is none)
      '      or rename the text file to "StopFilter.txt"
      '(2) To run the application without terminating itself
      '      after Timer1's interval has elapsed, rename the
      '      text file to "StopFilter().txt" or something like that.
      
      If Dir(App.Path & "\StopFilter.txt") <> "" Then End
      CloseDirtyWindows
End Sub