Go4Expert

Go4Expert (http://www.go4expert.com/)
-   Visual Basic ( VB ) (http://www.go4expert.com/forums/visual-basic/)
-   -   Trapping Windows events (http://www.go4expert.com/forums/trapping-windows-events-t2886/)

kumarangopi 6Feb2007 16:05

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?

shabbir 6Feb2007 16:18

Re: Trapping Windows events
 
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 6Feb2007 16:23

Re: Trapping Windows events
 
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 6Feb2007 17:11

Re: Trapping Windows events
 
I dont know why your program becomes slow. You should be using the thread with just one statement of FindWindow or FindWindowEx API.

kumarangopi 6Feb2007 17:14

Re: Trapping Windows events
 
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

shabbir 6Feb2007 18:15

Re: Trapping Windows events
 
Checked

kumarangopi 6Feb2007 18:29

Re: Trapping Windows events
 
So shabbir any ideas, how to make it faster?

shabbir 6Feb2007 21:09

Re: Trapping Windows events
 
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 7Feb2007 09:43

Re: Trapping Windows events
 
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 7Feb2007 10:55

Re: Trapping Windows events
 
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.


All times are GMT +5.5. The time now is 23:34.