Trapping Windows events

kumarangopi's Avatar, Join Date: Feb 2007
Light Poster
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?
shabbir's Avatar, Join Date: Jul 2004
Go4Expert Founder
You need to have some hidden process which should run all the time and when you find the IE you should launch your own some other App or some GUI of the current app.
kumarangopi's Avatar, Join Date: Feb 2007
Light Poster
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?
shabbir's Avatar, Join Date: Jul 2004
Go4Expert Founder
I dont know why your program becomes slow. You should be using the thread with just one statement of FindWindow or FindWindowEx API.
kumarangopi's Avatar, Join Date: Feb 2007
Light Poster
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

Last edited by shabbir; 6Feb2007 at 18:14.. Reason: Code formatting.
shabbir's Avatar, Join Date: Jul 2004
Go4Expert Founder
Checked
kumarangopi's Avatar, Join Date: Feb 2007
Light Poster
So shabbir any ideas, how to make it faster?
shabbir's Avatar, Join Date: Jul 2004
Go4Expert Founder
Quote:
Originally Posted by kumarangopi
So shabbir any ideas, how to make it faster?
Do you think anybody can help you who dont even bother to help us by giving the code snippets that can be a problematic one. Instead pasting the content of all the files here is not what can help you along.
kumarangopi's Avatar, Join Date: Feb 2007
Light Poster
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.
shabbir's Avatar, Join Date: Jul 2004
Go4Expert Founder
Quote:
Originally Posted by kumarangopi
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.
Its not about wasting the time because I dont waste time here but help people in to get some help.

As I explained why your operation should not take long should be clear to you.