| 魔界の仮面弁士 様
大変お世話になっております。
ご教授頂いたお蔭で■90455が当方でもようやく動作致しました。
ありがとうございます。明日、これを用いてＷＥＢページダイアログのボタンイベントに取り掛かろうと思います。
ちなみに試行錯誤の結果、下記のようになりましたのでご報告致します。
'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
|