Trapping Windows events

Iam working in windows XP.When user clicks internet explorer,my vb program should start.Much to say....when internet explorer starts running vb program.exe should start.Any ideas?

 

Thanks Shabbir.You mean to say I should use timer.In the timer i should check for IE, once found run the required function.Is it like that?If it is,i already done that.The problem is that by that way the process becomes slow.What i have done is.I have function check which will get all opened windows.Then i will check for windows title.If it is internet explorer the navigate to some url.But this process becomes slow.So I thought of another way like this where my program gets fired when user clicks internet explorer.For example systemdevicearrival function.This function fires when some device is inserted.Similary i want my program to fire when ie is clicked.Got it?

 

Code:

Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
Private Declare Function OpenIcon Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
'Declare Function OpenIcon Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function IsIconic Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
         
Const GW_HWNDPREV = 3
Private Const SW_SHOW = 5
Private Const SW_RESTORE = 9

Public serv As String
Const MAX_TOOLTIP As Integer = 64
Const NIF_ICON = &H2
Const NIF_MESSAGE = &H1
Const NIF_TIP = &H4
Const NIM_ADD = &H0
Const NIM_DELETE = &H2
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


Private Type NOTIFYICONDATA
    cbSize           As Long
    hWnd             As Long
    uID              As Long
    uFlags           As Long
    uCallbackMessage As Long
    hIcon            As Long
    szTip            As String * MAX_TOOLTIP
End Type
Private nfIconData As NOTIFYICONDATA
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Private Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
'Private Declare Function GetWindow Lib "user32" Alias "GetWindowA" (ByVal hwnd As Long, ByVal uCmd As Integer) 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 GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Public Sub ShowPrevInstance()
 
   Dim OldTitle As String
   Dim ll_WindowHandle As Long

   'saving the current title in OldTitle variable
   'and changing the application title
   OldTitle = App.title
   App.title = "Service running currently.This App Will Be Closed"

   'finding the previous instance. if you are using VB 5.0,
   'change "ThunderRT6Main" to "ThunderRT5Main"
   ll_WindowHandle = FindWindow("ieform1", OldTitle)

   'if there is no old instances of your application - exit.
   If ll_WindowHandle = 0 Then Exit Sub

   'Find the window we need to restore
   ll_WindowHandle = GetWindow(ll_WindowHandle, GW_HWNDPREV)

   'Now restore it
   Call OpenIcon(ll_WindowHandle)

   'And Bring it to the foreground
   Call SetForegroundWindow(ll_WindowHandle)
       
   'Call SetFocus(ll_WindowHandle)
    
   If IsIconic(ll_WindowHandle) Then
        Call ShowWindow(ll_WindowHandle, SW_RESTORE)
   Else
        Call ShowWindow(ll_WindowHandle, SW_SHOW)
   End If
End Sub
'Function FindWindowLike(hWndArray() As Variant, ByVal hWndStart As Variant, WindowText As String, Classname As String, ID) As Integer





'indwwindowlike(
'End Function
'Dim hwnd




Private Sub Form_Load()

If App.PrevInstance = True Then
ActivatePrevInstance
End
End If
'Dim objShellWinsld As SHDocVw.ShellWindows
'Set objShellWinsld = New SHDocVw.ShellWindows
'MsgBox objShellWinsld.Count


App.TaskVisible = False
On Error Resume Next

'Form1.mnustart
mnustart.Enabled = False
mnustop.Enabled = True


With nfIconData
    .hWnd = Me.hWnd
    .uID = Me.Icon
    .uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
    .uCallbackMessage = WM_MOUSEMOVE
    .hIcon = Me.Icon.Handle
    .szTip = "Doctor.com" & vbNullChar
    .cbSize = Len(nfIconData)
End With
Call Shell_NotifyIcon(NIM_ADD, nfIconData)
Timer1.Enabled = True
'Set objShellWins = New shdocvwShellWindows


End Sub
Sub ActivatePrevInstance()
         Dim OldTitle As String
         Dim PrevHndl As Long
         Dim result As Long

         'Save the title of the application.
         OldTitle = App.title

         'Rename the title of this application so FindWindow
         'will not find this application instance.
         App.title = "unwanted instance"

         'Attempt to get window handle using VB4 class name.
         PrevHndl = FindWindow("ThunderRTMain", OldTitle)

         'Check for no success.
         If PrevHndl = 0 Then
            'Attempt to get window handle using VB5 class name.
            PrevHndl = FindWindow("ThunderRT5Main", OldTitle)
         End If

         'Check if found
         If PrevHndl = 0 Then
         'Attempt to get window handle using VB6 class name
         PrevHndl = FindWindow("ThunderRT6Main", OldTitle)
         End If

         'Check if found
         If PrevHndl = 0 Then
            'No previous instance found.
            Exit Sub
         End If

         'Get handle to previous window.
         PrevHndl = GetWindow(PrevHndl, GW_HWNDPREV)

         'Restore the program.
         result = OpenIcon(PrevHndl)

         'Activate the application.
         result = SetForegroundWindow(PrevHndl)

         'End the application.
         Unload Me
      End Sub
