Please help, IE window DOM (by focus) automation error
parks...@fairpoint.net
Please can someone help me out.
I am trying to get access to any IE browser window that comes into
focus so I can use it's DOM for voice synthesising.
I can get the current browser window focus.
I set the objDoc to the browser's object and can access the DOM.
BUT
When I close the browser window that has focus (and the objDoc is
linked to) and switch focus to another browser window it crashes.
(I think the ObjDoc (object I use to connect) is messed up when the
browser window closes.. It doesn't happen all the time, but it does
happen a lot (and usually when I close all the browser windows and
either before or as I open a new one)
The error is,
Run-time error '-2147023174 (800706ba)':
Method 'objDoc' of object 'Form1' failed
So I set the objDoc in the debug, watch and when it crashes I double
click it and get this message,
"Connection to type library or object library for remote process has
been lost. Press OK for dialog to remove reference"
When it crashes (as I mention above) the error takes place anywhere
that the objDoc is being set (I have tried setting it to Nothing
before calling the Command1_Click sub and it crashes there.
NOW
I tested and it does NOT (I think) crash if I remove the WithEvents
form objDoc declaration. But I need the events so I can retrieve the
mouse position in the browser.
I have tried installing all the latest MSAA, MDAC, Jet from MS.
I am using VB5 Pro.
Any help would be great, I am stuck
Mike
****
Form has
A Timer1 (interval 200, enabled)
A Command1 button
A multiline Text1 textbox
Refrence to Microsoft HTML Object Libraries
[CODE]
Option Explicit
Private Type UUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
Private Declare Function FindWindow Lib "User32" Alias
"FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As
String) As Long
Private Declare Function FindWindowEx Lib "User32" Alias
"FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1
As String, ByVal lpsz2 As String) As Long
Private Declare Function ObjectFromLresult Lib "oleacc" (ByVal lResult
As Long, riid As UUID, ByVal wParam As Long, ppvObject As Any) As Long
Private Declare Function RegisterWindowMessage Lib "User32" Alias
"RegisterWindowMessageA" (ByVal lpString As String) As Long
Private Declare Function SendMessageTimeout Lib "User32" Alias
"SendMessageTimeoutA" (ByVal hwnd As Long, ByVal Msg As Long, ByVal
wParam As Long, lParam As Any, ByVal fuFlags As Long, ByVal uTimeout
As Long, lpdwResult As Long) As Long
Private Declare Function GetClassName Lib "User32" (ByVal hwnd As _
Integer, ByVal lpClassName As String, ByVal nMaxCount As _
Integer) As Integer
Private Declare Function GetWindowText Lib "User32" Alias
"GetWindowTextA" (ByVal hwnd As _
Integer, ByVal lpString As String, ByVal aint As Integer) As
_
Integer
Private Declare Function GetForegroundWindow Lib "user32.dll" () As
Long
Private Const SMTO_ABORTIFHUNG = &H2
Public WithEvents objDoc As HTMLDocument
' Create a web document object to control browser
'Private mhtmDoc3 As IHTMLDocument3
'Private WithEvents objDoc As HTMLDocument
Dim FocusHwnd As Long
Dim CurrentFocusWindowTitle As String * 255
Dim LastFocusWindowTitle As String * 255
Dim mx, my
Private Sub Command1_Click()
Dim hwnd As Long
'"coozzzzz - coozzzzz" is the title of the IM window
hwnd = FindWindow("IEFrame", CurrentFocusWindowTitle)
hwnd = FindWindowEx(hwnd, 0, "Shell DocObject View", vbNullString)
hwnd = FindWindowEx(hwnd, 0, "Internet Explorer_Server",
vbNullString)
If hwnd > 0 Then
Set objDoc = WindowDOM(hwnd)
If Not (objDoc Is Nothing) Then
Text1.Text = objDoc.body.innerText
LastFocusWindowTitle = CurrentFocusWindowTitle
End If
End If
End Sub
Private Function WindowDOM(ByVal hwnd As Long) As IHTMLDocument
Dim typUUID As UUID, lngRes As Long, lngMsg As Long
lngMsg = RegisterWindowMessage("WM_HTML_GETOBJECT")
If lngMsg <> 0 Then
Call SendMessageTimeout(hwnd, lngMsg, 0, 0, SMTO_ABORTIFHUNG,
1000, lngRes)
If lngRes <> 0 Then
With typUUID
.Data1 = &H626FC520
.Data2 = &HA41E
.Data3 = &H11CF
.Data4(0) = &HA7
.Data4(1) = &H31
.Data4(2) = &H0
.Data4(3) = &HA0
.Data4(4) = &HC9
.Data4(5) = &H8
.Data4(6) = &H26
.Data4(7) = &H37
End With
Call ObjectFromLresult(lngRes, typUUID, 0, WindowDOM)
End If
End If
End Function
Private Sub Timer1_Timer()
Dim a As Long
FocusHwnd = GetForegroundWindow
a = GetWindowText(FocusHwnd, CurrentFocusWindowTitle,
Len(CurrentFocusWindowTitle))
If (CurrentFocusWindowTitle <> LastFocusWindowTitle) Then
Command1_Click
End If
End Sub
[/CODE]
Larry Serflaten
<parks...@fairpoint.net> wrote
> I have been beating my head against this for days...
> Please can someone help me out.
>
> I am trying to get access to any IE browser window that comes into
> focus so I can use it's DOM for voice synthesising.
>
> When I close the browser window that has focus (and the objDoc is
> linked to) and switch focus to another browser window it crashes.
> (I think the ObjDoc (object I use to connect) is messed up when the
> browser window closes.. It doesn't happen all the time, but it does
> happen a lot (and usually when I close all the browser windows and
> either before or as I open a new one)
Your application will have to deal with the situation where no browser
is present. You either set a flag to indicate the Doc reference is not
valid and test that before using the Doc reference, or you test whether
your reference is Nothing before any command that uses that Doc ref.
Perhaps this will help you get the logic down. To a new project add
References to:
Microsoft Shell Controls and Automation
Microsoft Internet Controls
Add a Timer to the form then paste in the code below and try it out....
HTH
LFS
Option Explicit
Private WithEvents IE As InternetExplorer
Private reAcquire As Boolean
Private Sub Form_Load()
Timer1.Interval = 1000
Timer1.Enabled = False
Acquire
End Sub
Private Sub IE_BeforeNavigate2(ByVal pDisp As Object, URL As Variant, Flags As Variant, TargetFrameName As Variant, PostData As
Variant, Headers As Variant, Cancel As Boolean)
Debug.Print "Navigating (doc invalid)"
reAcquire = True
End Sub
Private Sub IE_DocumentComplete(ByVal pDisp As Object, URL As Variant)
If reAcquire Then Acquire
End Sub
Private Sub IE_OnQuit()
Debug.Print "Quit"
Set IE = Nothing
Timer1.Enabled = True
End Sub
Private Sub IE_WindowClosing(ByVal IsChildWindow As Boolean, Cancel As Boolean)
Debug.Print "Close"
Set IE = Nothing
Timer1.Enabled = True
End Sub
Private Sub Timer1_Timer()
Timer1.Enabled = False
Acquire
End Sub
Sub Acquire()
Dim shl As ShellWindows
Dim obj As InternetExplorer
reAcquire = False
Set shl = New ShellWindows
Set IE = Nothing
For Each obj In shl
If TypeName(obj.document) = "HTMLDocument" Then
Set IE = obj
End If
Next
If Not IE Is Nothing Then
Debug.Print "Using: ", IE.document.Title
Else
Debug.Print "No InternetExplorer Windows available."
Timer1.Enabled = True
End If
End Sub
parks...@fairpoint.net
I am going over the code.
I see how it is clearing the obj.
I did have a couple of more questions :D
1) It pops up with a Automation Error (same as I mention) when all
browser windows are closed and then one is opened... but it isn't
locking the obj up so I did this,
On Error GoTo ErrorJump
If TypeName(obj.Document) = "HTMLDocument" Then
On Error GoTo 0
around the test IF statement (that is where it would error) and I send
it to the last set of IF's in that sub.
So is that allright?
2) I have to grab the window in focus... is there anything I can
compare between the obj and the API FindWindow (or such)? I thought
about using the hWnd of the obj but I know those can change...
But I can't think of anything else that is a sure check (since anyone
can have as many windows open to the same URL I can't use
document.title).
Thank you for all the help,
Mike
Larry Serflaten
<parks...@fairpoint.net> wrote
> On Error GoTo ErrorJump
> If TypeName(obj.Document) = "HTMLDocument" Then
> On Error GoTo 0
>
> around the test IF statement (that is where it would error) and I send
> it to the last set of IF's in that sub.
> So is that allright?
I thought I covered that, but I find that I tested that sceanareo with
my browser that opens up to 'about:blank" as the homepage. If you
have a different home page, or you click a link then the browser is still
navigating when it hits that loop. "About:Blank" happened so fast that
it wasn't a problem. For that situation, my preference would be to
test if the document is ready, something like:
For Each obj In shl
If Not obj.Document Is Nothing Then
If TypeName(obj.Document) = "HTMLDocument" Then
Set IE = obj
End If
End If
Next
> 2) I have to grab the window in focus... is there anything I can
> compare between the obj and the API FindWindow (or such)? I thought
> about using the hWnd of the obj but I know those can change...
Its not likely to change while that window is in the foreground. Try it and
see if it will fill the bill (but again the foreground window may not always be
an Explorer type application):
Option Explicit
' Ref MS Internet Controls ....
Private shl As ShellWindows
Private Declare Function GetForegroundWindow Lib "user32.dll" () As Long
Private Sub Form_Load()
Set shl = New Shellwindows
Timer1.Interval = 1000
Timer1.Enabled = True
End Sub
Private Sub Timer1_Timer()
Dim itm, hw As Long
hw = GetForegroundWindow()
For Each itm In shl
If hw = itm.hWnd Then
Debug.Print itm.hWnd, itm.LocationName
End If
Next
End Sub
parks...@fairpoint.net
I can't find a way around using the On Error, and here is why.
(I numbered the lines below)
---------------
Sub Acquire()
1) Dim shl As ShellWindows
2) Dim obj As InternetExplorer
3) reAcquire = False
4) Set shl = New ShellWindows
5) Set IE = Nothing
6) For Each obj In shl
7) If Not obj.Document Is Nothing Then
8) If TypeName(obj.Document) = "HTMLDocument" Then
9) Set IE = obj
10) End If
11) End If
12) Next
13) If Not IE Is Nothing Then
14) Debug.Print "Using: ", IE.document.Title
15) Else
16) Debug.Print "No InternetExplorer Windows available."
17) Timer1.Enabled = True
18) End If
End Sub
-----------------
(Let me first say for testing I inserted a loop delay in so I could
trigger the error easier, meaning if it was running full speed then I
can still trigger the error if I catch it just right, but with the
loop I can trigger it without having to try over and over again)
(I am explaining it as I understand it, if I am wrong please correct
me)
Line 6 and Line 12 - Will sometimes error because shl.count has
changed before the loop could end (a window is closed during the
loop). I figured if I stored the shl.count before I enter the loop and
then test it before allowing it to reiterate then I can prevent it
from crashing at this point.
I found that even with my test right after the FOR and before the
NEXT, it would still sometimes trigger an error at these points.
Lines 7, 8 and 9 it can crash on because I am referencing the obj and
if that browser has been closed it will crash it (since the obj is no
longer connected to a valid window).
I even went to the point of removing the "For each obj in shl" with a
do until loop (setting obj to the shl with an incrementing the item
index). I did this thinking I could trap the loop easier since the
loop itself would not cause an error. This still did not work.
It appears to me that there is no way to stop the obj from pointing to
an invalid window (one closed within the loop). I had the test line
(that would break the loop) right above a line that used the obj and
it still would get by.
Have I explained what the process right? And is there anything besides
an On Error that can trap this?
Thank you for your time helping me on this,
Mike
parks...@fairpoint.net
If would even get by and IF..Else..
If(..<>...) then
exit for
else
set obj=.....
end if
It would get by the IF that should trap it and crash at the SET.
(sorry some of the sentences in my last post are broken up, I tried to
edit it after typing it to make it clearer and left some sentences
fragmented)
Mike
mayayana
> I am trying to get access to any IE browser window that comes into
> focus so I can use it's DOM for voice synthesising.
>
Maybe it would help if you explained that more.
From the info. you've posted it doesn't seem to
make sense, chasing IE instances all over the screen
while someone is apparently opening and closing them
very quickly.
But you said you want to "use it's DOM for voice
synthesising". Can't you use SAPI 5? That's installable,
and I think it's pre-installed on XP. It also has a
very easy object model.
parks...@fairpoint.net
But it has nothing to do with the browser.
I am reading the in focus browser's DOM (text, element under mouse,
etc.) to use with SAPI 5.
Thank you
Michael
mayayana
SAPI 5 is for voice synthesizing, which I am using.
But it has nothing to do with the browser.
I am reading the in focus browser's DOM (text, element under mouse,
etc.) to use with SAPI 5.
>
I see. I don't know whether you can use this,
but it may work:
www.jsware.net/jsware/vbcode.php3#acc
The link is to a VB sample of Active Accessibility
code. In the AA Events folder of the download zip
is a project that uses AA's SetWinEventHook to
trap changes in the system. The demo project uses
SAPI 5 to read current operations from the active
window. If you open numerous versions of IE and
switch between them, you'll get spoken descriptions
of what's happening.
That gets you the active window activity. The callback
also sends in the hWnd of the window that had an event.
So you might be able to mix that with the ShellWindows
code, or better yet, call EnumChildWindows on the hWnd
to check for a child of class Internet Explorer_Server
without a child of class SHELLDLL_DefView. (SHELLDLL_DefView
indicates an explorer window. On pre-XP systems there's
an IE window - Internet Explorer_Server class - below that.
On XP the Webview is fake, so there's no actual IE window
in folders and you'd only need to check for Internet Explorer_Server,
but if you want to run on other systems you'll need to check
for both in order to weed out open folders. SHELLDLL_DefView
is above Internet Explorer_Server, so you could set up your
EnumChildProc callback to quit if it gets a SHELLDLL_DefView
or return true if it gets an Internet Explorer_Server.)
I haven't tried this, but you might be able to do something
in the SetWinEventHook callback like the following, where you're
saving the hWnd value coming in so that you know when the
active window has changed:
If newHWND <> oldHWND
Set Doc = Nothing
' then do the EnumChildWindows here
' If you've got an IE, get the new Doc.
End if
Larry Serflaten
> I can't find a way around using the On Error, and here is why.
> (I numbered the lines below)
I find it surprising to hear that a reference can be in the ShellWindows
collection, yet be invalid when you go to use it. I guess timing is critical....
None the less, do not hesitate to add error handling as you see fit. If you
are trying to get your app to respond to all circumstances that may happen,
adding error handling is unavoidable, and it just makes good sense to trap
errors and fail gracefully, rather than let Windows catch the error and close
your app.
LFS
mayayana
If you end up using the AA hook to keep track
of active IE instances, you can use the following function
to return a Document object from the hWnd sent in
by the hook callback. It will return a Doc. from any
window of class InternetExplorer_Server (a browser
window). Between the AA hook and this function
you should be able to avoid constantly iterating
through the Shell Windows collection, which is really
best suited to scripting.
This code is rather odd, but it works. I think
it might have come originally from Eduardo Morcillo:
-------------- begin code -------------
Private Const SMTO_ABORTIFHUNG = &H2
Private Type UUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
Private Declare Function ObjectFromLresult Lib "oleacc" (ByVal lResult As
Long, riid As UUID, ByVal wParam As Long, ppvObject As Any) As Long
Private Declare Function RegisterWindowMessage Lib "user32" Alias
"RegisterWindowMessageA" (ByVal lpString As String) As Long
Private Declare Function SendMessageTimeout Lib "user32" Alias
"SendMessageTimeoutA" (ByVal hWnd As Long, ByVal msg As Long, ByVal wParam
As Long, lParam As Any, ByVal fuFlags As Long, ByVal uTimeout As Long,
lpdwResult As Long) As Long
Private Function GetIEDoc(ByVal H2 As Long, Success As Boolean) As
IHTMLDocument
Dim IID_IHTMLDocument2 As UUID
Dim LMsg As Long, LRes As Long, LRet As Long, H2 As Long
Success = False
LMsg = RegisterWindowMessage("WM_HTML_GETOBJECT")
LRet = SendMessageTimeout(H2, LMsg, 0, 0, SMTO_ABORTIFHUNG, 1000, LRes)
If LRes = 0 Then Exit Function
With IID_IHTMLDocument2
.Data1 = &H332C4425
.Data2 = &H26CB
.Data3 = &H11D0
.Data4(0) = &HB4
.Data4(1) = &H83
.Data4(2) = &H0
.Data4(3) = &HC0
.Data4(4) = &H4F
.Data4(5) = &HD9
.Data4(6) = &H1
.Data4(7) = &H19
End With
LRet = ObjectFromLresult(LRes, IID_IHTMLDocument2, 0, GetIEDoc)
If LRet = 0 Then Success = True
End Function
------------ end code ---------------
parks...@fairpoint.net
The sample you posted even has a note in it from whoever did it saying
they gave up trying to use AA since there was not enough documentation
for VB and that the whole AA system seemed incomplete.
Mike
mayayana
The sample you posted even has a note in it from whoever did it saying
they gave up trying to use AA since there was not enough documentation
for VB and that the whole AA system seemed incomplete.
>
AA is limited. It seems that Microsoft just never
bothered to flesh it out.
I wrote that sample code and I did give up on
writing a screen reader. That was partly because
AA is incomplete and partly because the screen
reader project was mainly for a blind friend who
ended up getting a state-subsidized copy of
Jaws. :)
My impression is that screen readers, to this day,
are still written using lots of little hacks. My blind
friend deals with a lot of frustration trying to read
a webpage.
Nevertheless, oleacc.dll has some interesting
and useful stuff in it that's unique because it was
designed for AA uses. I don't know of anything
comparable to SetWinEventHook in the "normal"
API. And the method of getting an IE Doc is also
unique, not available from the basic API. The code
available should do what you want. But...suit yourself.
mayayana
directly. Also, I forgot to list the needed references
for a sample project I've included here.
I got curious and started playing with this. The project below
is a bit rough and quick, but it successfully returns the
body.innertext of whatever IE window is active.
To test the code, create a form named Form1 with a multi-line
textbox named T1 and a single-line textbox named TPath.
Also create 2 buttons, bHook and bUnhook. Then add a module.
References: Microsoft HTML object library - mshtml.tlb
Accessibility - oleacc.dll
Starting the project, click the Hook button. Then select various IE
windows to bring them to foreground. The multiline textbox will
display the body.innertext of the selected IE loaded webpage
and TPath will show the document path. When focus is lost,
the textboxes are cleared.
I don't know whether this will accomplish what you need,
and there are still lots of little issues, like not getting a page with
frames, for instance. But it has no problem switching between
IE instances, and dealing with closed IE windows, without crashing.
And the system is informing you of what's happening, so you don't
need timers.
Project Code: (Watch out for wordwrap)
F1 form code:
' ----------------
Option Explicit
Private Sub bHook_Click()
Hook
End Sub
Private Sub bUnhook_Click()
UnHook
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Set Doc1 = Nothing
UnHook
End Sub
'------------------------
Mod1 .bas module code:
'--------------------------
Option Explicit
Private Const SMTO_ABORTIFHUNG = &H2
Public Const SYS_FOREGROUND = 3&
Public Const SYS_CAPTURESTART = 8&
Public Const SYS_CAPTUREEND = 9&
Public Const WINEVENT_SKIPOWNPROCESS = 2& ' Don't call back for events on
installer's process
Private Const SDV As String = "SHELLDLL_DefView"
Private Const IES As String = "Internet Explorer_Server"
Private Type UUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
Public Declare Function AccessibleObjectFromEvent Lib "oleacc" (ByVal hWnd
As Long, ByVal dwId As Long, ByVal dwChildId As Long, ppacc As IAccessible,
pvarChild As Variant) As Long
Public Declare Function SetWinEventHook Lib "user32.dll" (ByVal eventMin As
Long, ByVal eventMax As Long, ByVal hmodWinEventProc As Long, ByVal
pfnWinEventProc As Long, ByVal idProcess As Long, ByVal idThread As Long,
ByVal dwFlags As Long) As Long
Public Declare Function UnhookWinEvent Lib "user32.dll" (ByVal lHandle As
Long) As Long
Private Declare Function ObjectFromLresult Lib "oleacc" (ByVal lResult As
Long, riid As UUID, ByVal wParam As Long, ppvObject As Any) As Long
Private Declare Function RegisterWindowMessage Lib "user32" Alias
"RegisterWindowMessageA" (ByVal lpString As String) As Long
Private Declare Function SendMessageTimeout Lib "user32" Alias
"SendMessageTimeoutA" (ByVal hWnd As Long, ByVal msg As Long, ByVal wParam
As Long, lParam As Any, ByVal fuFlags As Long, ByVal uTimeout As Long,
lpdwResult As Long) As Long
Private Declare Function GetClassName Lib "user32.dll" Alias "GetClassNameA"
(ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long)
As Long
Private Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As
Long, ByVal lpEnumFunc As Long, lParam As Long) As Long
Private sClassName As String
Private hCur As Long
Public Doc1 As IHTMLDocument2
Public LHook As Long
Public hWinCur As Long
Public Sub Hook()
Dim LRet As Long
LHook = SetWinEventHook(SYS_FOREGROUND, SYS_CAPTUREEND, 0&, AddressOf
WinEventFunc, 0, 0, WINEVENT_SKIPOWNPROCESS)
End Sub
Public Sub UnHook()
Dim LRet As Long
If LHook = 0 Then Exit Sub
LRet = UnhookWinEvent(LHook)
End Sub
Public Function WinEventFunc(ByVal HookHandle As Long, ByVal LEvent As Long,
ByVal hWnd As Long, ByVal idObject As Long, ByVal idChild As Long, ByVal
idEventThread As Long, ByVal dwmsEventTime As Long) As Long
Dim ObA As IAccessible
Dim LRet As Long, hWin As Long
Dim V As Variant
Dim s As String, s1 As String, sName As String
Dim Boo1 As Boolean
On Error Resume Next
If hWinCur = hWnd And Not (Doc1 Is Nothing) Then Exit Function
Select Case LEvent
Case SYS_CAPTURESTART, SYS_FOREGROUND
LRet = AccessibleObjectFromEvent(hWnd, idObject, idChild, ObA, V)
If LRet = 0 Then
hWin = GetIEWindow(hWnd)
If (hWin = 0) Then
Set Doc1 = Nothing
F1.T1.Text = ""
F1.TPath.Text = ""
Else
Set Doc1 = GetIEDoc(hWin, Boo1)
If (Boo1 = True) Then
F1.T1.Text = Doc1.body.innerText
F1.TPath.Text = Doc1.parentWindow.location.pathname
End If
End If
End If
Case SYS_CAPTUREEND
Set Doc1 = Nothing
F1.T1.Text = ""
F1.TPath.Text = ""
Case Else
'--
End Select
hWinCur = hWnd
WinEventFunc = 0
End Function
Public Function GetIEWindow(ByVal H1 As Long)
Dim LRet As Long
hCur = 0
GetIEWindow = 0
sClassName = IES ' "Internet Explorer_Server"
LRet = EnumChildWindows(H1, AddressOf EnumChildProc, 0)
GetIEWindow = hCur '-- either 0 or handle of browser.
End Function
'-- callback for function above.
Public Function EnumChildProc(ByVal hWnd As Long, lParam As Long) As Long
Dim s2 As String
s2 = GetWinClass(hWnd)
Select Case s2
Case SDV
hCur = 0
EnumChildProc = 0
Case IES
hCur = hWnd
EnumChildProc = 0
Case Else
EnumChildProc = 1
End Select
End Function
'-- get the class name for a window, given the hWnd.
Public Function GetWinClass(ByVal H1 As Long) As String
Dim sBuf As String
Dim LRet As Long
On Error Resume Next
GetWinClass = ""
sBuf = String$(256, 0)
LRet = GetClassName(H1, sBuf, Len(sBuf))
If (LRet > 0) Then GetWinClass = Left$(sBuf, LRet)
End Function
Public Function GetIEDoc(ByVal H2 As Long, Success As Boolean) As
IHTMLDocument
Dim IID_IHTMLDocument2 As UUID
Dim LMsg As Long, LRes As Long, LRet As Long
mayayana
First, I realized that the
AccessibleObjectFromEvent call was irrelevant to this
code. (The code I'd posted was a quick paste-together
and edit from existing code.) Also, I figured out a way to get
the document events. This is like the last project except
that it also requires a textbox named T2, which receives
an updated tagname every time the Doc. is clicked.
The WithEvents-version code at first was crashing when I closed
the IE window, but removing the AccessibleObjectFromEvent
code seems to fix that.
I also found that I needed to edit the function that returns
the Internet Explorer_Server hWnd because when the Doc. is
clicked the Internet Explorer_Server is no longer a child window,
but rather is the hWnd value sent in.
Form F1
' ---------------------------------
Option Explicit
Public WithEvents Doc1 As HTMLDocument
Private Sub bHook_Click()
Hook
End Sub
Private Sub bUnhook_Click()
UnHook
End Sub
Private Function Doc1_onclick() As Boolean
On Error Resume Next
T2.Text = Doc1.parentWindow.event.srcElement.tagName
End Function
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Set Doc1 = Nothing
UnHook
End Sub
'-------------------
Mod1 code
'------------------------
Option Explicit
Private Const SMTO_ABORTIFHUNG = &H2
Public Const SYS_FOREGROUND = 3&
Public Const SYS_CAPTURESTART = 8&
Public Const SYS_CAPTUREEND = 9&
Public Const WINEVENT_SKIPOWNPROCESS = 2& '-- exclude this process.
Private Const SDV As String = "SHELLDLL_DefView"
Private Const IES As String = "Internet Explorer_Server"
Private Type UUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
'Public Declare Function AccessibleObjectFromEvent Lib "oleacc" (ByVal hWnd
As Long, ByVal dwId As Long, ByVal dwChildId As Long, ppacc As IAccessible,
pvarChild As Variant) As Long
Public Declare Function SetWinEventHook Lib "user32.dll" (ByVal eventMin As
Long, ByVal eventMax As Long, ByVal hmodWinEventProc As Long, ByVal
pfnWinEventProc As Long, ByVal idProcess As Long, ByVal idThread As Long,
ByVal dwFlags As Long) As Long
Public Declare Function UnhookWinEvent Lib "user32.dll" (ByVal lHandle As
Long) As Long
Private Declare Function ObjectFromLresult Lib "oleacc" (ByVal lResult As
Long, riid As UUID, ByVal wParam As Long, ppvObject As Any) As Long
Private Declare Function RegisterWindowMessage Lib "user32" Alias
"RegisterWindowMessageA" (ByVal lpString As String) As Long
Private Declare Function SendMessageTimeout Lib "user32" Alias
"SendMessageTimeoutA" (ByVal hWnd As Long, ByVal msg As Long, ByVal wParam
As Long, lParam As Any, ByVal fuFlags As Long, ByVal uTimeout As Long,
lpdwResult As Long) As Long
Private Declare Function GetClassName Lib "user32.dll" Alias "GetClassNameA"
(ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long)
As Long
Private Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As
Long, ByVal lpEnumFunc As Long, lParam As Long) As Long
Private sClassName As String
Private hCur As Long
Public LHook As Long
Public hWinCur As Long
Public Sub Hook()
Dim LRet As Long
LHook = SetWinEventHook(SYS_FOREGROUND, SYS_CAPTUREEND, 0&, AddressOf
WinEventFunc, 0, 0, WINEVENT_SKIPOWNPROCESS)
End Sub
Public Sub UnHook()
Dim LRet As Long
If LHook = 0 Then Exit Sub
LRet = UnhookWinEvent(LHook)
End Sub
Public Function WinEventFunc(ByVal HookHandle As Long, ByVal LEvent As Long,
ByVal hWnd As Long, ByVal idObject As Long, ByVal idChild As Long, ByVal
idEventThread As Long, ByVal dwmsEventTime As Long) As Long
Dim LRet As Long, hWin As Long
Dim V As Variant
Dim s As String, s1 As String, sName As String
Dim Boo1 As Boolean
On Error Resume Next
If hWinCur = hWnd And Not (F1.Doc1 Is Nothing) Then Exit Function
Select Case LEvent
Case SYS_CAPTURESTART, SYS_FOREGROUND
hWin = GetIEWindow(hWnd)
If (hWin = 0) Then
With F1
Set .Doc1 = Nothing
.T1.Text = ""
.TPath.Text = ""
End With
Else
With F1
Set .Doc1 = GetIEDoc(hWin, Boo1)
If (Boo1 = True) Then
.T1.Text = .Doc1.body.innerText
.TPath.Text = .Doc1.parentWindow.location.pathname
End If
End With
End If
Case SYS_CAPTUREEND
With F1
Set .Doc1 = Nothing
.T1.Text = ""
.TPath.Text = ""
End With
Case Else
'--
End Select
hWinCur = hWnd
WinEventFunc = 0
End Function
Public Function GetIEWindow(ByVal H1 As Long)
Dim LRet As Long
Dim s1 As String
hCur = 0
GetIEWindow = 0
sClassName = IES ' "Internet Explorer_Server"
s1 = GetWinClass(H1) '-- also check top window itself.
If (s1 = IES) Then
GetIEWindow = H1
Exit Function
End If
Public Function GetIEDoc(ByVal H2 As Long, Success As Boolean) As
HTMLDocument
Dim IID_IHTMLDocument2 As UUID
Dim LMsg As Long, LRes As Long, LRet As Long
parks...@fairpoint.net
I'll try it out.
Mike
Ramana Kumar
> On Thursday, February 21, 2008 6:46 PM Larry Serflaten wrote:
> <parks...@fairpoint.net> wrote
>
>
>
> Your application will have to deal with the situation where no browser
> is present. You either set a flag to indicate the Doc reference is not
> valid and test that before using the Doc reference, or you test whether
> your reference is Nothing before any command that uses that Doc ref.
>
> Perhaps this will help you get the logic down. To a new project add
> References to:
>
> Microsoft Shell Controls and Automation
> Microsoft Internet Controls
>
> Add a Timer to the form then paste in the code below and try it out....
>
> HTH
> LFS
>
>
> Option Explicit
> Private WithEvents IE As InternetExplorer
> Private reAcquire As Boolean
>
> Private Sub Form_Load()
> Timer1.Interval = 1000
> Timer1.Enabled = False
> Acquire
> End Sub
>
> Private Sub IE_BeforeNavigate2(ByVal pDisp As Object, URL As Variant, Flags As Variant, TargetFrameName As Variant, PostData As
> Variant, Headers As Variant, Cancel As Boolean)
> Debug.Print "Navigating (doc invalid)"
> reAcquire = True
> End Sub
>
> Private Sub IE_DocumentComplete(ByVal pDisp As Object, URL As Variant)
> If reAcquire Then Acquire
> End Sub
>
> Private Sub IE_OnQuit()
> Debug.Print "Quit"
> Set IE = Nothing
> Timer1.Enabled = True
> End Sub
>
> Private Sub IE_WindowClosing(ByVal IsChildWindow As Boolean, Cancel As Boolean)
> Debug.Print "Close"
> Set IE = Nothing
> Timer1.Enabled = True
> End Sub
>
> Private Sub Timer1_Timer()
> Timer1.Enabled = False
> Acquire
> End Sub
>
> Sub Acquire()
>
> Dim shl As ShellWindows
> Dim obj As InternetExplorer
>
> reAcquire = False
> Set shl = New ShellWindows
>
> Set IE = Nothing
> For Each obj In shl
> If TypeName(obj.document) = "HTMLDocument" Then
> Set IE = obj
> End If
> Next
> If Not IE Is Nothing Then
> Debug.Print "Using: ", IE.document.Title
> Else
> Debug.Print "No InternetExplorer Windows available."
> Timer1.Enabled = True
> End If
> End Sub
>> On Thursday, February 21, 2008 10:16 PM parksfamil wrote:
>> I have been beating my head against this for days...
>> Please can someone help me out.
>>
>> I am trying to get access to any IE browser window that comes into
>> focus so I can use it's DOM for voice synthesising.
>>
>> I can get the current browser window focus.
>> I set the objDoc to the browser's object and can access the DOM.
>>
>> BUT
>>
>> When I close the browser window that has focus (and the objDoc is
>> linked to) and switch focus to another browser window it crashes.
>> (I think the ObjDoc (object I use to connect) is messed up when the
>> browser window closes.. It doesn't happen all the time, but it does
>> happen a lot (and usually when I close all the browser windows and
>> either before or as I open a new one)
>>
>> Private Type UUID
>> Data1 As Long
>> Data2 As Integer
>> Data3 As Integer
>> Data4(0 To 7) As Byte
>> End Type
>>
>> Private Declare Function FindWindow Lib "User32" Alias
>> "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As
>> String) As Long
>> Private Declare Function FindWindowEx Lib "User32" Alias
>> "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1
>> As String, ByVal lpsz2 As String) As Long
>> Private Declare Function ObjectFromLresult Lib "oleacc" (ByVal lResult
>> As Long, riid As UUID, ByVal wParam As Long, ppvObject As Any) As Long
>> Private Declare Function RegisterWindowMessage Lib "User32" Alias
>> "RegisterWindowMessageA" (ByVal lpString As String) As Long
>> Private Declare Function SendMessageTimeout Lib "User32" Alias
>> "SendMessageTimeoutA" (ByVal hwnd As Long, ByVal Msg As Long, ByVal
>> wParam As Long, lParam As Any, ByVal fuFlags As Long, ByVal uTimeout
>> As Long, lpdwResult As Long) As Long
>>
>> Private Declare Function GetClassName Lib "User32" (ByVal hwnd As _
>> Integer, ByVal lpClassName As String, ByVal nMaxCount As _
>> Integer) As Integer
>>
>> Private Declare Function GetWindowText Lib "User32" Alias
>> "GetWindowTextA" (ByVal hwnd As _
>> Integer, ByVal lpString As String, ByVal aint As Integer) As
>> _
>> Integer
>>
>> Private Declare Function GetForegroundWindow Lib "user32.dll" () As
>> Long
>>
>>
>> Private Const SMTO_ABORTIFHUNG = &H2
>>
>>
>>
>>
>> Public WithEvents objDoc As HTMLDocument
>>
>> ' Create a web document object to control browser
>> 'Private mhtmDoc3 As IHTMLDocument3
>> 'Private WithEvents objDoc As HTMLDocument
>>
>>
>> Dim FocusHwnd As Long
>> Dim CurrentFocusWindowTitle As String * 255
>> Dim LastFocusWindowTitle As String * 255
>>
>>
>> Dim mx, my
>>
>> Private Sub Command1_Click()
>> Dim hwnd As Long
>> '"coozzzzz - coozzzzz" is the title of the IM window
>> hwnd = FindWindow("IEFrame", CurrentFocusWindowTitle)
>>
>> hwnd = FindWindowEx(hwnd, 0, "Shell DocObject View", vbNullString)
>>
>> hwnd = FindWindowEx(hwnd, 0, "Internet Explorer_Server",
>> vbNullString)
>>
>> If hwnd > 0 Then
>> Set objDoc = WindowDOM(hwnd)
>> If Not (objDoc Is Nothing) Then
>> Text1.Text = objDoc.body.innerText
>> LastFocusWindowTitle = CurrentFocusWindowTitle
>> End If
>> End If
>>
>> End Sub
>>
>> Private Function WindowDOM(ByVal hwnd As Long) As IHTMLDocument
>> Dim typUUID As UUID, lngRes As Long, lngMsg As Long
>> lngMsg = RegisterWindowMessage("WM_HTML_GETOBJECT")
>> If lngMsg <> 0 Then
>> Call SendMessageTimeout(hwnd, lngMsg, 0, 0, SMTO_ABORTIFHUNG,
>> 1000, lngRes)
>> If lngRes <> 0 Then
>> With typUUID
>> .Data1 = &H626FC520
>> .Data2 = &HA41E
>> .Data3 = &H11CF
>> .Data4(0) = &HA7
>> .Data4(1) = &H31
>> .Data4(2) = &H0
>> .Data4(3) = &HA0
>> .Data4(4) = &HC9
>> .Data4(5) = &H8
>> .Data4(6) = &H26
>> .Data4(7) = &H37
>> End With
>> Call ObjectFromLresult(lngRes, typUUID, 0, WindowDOM)
>> End If
>> End If
>> End Function
>>
>>
>>
>> Private Sub Timer1_Timer()
>> Dim a As Long
>> FocusHwnd = GetForegroundWindow
>> a = GetWindowText(FocusHwnd, CurrentFocusWindowTitle,
>> Len(CurrentFocusWindowTitle))
>>
>> If (CurrentFocusWindowTitle <> LastFocusWindowTitle) Then
>> Command1_Click
>> End If
>>
>> End Sub
>> [/CODE]
>>> On Friday, February 22, 2008 8:32 AM Larry Serflaten wrote:
>>> <parks...@fairpoint.net> wrote
>>>
>>>
>>> I thought I covered that, but I find that I tested that sceanareo with
>>> my browser that opens up to 'about:blank" as the homepage. If you
>>> have a different home page, or you click a link then the browser is still
>>> navigating when it hits that loop. "About:Blank" happened so fast that
>>> it wasn't a problem. For that situation, my preference would be to
>>> test if the document is ready, something like:
>>>
>>> For Each obj In shl
>>> If Not obj.Document Is Nothing Then
>>> If TypeName(obj.Document) = "HTMLDocument" Then
>>> Set IE = obj
>>> End If
>>> End If
>>> Next
>>>
>>>
>>>
>>> Its not likely to change while that window is in the foreground. Try it and
>>> see if it will fill the bill (but again the foreground window may not always be
>>> an Explorer type application):
>>>
>>> Option Explicit
>>> ' Ref MS Internet Controls ....
>>> Private shl As ShellWindows
>>> Private Declare Function GetForegroundWindow Lib "user32.dll" () As Long
>>>
>>> Private Sub Form_Load()
>>> Set shl = New Shellwindows
>>> Timer1.Interval = 1000
>>> Timer1.Enabled = True
>>> End Sub
>>>
>>> Private Sub Timer1_Timer()
>>> Dim itm, hw As Long
>>> hw = GetForegroundWindow()
>>> For Each itm In shl
>>> If hw = itm.hWnd Then
>>> Debug.Print itm.hWnd, itm.LocationName
>>> End If
>>> Next
>>> End Sub
>>>> On Friday, February 22, 2008 2:38 PM mayayana wrote:
>>>> Maybe it would help if you explained that more.
>>>> From the info. you've posted it doesn't seem to
>>>> make sense, chasing IE instances all over the screen
>>>> while someone is apparently opening and closing them
>>>> very quickly.
>>>>
>>>> But you said you want to "use it's DOM for voice
>>>> synthesising". Can't you use SAPI 5? That's installable,
>>>> and I think it's pre-installed on XP. It also has a
>>>> very easy object model.
>>>>>> On Saturday, February 23, 2008 7:48 AM Larry Serflaten wrote:
>>>>>> <parks...@fairpoint.net> wrote
>>>>>>
>>>>>>
>>>>>> I find it surprising to hear that a reference can be in the ShellWindows
>>>>>> collection, yet be invalid when you go to use it. I guess timing is critical....
>>>>>>
>>>>>> None the less, do not hesitate to add error handling as you see fit. If you
>>>>>> are trying to get your app to respond to all circumstances that may happen,
>>>>>> adding error handling is unavoidable, and it just makes good sense to trap
>>>>>> errors and fail gracefully, rather than let Windows catch the error and close
>>>>>> your app.
>>>>>>
>>>>>> LFS
>>>>>>> On Saturday, February 23, 2008 4:58 PM parksfamil wrote:
>>>>>>> Thank you very much...
>>>>>>> I am going over the code.
>>>>>>> I see how it is clearing the obj.
>>>>>>>
>>>>>>> I did have a couple of more questions :D
>>>>>>>
>>>>>>> 1) It pops up with a Automation Error (same as I mention) when all
>>>>>>> browser windows are closed and then one is opened... but it isn't
>>>>>>> locking the obj up so I did this,
>>>>>>>
>>>>>>> On Error GoTo ErrorJump
>>>>>>> If TypeName(obj.Document) = "HTMLDocument" Then
>>>>>>> On Error GoTo 0
>>>>>>>
>>>>>>> around the test IF statement (that is where it would error) and I send
>>>>>>> it to the last set of IF's in that sub.
>>>>>>> So is that allright?
>>>>>>>
>>>>>>>
>>>>>>> 2) I have to grab the window in focus... is there anything I can
>>>>>>> compare between the obj and the API FindWindow (or such)? I thought
>>>>>>> about using the hWnd of the obj but I know those can change...
>>>>>>> But I can't think of anything else that is a sure check (since anyone
>>>>>>> can have as many windows open to the same URL I can't use
>>>>>>> document.title).
>>>>>>>
>>>>>>> Thank you for all the help,
>>>>>>> Mike
>>>>>>>> On Saturday, February 23, 2008 4:58 PM parksfamil wrote:
>>>>>>>> Thank you...
>>>>>>>>
>>>>>>>> It still will crash in the loop, but your examples have shown me the
>>>>>>>> reasons (and also your code keeps the objects alive, not allowing them
>>>>>>>> to just lock up).
>>>>>>>>
>>>>>>>> I am going over it writing down comments on each line (testing in
>>>>>>>> another project to reproduce the errors till I understand their
>>>>>>>> causes) and it is really helping me.
>>>>>>>>
>>>>>>>> I may have to ask more questions later :D
>>>>>>>>
>>>>>>>> Thank you very much for your help. I don't think I would have ever
>>>>>>>> been able to understand the process with those examples..
>>>>>>>>
>>>>>>>> Mike
>>>>>>>>
>>>>>>>>
>>>>>>>>
>>>>>>>>
>>>>>>>>
>>>>>>>>
>>>>>>>>
>>>>>>>>
>>>>>>>> On Feb 22, 8:32=A0am, "Larry Serflaten" <serfla...@usinternet.com>
>>>>>>>> wrote:
>>>>>>>> and
>>>>>>>> ys be
>>>>>>>>> On Saturday, February 23, 2008 4:58 PM parksfamil wrote:
>>>>>>>>> Sorry... back sooner than I thought..
>>>>>>>>>
>>>>>>>>> I can't find a way around using the On Error, and here is why.
>>>>>>>>> (I numbered the lines below)
>>>>>>>>>
>>>>>>>>>>> On Saturday, February 23, 2008 4:58 PM parksfamil wrote:
>>>>>>>>>>> SAPI 5 is for voice synthesizing, which I am using.
>>>>>>>>>>> But it has nothing to do with the browser.
>>>>>>>>>>> I am reading the in focus browser's DOM (text, element under mouse,
>>>>>>>>>>> etc.) to use with SAPI 5.
>>>>>>>>>>>
>>>>>>>>>>> Thank you
>>>>>>>>>>> Michael
>>>>>>>>>>>
>>>>>>>>>>>
>>>>>>>>>>>
>>>>>>>>>>>
>>>>>>>>>>>
>>>>>>>>>>> On Feb 22, 2:38=A0pm, "mayayana" <mayaXXyan...@mindXXspring.com> wrote:
>>>>>>>>>>>>>> Private Sub bHook_Click()
>>>>>>>>>>>>>> Hook
>>>>>>>>>>>>>> End Sub
>>>>>>>>>>>>>>
>>>>>>>>>>>>>> Private Sub bUnhook_Click()
>>>>>>>>>>>>>> UnHook
>>>>>>>>>>>>>> End Sub
>>>>>>>>>>>>>>
>>>>>>>>>>>>>> Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
>>>>>>>>>>>>>> Set Doc1 = Nothing
>>>>>>>>>>>>>> UnHook
>>>>>>>>>>>>>> End Sub
>>>>>>>>>>>>>>
>>>>>>>>>>>>>> '------------------------
>>>>>>>>>>>>>>
>>>>>>>>>>>>>> Mod1 .bas module code:
>>>>>>>>>>>>>> '--------------------------
>>>>>>>>>>>>>>
>>>>>>>>>>>>>> Option Explicit
>>>>>>>>>>>>>>
>>>>>>>>>>>>>>
>>>>>>>>>>>>>> Private Const SMTO_ABORTIFHUNG = &H2
>>>>>>>>>>>>>> Public Const SYS_FOREGROUND = 3&
>>>>>>>>>>>>>> Public Const SYS_CAPTURESTART = 8&
>>>>>>>>>>>>>> Public Const SYS_CAPTUREEND = 9&
>>>>>>>>>>>>>> Public Const WINEVENT_SKIPOWNPROCESS = 2& ' Don't call back for events on
>>>>>>>>>>>>>> installer's process
>>>>>>>>>>>>>>
>>>>>>>>>>>>>> Private Const SDV As String = "SHELLDLL_DefView"
>>>>>>>>>>>>>> Private Const IES As String = "Internet Explorer_Server"
>>>>>>>>>>>>>>
>>>>>>>>>>>>>> Private Type UUID
>>>>>>>>>>>>>> Data1 As Long
>>>>>>>>>>>>>> Data2 As Integer
>>>>>>>>>>>>>> Data3 As Integer
>>>>>>>>>>>>>> Data4(0 To 7) As Byte
>>>>>>>>>>>>>> End Type
>>>>>>>>>>>>>>
>>>>>>>>>>>>>> Public Declare Function AccessibleObjectFromEvent Lib "oleacc" (ByVal hWnd
>>>>>>>>>>>>>> As Long, ByVal dwId As Long, ByVal dwChildId As Long, ppacc As IAccessible,
>>>>>>>>>>>>>> pvarChild As Variant) As Long
>>>>>>>>>>>>>> Public Declare Function SetWinEventHook Lib "user32.dll" (ByVal eventMin As
>>>>>>>>>>>>>> Long, ByVal eventMax As Long, ByVal hmodWinEventProc As Long, ByVal
>>>>>>>>>>>>>> pfnWinEventProc As Long, ByVal idProcess As Long, ByVal idThread As Long,
>>>>>>>>>>>>>> ByVal dwFlags As Long) As Long
>>>>>>>>>>>>>> Public Declare Function UnhookWinEvent Lib "user32.dll" (ByVal lHandle As
>>>>>>>>>>>>>> Long) As Long
>>>>>>>>>>>>>>
>>>>>>>>>>>>>> Private Declare Function ObjectFromLresult Lib "oleacc" (ByVal lResult As
>>>>>>>>>>>>>> Long, riid As UUID, ByVal wParam As Long, ppvObject As Any) As Long
>>>>>>>>>>>>>> Private Declare Function RegisterWindowMessage Lib "user32" Alias
>>>>>>>>>>>>>> "RegisterWindowMessageA" (ByVal lpString As String) As Long
>>>>>>>>>>>>>> Private Declare Function SendMessageTimeout Lib "user32" Alias
>>>>>>>>>>>>>> "SendMessageTimeoutA" (ByVal hWnd As Long, ByVal msg As Long, ByVal wParam
>>>>>>>>>>>>>> As Long, lParam As Any, ByVal fuFlags As Long, ByVal uTimeout As Long,
>>>>>>>>>>>>>> lpdwResult As Long) As Long
>>>>>>>>>>>>>>
>>>>>>>>>>>>>> Private Declare Function GetClassName Lib "user32.dll" Alias "GetClassNameA"
>>>>>>>>>>>>>> (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long)
>>>>>>>>>>>>>> As Long
>>>>>>>>>>>>>> Private Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As
>>>>>>>>>>>>>> Long, ByVal lpEnumFunc As Long, lParam As Long) As Long
>>>>>>>>>>>>>>
>>>>>>>>>>>>>> Private sClassName As String
>>>>>>>>>>>>>> Private hCur As Long
>>>>>>>>>>>>>> Public Doc1 As IHTMLDocument2
>>>>>>>>>>>>>> Public LHook As Long
>>>>>>>>>>>>>> Public hWinCur As Long
>>>>>>>>>>>>>>
>>>>>>>>>>>>>> Public Sub Hook()
>>>>>>>>>>>>>> Dim LRet As Long
>>>>>>>>>>>>>> LHook = SetWinEventHook(SYS_FOREGROUND, SYS_CAPTUREEND, 0&, AddressOf
>>>>>>>>>>>>>> WinEventFunc, 0, 0, WINEVENT_SKIPOWNPROCESS)
>>>>>>>>>>>>>> End Sub
>>>>>>>>>>>>>>
>>>>>>>>>>>>>> Public Sub UnHook()
>>>>>>>>>>>>>> Dim LRet As Long
>>>>>>>>>>>>>> If LHook = 0 Then Exit Sub
>>>>>>>>>>>>>> LRet = UnhookWinEvent(LHook)
>>>>>>>>>>>>>> End Sub
>>>>>>>>>>>>>>
>>>>>>>>>>>>>> Public Function WinEventFunc(ByVal HookHandle As Long, ByVal LEvent As Long,
>>>>>>>>>>>>>> ByVal hWnd As Long, ByVal idObject As Long, ByVal idChild As Long, ByVal
>>>>>>>>>>>>>> idEventThread As Long, ByVal dwmsEventTime As Long) As Long
>>>>>>>>>>>>>> Dim ObA As IAccessible
>>>>>>>>>>>>>> Dim LRet As Long, hWin As Long
>>>>>>>>>>>>>> Dim V As Variant
>>>>>>>>>>>>>> Dim s As String, s1 As String, sName As String
>>>>>>>>>>>>>> Dim Boo1 As Boolean
>>>>>>>>>>>>>> On Error Resume Next
>>>>>>>>>>>>>>
>>>>>>>>>>>>>>
>>>>>>>>>>>>>> If hWinCur = hWnd And Not (Doc1 Is Nothing) Then Exit Function
>>>>>>>>>>>>>>
>>>>>>>>>>>>>> Select Case LEvent
>>>>>>>>>>>>>> Case SYS_CAPTURESTART, SYS_FOREGROUND
>>>>>>>>>>>>>> LRet = AccessibleObjectFromEvent(hWnd, idObject, idChild, ObA, V)
>>>>>>>>>>>>>> If LRet = 0 Then
>>>>>>>>>>>>>> hWin = GetIEWindow(hWnd)
>>>>>>>>>>>>>> If (hWin = 0) Then
>>>>>>>>>>>>>> Set Doc1 = Nothing
>>>>>>>>>>>>>> F1.T1.Text = ""
>>>>>>>>>>>>>> F1.TPath.Text = ""
>>>>>>>>>>>>>> Else
>>>>>>>>>>>>>> Set Doc1 = GetIEDoc(hWin, Boo1)
>>>>>>>>>>>>>> If (Boo1 = True) Then
>>>>>>>>>>>>>> F1.T1.Text = Doc1.body.innerText
>>>>>>>>>>>>>> F1.TPath.Text = Doc1.parentWindow.location.pathname
>>>>>>>>>>>>>> End If
>>>>>>>>>>>>>> End If
>>>>>>>>>>>>>> End If
>>>>>>>>>>>>>> Case SYS_CAPTUREEND
>>>>>>>>>>>>>>
>>>>>>>>>>>>>> Set Doc1 = Nothing
>>>>>>>>>>>>>> F1.T1.Text = ""
>>>>>>>>>>>>>> F1.TPath.Text = ""
>>>>>>>>>>>>>>
>>>>>>>>>>>>>> Case Else
>>>>>>>>>>>>>>
>>>>>>>>>>>>>> '--
>>>>>>>>>>>>>> End Select
>>>>>>>>>>>>>> hWinCur = hWnd
>>>>>>>>>>>>>> WinEventFunc = 0
>>>>>>>>>>>>>> End Function
>>>>>>>>>>>>>>
>>>>>>>>>>>>>> Public Function GetIEWindow(ByVal H1 As Long)
>>>>>>>>>>>>>> Dim LRet As Long
>>>>>>>>>>>>>> hCur = 0
>>>>>>>>>>>>>> GetIEWindow = 0
>>>>>>>>>>>>>> sClassName = IES ' "Internet Explorer_Server"
>>>>>>>>>>>>>> Public Function GetIEDoc(ByVal H2 As Long, Success As Boolean) As
>>>>>>>>>>>>>> IHTMLDocument
>>>>>>>>>>>>>> Dim IID_IHTMLDocument2 As UUID
>>>>>>>>>>>>>> Dim LMsg As Long, LRes As Long, LRet As Long
>>>>>>>>>>>>>> Success = False
>>>>>>>>>>>>>>
>>>>>>>>>>>>>> LMsg = RegisterWindowMessage("WM_HTML_GETOBJECT")
>>>>>>>>>>>>>> LRet = SendMessageTimeout(H2, LMsg, 0, 0, SMTO_ABORTIFHUNG, 1000, LRes)
>>>>>>>>>>>>>> If LRes = 0 Then Exit Function
>>>>>>>>>>>>>>
>>>>>>>>>>>>>> With IID_IHTMLDocument2
>>>>>>>>>>>>>> .Data1 = &H332C4425
>>>>>>>>>>>>>> .Data2 = &H26CB
>>>>>>>>>>>>>> .Data3 = &H11D0
>>>>>>>>>>>>>> .Data4(0) = &HB4
>>>>>>>>>>>>>> .Data4(1) = &H83
>>>>>>>>>>>>>> .Data4(2) = &H0
>>>>>>>>>>>>>> .Data4(3) = &HC0
>>>>>>>>>>>>>> .Data4(4) = &H4F
>>>>>>>>>>>>>> .Data4(5) = &HD9
>>>>>>>>>>>>>> .Data4(6) = &H1
>>>>>>>>>>>>>> .Data4(7) = &H19
>>>>>>>>>>>>>> End With
>>>>>>>>>>>>>>
>>>>>>>>>>>>>> LRet = ObjectFromLresult(LRes, IID_IHTMLDocument2, 0, GetIEDoc)
>>>>>>>>>>>>>> If LRet = 0 Then Success = True
>>>>>>>>>>>>>> End Function
>>>>>>>>>>>>>>> On Sunday, February 24, 2008 10:34 PM parksfamil wrote:
>>>>>>>>>>>>>>> Problem with the AA is that it is so C/C++ oriented.
>>>>>>>>>>>>>>> The sample you posted even has a note in it from whoever did it saying
>>>>>>>>>>>>>>> they gave up trying to use AA since there was not enough documentation
>>>>>>>>>>>>>>> for VB and that the whole AA system seemed incomplete.
>>>>>>>>>>>>>>>
>>>>>>>>>>>>>>> Mike
>>>>>>>>>>>>>>>
>>>>>>>>>>>>>>>
>>>>>>>>>>>>>>>
>>>>>>>>>>>>>>>
>>>>>>>>>>>>>>>
>>>>>>>>>>>>>>>
>>>>>>>>>>>>>>>
>>>>>>>>>>>>>>>
>>>>>>>>>>>>>>>
>>>>>>>>>>>>>>> On Feb 23, 9:30=A0pm, "mayayana" <mayaXXyan...@mindXXspring.com> wrote:
>>>>>>>>>>>>>>>
>>>>>>>>>>>>>>> es)
>>>>>>>>>>>>>>> oc)
>>>>>>>>>>>>>>>> Private Const SMTO_ABORTIFHUNG = &H2
>>>>>>>>>>>>>>>> Public Const SYS_FOREGROUND = 3&
>>>>>>>>>>>>>>>> Public Const SYS_CAPTURESTART = 8&
>>>>>>>>>>>>>>>> Public Const SYS_CAPTUREEND = 9&
>>>>>>>>>>>>>>>> Public Const WINEVENT_SKIPOWNPROCESS = 2& '-- exclude this process.
>>>>>>>>>>>>>>>>
>>>>>>>>>>>>>>>> Private Const SDV As String = "SHELLDLL_DefView"
>>>>>>>>>>>>>>>> Private Const IES As String = "Internet Explorer_Server"
>>>>>>>>>>>>>>>>
>>>>>>>>>>>>>>>> Private Type UUID
>>>>>>>>>>>>>>>> Data1 As Long
>>>>>>>>>>>>>>>> Data2 As Integer
>>>>>>>>>>>>>>>> Data3 As Integer
>>>>>>>>>>>>>>>> Data4(0 To 7) As Byte
>>>>>>>>>>>>>>>> End Type
>>>>>>>>>>>>>>>>
>>>>>>>>>>>>>>>> 'Public Declare Function AccessibleObjectFromEvent Lib "oleacc" (ByVal hWnd
>>>>>>>>>>>>>>>> As Long, ByVal dwId As Long, ByVal dwChildId As Long, ppacc As IAccessible,
>>>>>>>>>>>>>>>> pvarChild As Variant) As Long
>>>>>>>>>>>>>>>> Public Declare Function SetWinEventHook Lib "user32.dll" (ByVal eventMin As
>>>>>>>>>>>>>>>> Long, ByVal eventMax As Long, ByVal hmodWinEventProc As Long, ByVal
>>>>>>>>>>>>>>>> pfnWinEventProc As Long, ByVal idProcess As Long, ByVal idThread As Long,
>>>>>>>>>>>>>>>> ByVal dwFlags As Long) As Long
>>>>>>>>>>>>>>>> Public Declare Function UnhookWinEvent Lib "user32.dll" (ByVal lHandle As
>>>>>>>>>>>>>>>> Long) As Long
>>>>>>>>>>>>>>>>
>>>>>>>>>>>>>>>> Private Declare Function ObjectFromLresult Lib "oleacc" (ByVal lResult As
>>>>>>>>>>>>>>>> Long, riid As UUID, ByVal wParam As Long, ppvObject As Any) As Long
>>>>>>>>>>>>>>>> Private Declare Function RegisterWindowMessage Lib "user32" Alias
>>>>>>>>>>>>>>>> "RegisterWindowMessageA" (ByVal lpString As String) As Long
>>>>>>>>>>>>>>>> Private Declare Function SendMessageTimeout Lib "user32" Alias
>>>>>>>>>>>>>>>> "SendMessageTimeoutA" (ByVal hWnd As Long, ByVal msg As Long, ByVal wParam
>>>>>>>>>>>>>>>> As Long, lParam As Any, ByVal fuFlags As Long, ByVal uTimeout As Long,
>>>>>>>>>>>>>>>> lpdwResult As Long) As Long
>>>>>>>>>>>>>>>>
>>>>>>>>>>>>>>>> Private Declare Function GetClassName Lib "user32.dll" Alias "GetClassNameA"
>>>>>>>>>>>>>>>> (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long)
>>>>>>>>>>>>>>>> As Long
>>>>>>>>>>>>>>>> Public Function GetIEDoc(ByVal H2 As Long, Success As Boolean) As
>>>>>>>>>>>>>>>> HTMLDocument
>>>>>>>>>>>>>>>> Dim IID_IHTMLDocument2 As UUID
>>>>>>>>>>>>>>>> Dim LMsg As Long, LRes As Long, LRet As Long
>>>>>>>>>>>>>>>> Success = False
>>>>>>>>>>>>>>>>
>>>>>>>>>>>>>>>> LMsg = RegisterWindowMessage("WM_HTML_GETOBJECT")
>>>>>>>>>>>>>>>> LRet = SendMessageTimeout(H2, LMsg, 0, 0, SMTO_ABORTIFHUNG, 1000, LRes)
>>>>>>>>>>>>>>>> If LRes = 0 Then Exit Function
>>>>>>>>>>>>>>>>
>>>>>>>>>>>>>>>> With IID_IHTMLDocument2
>>>>>>>>>>>>>>>> .Data1 = &H332C4425
>>>>>>>>>>>>>>>> .Data2 = &H26CB
>>>>>>>>>>>>>>>> .Data3 = &H11D0
>>>>>>>>>>>>>>>> .Data4(0) = &HB4
>>>>>>>>>>>>>>>> .Data4(1) = &H83
>>>>>>>>>>>>>>>> .Data4(2) = &H0
>>>>>>>>>>>>>>>> .Data4(3) = &HC0
>>>>>>>>>>>>>>>> .Data4(4) = &H4F
>>>>>>>>>>>>>>>> .Data4(5) = &HD9
>>>>>>>>>>>>>>>> .Data4(6) = &H1
>>>>>>>>>>>>>>>> .Data4(7) = &H19
>>>>>>>>>>>>>>>> End With
>>>>>>>>>>>>>>>>
>>>>>>>>>>>>>>>> LRet = ObjectFromLresult(LRes, IID_IHTMLDocument2, 0, GetIEDoc)
>>>>>>>>>>>>>>>> If LRet = 0 Then Success = True
>>>>>>>>>>>>>>>> End Function
>>>>>>>>>>>>>>>>> On Wednesday, February 27, 2008 4:50 AM parksfamil wrote:
>>>>>>>>>>>>>>>>> Thanks a lot for the help...
>>>>>>>>>>>>>>>>> I will try it out.
>>>>>>>>>>>>>>>>>
>>>>>>>>>>>>>>>>> Mike
>>>>>>>>>>>>>>>>>
>>>>>>>>>>>>>>>>>
>>>>>>>>>>>>>>>>>
>>>>>>>>>>>>>>>>>
>>>>>>>>>>>>>>>>>
>>>>>>>>>>>>>>>>> d
>>>>>>>>>>>>>>>>> ,
>>>>>>>>>>>>>>>>> s
>>>>>>>>>>>>>>>>>
>>>>>>>>>>>>>>>>> A"
>>>>>>>>>>>>>>>>>
>>>>>>>>>>>>>>>>> s
>>>>>>>>>>>>>>>>> f
>>>>>>>>>>>>>>>>> g,
>>>>>>>>>>>>>>>>>
>>>>>>>>>>>>>>>>> .pathname
>>>>>>>>>>>>>>>>> es)
>>>>>>>>>>>>>>>>> oc)
Mike S
> This Code works, I want to ask u if this code will work for Firefox browser document object
Have you seen this?
Mayayana
browser document object
| <major snip of IE automation code>
|
| Have you seen this?
|
| http://www.iol.ie/~locka/mozilla/control.htm
|
I sometimes wonder if these posts are some kind of
practical joke. The ones addressed to old posts always
seem to be 3 years old.
...And the questions asked are usually unanswerable.
(This poster couldn't even be bothered with punctuation.)
...And I don't think I've ever seen one of these ghost-posters
follow up.
...I'm imagining a drunk college student somewhere, having
a whimsical conversation with what he imagines he's seeing
on his PC. :)