Wednesday, July 1, 2009

How can I write a VB 6.0 program showing icons in Systray?

Hey, Programming Guy! How can I write a program showing an icon in system tray automatically involve the notepad.exe to open a file, sending keys to close the notepad and check if any virus such as W32.virut.CF has modified an html file?
- K.O.

Option Explicit
Dim Counter
' Type passed to Shell_NotifyIcon
Private Type NotifyIconData
Size As Long
Handle As Long
ID As Long
Flags As Long
CallBackMessage As Long
Icon As Long
Tip As String * 64
End Type

' Constants for managing System Tray tasks, foudn in shellapi.h
Private Const AddIcon = &H0
Private Const ModifyIcon = &H1
Private Const DeleteIcon = &H2

Private Const WM_MOUSEMOVE = &H200
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202

Private Const WM_RBUTTONDBLCLK = &H206
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205

Private Const MessageFlag = &H1
Private Const IconFlag = &H2
Private Const TipFlag = &H4

Private Declare Function Shell_NotifyIcon _
Lib "shell32" Alias "Shell_NotifyIconA" ( _
ByVal Message As Long, Data 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 PostMessage Lib "user32" _
Alias "PostMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Long) As Long



Const WM_CLOSE = &H10
Private Data As NotifyIconData


Private Sub Form_Load()

If App.PrevInstance Then
MsgBox "The checking has been started alreay.", vbCritical
End
End If
Counter = 10
AddIconToTray
Visible = False
End Sub

Private Sub Form_Terminate()
DeleteIconFromTray
End Sub

Private Sub AddIconToTray()

Data.Size = Len(Data)
Data.Handle = hwnd
Data.ID = vbNull
Data.Flags = IconFlag Or TipFlag Or MessageFlag
Data.CallBackMessage = WM_MOUSEMOVE
Data.Icon = Icon
Data.Tip = "Checking Files" & vbNullChar
Call Shell_NotifyIcon(AddIcon, Data)

End Sub

Private Sub DeleteIconFromTray()
Call Shell_NotifyIcon(DeleteIcon, Data)
End Sub

Private Sub Form_MouseMove(Button As Integer, _
Shift As Integer, X As Single, Y As Single)

Dim Message As Long
Message = X / Screen.TwipsPerPixelX

Select Case Message
Case WM_LBUTTONDBLCLK
Visible = Not Visible
WindowState = Abs(Not Visible)
End Select
End Sub

Private Sub Timer1_Timer()
Dim UIHandle As Long
Dim tmp As String, content As String
Dim n As Integer
Counter = Counter - 1
If Counter = 0 Then
Timer1.Interval = 60000
Counter = 10
Shell "Notepad.exe c:\test.html", vbNormalFocus

UIHandle = FindWindow(vbNullString, "test.html - Notepad")
PostMessage UIHandle, WM_CLOSE, 0&, 0&
content = ""

n = FreeFile
Open "C:\test.html" For Input As #n
Do While Not EOF(1)
Line Input #n, tmp
content = content & tmp
Loop
Close #n
If InStr(1, content, "<" & "iframe") > 0 Then MsgBox "Virus found! Please contact IT Staff!", vbCritical, "Virus Checker"
End If
End Sub

No comments: