technofantasy

博客园 首页 新随笔 联系 订阅 管理
Option Explicit

Private Type UUID
    Data1 
As Long
    Data2 
As Integer
    Data3 
As Integer
    Data4(
0 To 7As Byte
End Type

Private Declare Sub ZeroMemory Lib "kernel32.dll" Alias "RtlZeroMemory" ( _
        Destination 
As Any, _
        
ByVal Length As Long)

Private Declare Function FindWindowA Lib "user32" ( _
        
ByVal lpClassName As String, _
        
ByVal lpWindowName As LongAs Long

Private Declare Function FindWindowExA Lib "user32" ( _
        
ByVal hWnd1 As Long, _
        
ByVal hWnd2 As Long, _
        
ByVal lpsz1 As String, _
        
ByVal lpsz2 As LongAs 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 RegisterWindowMessageA Lib "user32" ( _
        
ByVal lpString As StringAs Long

Private Declare 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 LongAs Long

Private Declare Function EnumWindows Lib "user32" ( _
        
ByVal lpEnumFunc As Long, _
        lparam 
As LongAs Boolean

Private Declare Function RealGetWindowClassA Lib "user32" ( _
        
ByVal hwnd As Long, _
        
ByVal psztype As String, _
        
ByVal cchtype As LongAs Long

Private Declare 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 LongAs Long

Private Declare 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()
    IsIE 
= vbNullString
    IsIE 
= Space$(10)
    EnumWindows 
AddressOf Frames, 0
End Sub


Public Sub GoWeb(ByVal address As StringOptional Timeout As Long)
    ShellExecuteA 
0"open", address, "", vbNullString, 1
    Sleep Timeout
End Sub


Public Function Generate(ByVal hwnd As LongAs 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, 00&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)
posted on 2006-06-30 12:20  陈锐  阅读(840)  评论(0)    收藏  举报