tambien pueden usar una dll como ultimo recurso. existe una llamada hp.dll q esconde el proceso de el administrador de tareas.. espero q sirva saludos
Esta sección te permite ver todos los mensajes escritos por este usuario. Ten en cuenta que sólo puedes ver los mensajes escritos en zonas a las que tienes acceso en este momento.
Mostrar Mensajes Menú[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