VB IE控制

canca15年前 (2009-04-02)VB361

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

相关文章

在VB中实现MD5算法

——————————————————————————————————————Option Explicit Dim w1 As String, w2 As String, w3 As Strin...

VB小作品--成语大全

       两三年没用过VB开发过啦!今天我用VB开发了个《成语大全》感觉还OK吧!本来想用.Net开发的,它那个框架这么吓人,...

祝各位圣诞快乐

昨晚用VB弄的圣诞小礼物。呵呵...一时兴致到了... 下载:http://exs.mail.qq.com/cgi-bin/downloadfilepart?svrid=16&fid=2535...

就类似于3721的插件一样,当用户浏览我的网站的时候,提示下载运行插件

实现方法如下: 首先需要获得IObjectWithSite接口的定义,你下载个olelib.tlb,包含了接口定义。然后创建一个ActiveX DLL工程, 在工程中引用这个tlb文件,...

CreateDesktop实现虚拟桌面

CreateDesktop实现虚拟桌面

'Module1 引用: Public Declare Function GetThreadDesktop Lib "user32" (ByVal dwThread As Long) As Long...

VB获取WebBroswer里的验证码

Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant) Dim X, CtrlRange Dim...

发表评论

访客

◎欢迎参与讨论,请在这里发表您的看法和观点。