VB IE控制

VERSION 5.00
Begin VB.UserControl uctlIe
   ClientHeight    =   450
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   510
   ScaleHeight     =   450
   ScaleWidth      =   510
End
Attribute VB_Name = "uctlIe"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
Private WithEvents IEWindow As SHDocVw.WebBrowser
Attribute IEWindow.VB_VarHelpID = -1
Event BeforeNavigate2(ByVal pDisp As Object, ByVal URL As String, ByVal Flags As Long, ByVal TargetFrameName As String, PostData As Variant, ByVal Headers As String, Cancel As Boolean)
Event NewWindow2(ByVal pDisp As Object, ByVal Cancel As Boolean)
Event NavigateError(ByVal pDisp As Object, URL As Variant, Frame As Variant, StatusCode As Variant, Cancel As Boolean)
Event NavigateComplete2(ByVal pDisp As Object, ByVal URL As String)
Event ClientToHostWindow(CX As Long, CY As Long)
Event CommandStateChange(ByVal Command As Long, ByVal Enable As Boolean)
Event DocumentComplete(ByVal pDisp As Object, URL)
Event DownloadBegin()
Event DownloadComplete()
Event FileDownload(Cancel As Boolean)
Event OnFullScreen(ByVal FullScreen As Boolean)
Event OnMenuBar(ByVal MenuBar As Boolean)
Event OnQuit()
Event OnStatusBar(ByVal StatusBar As Boolean)
Event OnTheaterMode(ByVal TheaterMode As Boolean)
Event OnToolBar(ByVal ToolBar As Boolean)
Event OnVisible(ByVal Visible As Boolean)
Event PrintTemplateInstantiation(ByVal pDisp As Object)
Event PrintTemplateTeardown(ByVal pDisp As Object)
Event PrivacyImpactedStateChange(ByVal bImpacted As Boolean)
Event ProgressChange(ByVal Progress As Long, ByVal ProgressMax As Long)
Event PropertyChange(ByVal szProperty As String)
Event SetSecureLockIcon(ByVal SecureLockIcon As Long)
Event StatusTextChange(ByVal Text As String)
Event TitleChange(ByVal Text As String)
Event UpdatePageStatus(ByVal pDisp As Object, nPage, fDone)
Event WindowClosing(ByVal IsChildWindow As Boolean, Cancel As Boolean)
Event WindowSetHeight(ByVal Height As Long)
Event WindowSetLeft(ByVal Left As Long)
Event WindowSetResizable(ByVal Resizable As Boolean)
Event WindowSetTop(ByVal Top As Long)
Event WindowSetWidth(ByVal Width As Long)

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WM_SETTEXT = &HC

Private Sub Class_Initialize()
    Set IEWindow = New SHDocVw.WebBrowser
End Sub

'请求连接前触发的事件
Private Sub IEWindow_BeforeNavigate2(ByVal pDisp As Object, URL, Flags, TargetFrameName, PostData, Headers, Cancel As Boolean)
    RaiseEvent BeforeNavigate2(pDisp, URL, Flags, TargetFrameName, PostData, Headers, Cancel)
End Sub

'当需要创建新窗口时触发的事件
Private Sub IEWindow_NewWindow2(pDisp As Object, Cancel As Boolean)
    RaiseEvent NewWindow2(pDisp, Cancel)
End Sub

'当访问出错触发的事件
Private Sub IEWindow_NavigateError(ByVal pDisp As Object, URL As Variant, Frame As Variant, StatusCode As Variant, Cancel As Boolean)
    RaiseEvent NavigateError(pDisp, URL, Frame, StatusCode, Cancel)
End Sub

'当访问完成触发的事件
Private Sub IEWindow_NavigateComplete2(ByVal pDisp As Object, URL As Variant)
    RaiseEvent NavigateComplete2(pDisp, URL)
End Sub

Public Property Get IEObject() As SHDocVw.WebBrowser
    Set IEObject = IEWindow
End Property

Public Property Let IEObject(ByVal vNewValue As SHDocVw.WebBrowser)
    Set IEWindow = vNewValue
End Property

Private Sub IEWindow_ClientToHostWindow(CX As Long, CY As Long)
    RaiseEvent ClientToHostWindow(CX, CY)
End Sub

Private Sub IEWindow_CommandStateChange(ByVal Command As Long, ByVal Enable As Boolean)
    RaiseEvent CommandStateChange(Command, Enable)
End Sub

Private Sub IEWindow_DocumentComplete(ByVal pDisp As Object, URL)
    RaiseEvent DocumentComplete(pDisp, URL)
End Sub