Private Function check()

On Error Resume Next

Dim objShellWins As SHDocVw.ShellWindows

Dim objIE As SHDocVw.InternetExplorer
Dim buf As String * 1024
Dim title As String
Dim length As Long
Dim txt As String

Dim objDoc As Object
Dim i As Integer
Dim strOut As String
Dim intFree As Integer

Set objShellWins = New SHDocVw.ShellWindows


' If objIE.LocationURL <> "http://www.physician-to-go.net/" Then
'    objIE.Navigate2 ("http://www.physician-to-go.net/")
'
'End If



For Each objIE In objShellWins

length = GetWindowText(objIE.hWnd, buf, Len(buf))
title = Left$(buf, length)

If InStr(title, " - Microsoft Internet Explorer") > 0 Or InStr(title, " - Windows Internet Explorer") > 0 Or InStr(title, " - Mozilla Firefox") > 0 Then

MsgBox objIE.hWnd
If objIE.ToolBar() = True Then
    objIE.ToolBar() = False
End If

If objIE.AddressBar() = True Then
objIE.AddressBar() = False
End If





Dim a As Integer
a = InStr(1, objIE.LocationURL, "physician-to-go")
If a = 0 Then

    objIE.Navigate2 ("https://websrv01.physician-to-go.net/proxy.cgi/off/home/login.htm")

Else
'
End If
End If
Next objIE
err:

End Function



Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next
Dim lMsg As Single
'Dim mnufile As Menu
'
' Determine the event that happened to the System Tray icon.
' Left clicking the icon displays a message box.
' Right clicking the icon creates an instance of an object from an
' ActiveX Code component then invokes a method to display a message.
'
lMsg = X / Screen.TwipsPerPixelX
Select Case lMsg
    Case WM_LBUTTONUP
            'MsgBox "left click"
    Case WM_RBUTTONUP
    Dim hProcess As Long
GetWindowThreadProcessId hWnd, hProcess
            AppActivate hProcess
          Call PopupMenu(mnufile, vbPopupMenuLeftButton)
    Case WM_MOUSEMOVE
    Case WM_LBUTTONDOWN
    Case WM_LBUTTONDBLCLK
    Case WM_RBUTTONDOWN
    Case WM_RBUTTONDBLCLK
    Case Else
End Select
End Sub
Private Sub mnuFileArray_Click(Index As Integer)

    Select Case Index
        Case 0 'Option 1
            MsgBox "You've clicked on option1 - good for you!", _
                   vbInformation, App.ProductName & Me.Caption
                    
        Case 1 'Option 2
            MsgBox "You've clicked on option2 - great!", _
                   vbInformation, App.ProductName & Me.Caption
                    
        Case 4 'Option 1
            Unload Me
            End
     
    End Select
     
End Sub







Private Sub mnustart_Click()
'serv = "start"
            Form1.Timer1.Enabled = True
            Form1.mnustart.Enabled = False
            Form1.mnustop.Enabled = True
'frmLogin.Show
'frmLogin.txtUserName.Text = ""
'frmLogin.txtPassword.Text = ""
'frmLogin.txtUserName.SetFocus

End Sub

Private Sub mnustop_Click()
serv = "stop"
frmLogin.Show
frmLogin.txtUserName.Text = ""
frmLogin.txtPassword.Text = ""
frmLogin.txtUserName.SetFocus

End Sub

Private Sub Timer1_Timer()
check
End Sub

Private Sub uninstall_Click()
serv = "uninstall"
frmLogin.Show
frmLogin.txtUserName.Text = ""
frmLogin.txtPassword.Text = ""
frmLogin.txtUserName.SetFocus
End Sub

please check it out

 

So shabbir any ideas, how to make it faster?

 

The reason why i pasted complete lines is that in some forums it has been asked like that.Instead of only error lines,if complete program is there it will be easy to understand and my program is not a big one.No intentions that I should waste your time.If so,sorry for that and thanks for your effort.

 

I cant get you.

 

Yes thats what iam using.I changed the code little.After navigating the url, i added code
do while objie.readystate < READYSTATE_COMPLETED
i=i+1
loop
This code just helps not to navigate till the current page is loaded.May be this helps little.

 

My code was approved, anyhow I will try what u said.One more query is that all this code is working with internet explorer only not with mozilla since microsoft internet controls is used.How to make this work with mozilla browser too?