|
魔界の仮面弁士 様
大変お世話になっております。 ご教授頂いたお蔭で■90455が当方でもようやく動作致しました。 ありがとうございます。明日、これを用いてWEBページダイアログのボタンイベントに取り掛かろうと思います。
ちなみに試行錯誤の結果、下記のようになりましたのでご報告致します。
'Option Strict On 'これオンすると遅延バインディング使用できませんと出る為、削除しました。
Public Class Form1
Dim o As Object Dim aShell As SHDocVw.ShellWindows Dim doc As mshtml.HTMLDocument Dim yahooButton As mshtml.IHTMLElement Dim Event1 As mshtml.HTMLInputTextElementEvents2_Event
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
EnumWindows(New EnumWindowsDelegate(AddressOf EnumWindowCallBack), IntPtr.Zero)
o = GetIEDocument(hWnd_IES) ' No90411 を参照
doc = DirectCast(o, mshtml.HTMLDocument)
Debug.WriteLine(doc.body.document.body.innerHTML)
yahooButton = DirectCast(doc.all.item("yahoo"), mshtml.IHTMLElement)
Event1 = DirectCast(DirectCast(doc.all.item("yahoo"), mshtml.IHTMLElement), mshtml.HTMLInputTextElementEvents2_Event) AddHandler Event1.onclick, AddressOf WebDisp_click
End Sub
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click yahooButton.click() End Sub
Private Function WebDisp_click(ByVal e As mshtml.IHTMLEventObj) As Boolean MsgBox("webDisp_onclick", MsgBoxStyle.SystemModal) Return True End Function
End Class
'***************************************************************************************
Imports System.Runtime.InteropServices Imports System.Text
Module API
Public hWnd_IEFRAME As IntPtr Public hWnd_IES As IntPtr
<DllImport("user32")> Function GetClassName( <[In]()> ByVal hWnd As IntPtr, <Out()> ByVal lpClassName As StringBuilder, <[In]()> ByVal nMaxCount As Integer ) As Integer End Function
<DllImport("user32")> Function EnumChildWindows( <[In]()> ByVal hWndParent As IntPtr, <[In]()> ByVal lpEnumFunc As EnumChildProc, <[In]()> ByRef lParam As IntPtr ) As Boolean End Function
<DllImport("user32")> Function RegisterWindowMessage( <[In]()> ByVal lpString As String ) As Integer End Function
<DllImport("user32")> Function SendMessageTimeout( <[In]()> ByVal hWnd As IntPtr, <[In]()> ByVal msg As Integer, <[In]()> ByVal wParam As Integer, <[In]()> ByVal lParam As Integer, <[In]()> ByVal fuFlags As Integer, <[In]()> ByVal uTimeout As Integer, <Out()> ByRef lpdwResult As IntPtr ) As IntPtr End Function
<DllImport("oleacc")> Function ObjectFromLresult( <[In]()> ByVal lResult As Int32, <[In]()> ByRef riid As System.Guid, <[In]()> ByVal wParam As Int32, <Out(), MarshalAs(UnmanagedType.Interface)> ByRef ppvObject As Object ) As IntPtr End Function
<DllImport("user32.dll", CharSet:=CharSet.Auto, SetLastError:=True)> Public Function GetWindowText(hWnd As IntPtr, lpString As StringBuilder, nMaxCount As Integer) As Integer End Function
<DllImport("user32.dll", CharSet:=CharSet.Auto, SetLastError:=True)> Public Function GetWindowTextLength(hWnd As IntPtr) As Integer End Function
<DllImport("user32.dll")> Public Function EnumWindows(lpEnumFunc As EnumWindowsDelegate, ByVal lparam As IntPtr) As <MarshalAs(UnmanagedType.Bool)> Boolean End Function
Delegate Function EnumWindowsDelegate(hWnd As IntPtr, ByVal lparam As IntPtr) As Boolean
Delegate Function EnumChildProc(hWnd As IntPtr, ByVal lParam As IntPtr) As Boolean
Public Function EnumWindowCallBack(hWnd As IntPtr, ByVal lparam As IntPtr) As Boolean
Dim textLen As Integer = GetWindowTextLength(hWnd) Dim tsb As New StringBuilder(textLen + 1) Dim csb As New StringBuilder(256)
If 0 <textLen Then GetWindowText(hWnd, tsb, tsb.Capacity) GetClassName(hWnd, csb, csb.Capacity)
If tsb.ToString() = "JavaScript テスト - Internet Explorer" Then If csb.ToString() = "IEFrame" Then
hWnd_IEFRAME = hWnd
EnumChildWindows(hWnd_IEFRAME, AddressOf EnumChildWindowsProc, IntPtr.Zero)
End If End If
End If
Return True End Function
Public Function EnumChildWindowsProc(hWnd As IntPtr, lparam As IntPtr) As IntPtr
Dim textLen As Integer = GetWindowTextLength(hWnd) Dim tsb As New StringBuilder(textLen + 1) Dim csb As New StringBuilder(256)
GetClassName(hWnd, csb, csb.Capacity)
If csb.ToString() = "Internet Explorer_Server" Then
hWnd_IES = hWnd
End If EnumChildWindowsProc = 1 End Function
'***********************************************************************
'IEオブジェクト取得メソッド
Function GetIEDocument(ByVal hWnd As IntPtr) As Object
Dim nMsg As Integer Dim lRes As IntPtr Dim IID_IHTMLDocument As System.Guid = New System.Guid("626FC520-A41E-11CF-A731-00A0C9082637") Dim SMTO_ABORTIFHUNG As Integer = &H2 Dim spDoc As Object = Nothing
nMsg = RegisterWindowMessage("WM_HTML_GETOBJECT")
If nMsg <> 0 Then SendMessageTimeout(hWnd, nMsg, 0, 0, SMTO_ABORTIFHUNG, 1000, lRes) If Not lRes = IntPtr.Zero Then ObjectFromLresult(lRes, IID_IHTMLDocument, 0, spDoc) End If End If
Return spDoc End Function
End Module
|