Private Sub IEWindow_DownloadBegin()
    RaiseEvent DownloadBegin
End Sub

Private Sub IEWindow_DownloadComplete()
    RaiseEvent DownloadComplete
End Sub

Private Sub IEWindow_FileDownload(Cancel As Boolean)
    RaiseEvent FileDownload(Cancel)
End Sub

Private Sub IEWindow_OnFullScreen(ByVal FullScreen As Boolean)
    RaiseEvent OnFullScreen(FullScreen)
End Sub

Private Sub IEWindow_OnMenuBar(ByVal MenuBar As Boolean)
    RaiseEvent OnMenuBar(MenuBar)
End Sub

Private Sub IEWindow_OnQuit()
    RaiseEvent OnQuit
End Sub

Private Sub IEWindow_OnStatusBar(ByVal StatusBar As Boolean)
    RaiseEvent OnStatusBar(StatusBar)
End Sub

Private Sub IEWindow_OnTheaterMode(ByVal TheaterMode As Boolean)
    RaiseEvent OnTheaterMode(TheaterMode)
End Sub

Private Sub IEWindow_OnToolBar(ByVal ToolBar As Boolean)
    RaiseEvent OnToolBar(ToolBar)
End Sub

Private Sub IEWindow_OnVisible(ByVal Visible As Boolean)
    RaiseEvent OnVisible(Visible)
End Sub

Private Sub IEWindow_PrintTemplateInstantiation(ByVal pDisp As Object)
    RaiseEvent PrintTemplateInstantiation(pDisp)
End Sub

Private Sub IEWindow_PrintTemplateTeardown(ByVal pDisp As Object)
    RaiseEvent PrintTemplateTeardown(pDisp)
End Sub

Private Sub IEWindow_PrivacyImpactedStateChange(ByVal bImpacted As Boolean)
    RaiseEvent PrivacyImpactedStateChange(bImpacted)
End Sub

Private Sub IEWindow_ProgressChange(ByVal Progress As Long, ByVal ProgressMax As Long)
    RaiseEvent ProgressChange(Progress, ProgressMax)
End Sub

Private Sub IEWindow_PropertyChange(ByVal szProperty As String)
    RaiseEvent PropertyChange(szProperty)
End Sub

Private Sub IEWindow_SetSecureLockIcon(ByVal SecureLockIcon As Long)
    RaiseEvent SetSecureLockIcon(SecureLockIcon)
End Sub

Private Sub IEWindow_StatusTextChange(ByVal Text As String)
    RaiseEvent StatusTextChange(Text)
End Sub

Private Sub IEWindow_TitleChange(ByVal Text As String)
    RaiseEvent TitleChange(Text)
End Sub

Private Sub IEWindow_UpdatePageStatus(ByVal pDisp As Object, nPage, fDone)
    RaiseEvent UpdatePageStatus(pDisp, nPage, fDone)
End Sub

Private Sub IEWindow_WindowClosing(ByVal IsChildWindow As Boolean, Cancel As Boolean)
    RaiseEvent WindowClosing(IsChildWindow, Cancel)
End Sub

Private Sub IEWindow_WindowSetHeight(ByVal Height As Long)
    RaiseEvent WindowSetHeight(Height)
End Sub

Private Sub IEWindow_WindowSetLeft(ByVal Left As Long)
    RaiseEvent WindowSetLeft(Left)
End Sub

Private Sub IEWindow_WindowSetResizable(ByVal Resizable As Boolean)
    RaiseEvent WindowSetResizable(Resizable)
End Sub

Private Sub IEWindow_WindowSetTop(ByVal Top As Long)
    RaiseEvent WindowSetTop(Top)
End Sub

Private Sub IEWindow_WindowSetWidth(ByVal Width As Long)
    RaiseEvent WindowSetWidth(Width)
End Sub

Private Sub Class_Terminate()
    Set IEWindow = Nothing
End Sub

Public Sub Navigate(ByVal URL As String, ByVal Flags As Long, ByVal TargetFrameName As String, PostData As Variant, ByVal Headers As String)
    IEWindow.Navigate URL, Flags, TargetFrameName, PostData, Headers
End Sub

Public Sub Navigate2(ByVal URL As String, ByVal Flags As Long, ByVal TargetFrameName As String, PostData As Variant, ByVal Headers As String)
    IEWindow.Navigate2 URL, Flags, TargetFrameName, PostData, Headers
End Sub

Public Sub SetIEWindowText(IEWindow As SHDocVw.WebBrowser, ByVal strText As String)
    SendMessage IEWindow.hwnd, WM_SETTEXT, 0, ByVal strText
End Sub