VFP 能不能与不在VFP窗体下的浏览器交互？从hwnd获得webbrowser组件
VFP 能不能与不在VFP窗体下的浏览器交互？SendMessage hWnd, WM_HTML_GETOBJECT,0, 0
[此贴子已经被作者于2023-10-16 14:57编辑过]
从hwnd获得webbrowser组件
Option Explicit
Private Type UUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
Private Declare Sub ZeroMemory()Sub ZeroMemory Lib "kernel32.dll" Alias "RtlZeroMemory" ( _
Destination As Any, _
ByVal Length As Long)
Private Declare Function FindWindowA()Function FindWindowA Lib "user32" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As Long) As Long
Private Declare Function FindWindowExA()Function FindWindowExA Lib "user32" ( _
ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, _
ByVal lpsz1 As String, _
ByVal lpsz2 As Long) As Long
Private Declare Function ObjectFromLresult()Function ObjectFromLresult Lib "oleacc" ( _
ByVal lResult As Long, _
riid As UUID, _
ByVal wParam As Long, _
ppvObject As Any) As Long
Private Declare Function RegisterWindowMessageA()Function RegisterWindowMessageA Lib "user32" ( _
ByVal lpString As String) As Long
Private Declare Function SendMessageTimeoutA()Function SendMessageTimeoutA Lib "user32" ( _
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 EnumWindows()Function EnumWindows Lib "user32" ( _
ByVal lpEnumFunc As Long, _
lparam As Long) As Boolean
Private Declare Function RealGetWindowClassA()Function RealGetWindowClassA Lib "user32" ( _
ByVal hwnd As Long, _
ByVal psztype As String, _
ByVal cchtype As Long) As Long
Private Declare Function ShellExecuteA()Function ShellExecuteA Lib "shell32.dll" ( _
ByVal hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
Private Declare Sub Sleep()Sub Sleep Lib "kernel32" ( _
ByVal dwMilliseconds As Long)
'// FindWindow args
Private Const arg As String = "ieframe"
Private Const arg1 As String = "shell docobject view"
Private Const arg2 As String = "Internet Explorer_Server"
'// GetObject args
Private Const WM_HTML_GETOBJECT As String = "WM_HTML_GETOBJECT"
Private HTML As HTMLDocument
Dim Handle As Long
Dim IsIE As String
Public Sub doLogin()Sub doLogin()
IsIE = vbNullString
IsIE = Space$(10)
EnumWindows AddressOf Frames, 0
End Sub
Public Sub GoWeb()Sub GoWeb(ByVal address As String, Optional Timeout As Long)
ShellExecuteA 0, "open", address, "", vbNullString, 1
Sleep Timeout
End Sub
Public Function Generate()Function Generate(ByVal hwnd As Long) As IHTMLDocument
Dim ID As UUID
Dim lngReg As Long
Dim lngHnD As Long
lngHnD = RegisterWindowMessageA(WM_HTML_GETOBJECT)
With ID
.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 SendMessageTimeoutA(hwnd, lngHnD, 0, 0, &H2, 2000, lngReg)
Call ZeroMemory(ID, Len(ID))
'从句柄获得webbrowser对象
Call ObjectFromLresult(lngReg, ID, 0, Generate)
End Function
调用的方法：
Dim xDoc As IHTMLDocument
Set xDoc = Generate(hwnd)
