Trapping Windows events
|
Light Poster
|
|
| 6Feb2007,16:05 | #1 |
|
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?
|
|
Go4Expert Founder
|
![]() |
| 6Feb2007,16:18 | #2 |
|
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.
|
|
Light Poster
|
|
| 6Feb2007,16:23 | #3 |
|
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?
|
|
Go4Expert Founder
|
![]() |
| 6Feb2007,17:11 | #4 |
|
I dont know why your program becomes slow. You should be using the thread with just one statement of FindWindow or FindWindowEx API.
|
|
Light Poster
|
|
| 6Feb2007,17:14 | #5 |
|
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
Last edited by shabbir; 6Feb2007 at 18:14.. Reason: Code formatting. |
|
Go4Expert Founder
|
![]() |
| 6Feb2007,18:15 | #6 |
|
Checked
|
|
Light Poster
|
|
| 6Feb2007,18:29 | #7 |
|
So shabbir any ideas, how to make it faster?
|
|
Go4Expert Founder
|
![]() |
| 6Feb2007,21:09 | #8 |
|
Quote:
Originally Posted by kumarangopi |
|
Light Poster
|
|
| 7Feb2007,09:43 | #9 |
|
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.
|
|
Go4Expert Founder
|
![]() |
| 7Feb2007,10:55 | #10 |
|
Quote:
Originally Posted by kumarangopi As I explained why your operation should not take long should be clear to you. |

