给自己的程序增加网页浏览功能

    技术2022-05-11  115

     给自己的程序增加网页浏览功能

    有很多文章介绍了怎样在自己的程序中加入浏览网页的功能,我也曾经用VB制作自己的浏览器。大多是利用了SHDOCVW.DLL中的WEBBROWSER控件和INTERNET EXPLORER AUTOMATIONShdocvw.DLL提供了COM接口,使得程序员可以在自己的程序中使用WEBBROWSER控件和INTERNET EXPLORER AUTOMATION。它还提供了系列的INTERNET API函数,给我们控制INTERNET EXPLORER

    如果大家想了解SHDOCVW.DLL提供了些什么给我们,可以用《高级VISUAL BASIC编程》(中国电力出版社)中TYPE LIBRARY EDITOR工具浏览SHDOCVW.DLL中的内幕。还可以用Exescope这个资源编辑工具看看SHDOCVW.DLL中有什么函数。

     

    IE基本架构(摘自《程序员》专刊)

    IEXPLORER.EXE

    SHDOCVW.DLL–WEBBROWSER CONTROL AND INTERNET EXPLORER AUTOMATION页面显示

    MSHTML.DLL – MSHTML,处理页面的语法分析,又是一个COM服务器,把HTML中的页面元素定义成对象,给客户端访问

    HTML

    ACTIVEX CONTROL

    ACTIVEX SCRIPT ENGINE

    JAVA APPLET

    PLUG IN

     

    MSDN中有详细的帮助介绍WEBBROWSER控件和INTERNET EXPLORER AUTOMATION。它们的属性、方法和事件大部分相同,有部分属性和方法WEBBROWSER控件会忽略掉。SHDOCVW.DLL提供一个手段给我们把网页浏览功能加入到我们的程序中,或控制一个INTERNET EXPLORER实例。以下是一些我在应用中使用到的技巧,我以代码加说明的形式给出大家参考。

     

    一、        工具栏

    brwWebBrowser是一个WEBBROWSER控件的实例,CommandStateChange事件可以实现工具栏中的前进和后退的是否有效。

    Private Sub brwWebBrowser_CommandStateChange(ByVal Command As Long, ByVal Enable As Boolean)

        Select Case Command

            Case CSC_UPDATECOMMANDS

    '            Me.tbToolBar.Buttons(1).Enabled = Enable

    '            Me.tbToolBar.Buttons(2).Enabled = Enable

     

     

            Case CSC_NAVIGATEFORWARD

    工具栏的前进按扭的有效状态改变

                Me.tbToolBar.Buttons(2).Enabled = Enable 

    工具栏的后退按扭的有效状态改变

            Case CSC_NAVIGATEBACK

                Me.tbToolBar.Buttons(1).Enabled = Enable

     

            Case Else

     

     

        End Select

    End Sub

     

    利用WEBBROWSER的方法进行导航

    Private Sub tbToolBar_ButtonClick(ByVal Button As MSComctlLib.Button)

    On Error Resume Next

        Select Case Button.Key

            Case "Back"

                brwWebBrowser.GoBack  后退

            Case "Forward"

               

                brwWebBrowser.GoForward           前进

            Case "Refresh"

                brwWebBrowser.Refresh  刷新

            Case "Home"

                brwWebBrowser.GoHome 到主页

            Case "Search"

                Me.tbToolBar.Buttons("HtmlClass").Value = tbrUnpressed

                Me.tbToolBar.Buttons("History").Value = tbrUnpressed

                If Button.Value = tbrPressed Then

                    Me.brwSearch.Visible = True

                    Me.brwSearch.GoSearch

                    m_blnIsSplitter = True

                Else

                    Me.brwSearch.Visible = False

                    Me.brwSearch.GoSearch

                    m_blnIsSplitter = False

               

                End If

                Me.UCtlHistroy1.Visible = False

                Me.UCtlClassUrl1.Visible = False

                Call ResizeControls(m_blnIsSplitter, Me.imgSplitter.Left)

               

            Case "Stop"

                    brwWebBrowser.Stop

        Me.Caption = brwWebBrowser.LocationName & "  -  " & strCurrentUserName

               

            Case "HtmlClass"

    '            If Button.Value = tbrPressed Then

    '                Me.tbToolBar.Buttons("History").Value = tbrUnpressed

    '                Me.tbToolBar.Buttons("Search").Value = tbrUnpressed

    '

    '                m_blnIsSplitter = True

    '                Me.UCtlClassUrl1.Visible = True

    '                Me.UCtlHistroy1.Visible = False

    '

    '                Me.UCtlClassUrl1.BuildTree (Normal)

    '

    '            Else

    '                m_blnIsSplitter = False

    '                Me.UCtlClassUrl1.Visible = False

    '                Me.UCtlHistroy1.Visible = False

    '            End If

    '            Call ResizeControls(m_blnIsSplitter, Me.imgSplitter.Left)

                Call mnuManClass_Click

            Case "History"

    '            If Button.Value = tbrPressed Then

    '                Me.tbToolBar.Buttons("HtmlClass").Value = tbrUnpressed

    '                Me.tbToolBar.Buttons("Search").Value = tbrUnpressed

    '

    '                m_blnIsSplitter = True

    '                Me.UCtlHistroy1.Visible = True

    '                Me.UCtlClassUrl1.Visible = False

    '                Me.UCtlHistroy1.BuildTree (0)

    '            Else

    '                m_blnIsSplitter = False

    '                Me.UCtlHistroy1.Visible = False

    '                Me.UCtlClassUrl1.Visible = False

    '                Me.UCtlHistroy1.BuildTree (0)

    '            End If

    '            Call ResizeControls(m_blnIsSplitter, Me.imgSplitter.Left)

    '

                Call mnuManHistory_Click

               

            Case "PrintOut"

     

                brwWebBrowser.SetFocus

                On Error Resume Next

                brwWebBrowser.ExecWB OLECMDID_PRINT, OLECMDEXECOPT_DODEFAULT 打印

               

               

            Case "Status"

    '           m_blnStatusBarShow = CBool(Button.Value)

                Me.tbToolBar.Customize

    '            Me.tbToolBar.SaveToolbar

               

            Case "Help"

                Call mnuHelpAbout_Click

           

            Case "Exit"

                Call mnuFileClose_Click

            Case Else

                Exit Sub

        End Select

    End Sub

    (不好意思以上有很多垃圾代码。)

     

     

    二、        状态栏

    利用了WEBBROWSER控件的ProgressChange事件显示一个进度条;StatusTextChange事件更新状态栏窗格的信息,反映WEBBROWSER控件的的状态。

     

    Private Sub brwWebBrowser_DownloadBegin()

        ProgressShow True

    End Sub

     

    Sub ProgressShow(Visible As Boolean)              显示一个进度条

      Me.sbrHtml.Panels(2).Visible = Visible

      Progress1.Visible = Visible

      If Visible Then Progress1.Move sbrHtml.Panels(2).Left + 10, sbrHtml.Top + (sbrHtml.Height - sbrHtml.Height) / 2 + 10, sbrHtml.Panels(2).Width - 20

     

    End Sub

     

     

    Private Sub brwWebBrowser_ProgressChange(ByVal Progress As Long, ByVal ProgressMax As Long)

    On Error Resume Next

      Progress1.Max = ProgressMax

      If Progress > 0 Then

        Progress1.Value = Progress

      Else

        Progress1.Value = ProgressMax

      End If

    End Sub

     

     

     

    Private Sub brwWebBrowser_StatusTextChange(ByVal Text As String)

        Me.sbrHtml.Panels(1).Text = Text

        Me.sbrHtml.Refresh

       

    End Sub

     

    Private Sub brwWebBrowser_DownloadComplete()

        On Error Resume Next

        Me.Caption = brwWebBrowser.LocationName

        Me.cboAddress = Me.brwWebBrowser.LocationURL   地址栏的现时地址

        ProgressShow False

    End Sub

     

    三、        地址栏

     

    Private mbDontNavigateNow As Boolean       是否正在在导航状态的变量

     

    Private Sub cboAddress_Click()   选中下拉列表中的行

        If mbDontNavigateNow Then Exit Sub

        brwWebBrowser.Navigate cboAddress.Text       导航到下拉列表文本中的地址

    End Sub

     

     

    Private Sub cboAddress_KeyPress(KeyAscii As Integer)

        On Error Resume Next

        If KeyAscii = vbKeyReturn Then       在下拉列表中输入地址完毕

            cboAddress_Click

        End If

    End Sub

     

     

    NavigateComplete2事件中把导航的地址加入下拉列表中(如果列表中没有的话)。

    Private Sub brwWebBrowser_NavigateComplete2(ByVal pDisp As Object, URL As Variant)

    '    On Error Resume Next

       

      

        Dim i As Integer

        Dim bFound As Boolean

        Dim strTemp() As String

    Me.Caption = brwWebBrowser.LocationName

    查找地址是否已在列表中

        For i = 0 To cboAddress.ListCount - 1

            If cboAddress.List(i) = brwWebBrowser.LocationURL Then

                bFound = True

                Exit For

            End If

        Next i

        mbDontNavigateNow = True

        If bFound Then       找到

            cboAddress.RemoveItem I       移除

        End If

        cboAddress.AddItem brwWebBrowser.LocationURL, 0       添加

        cboAddress.ListIndex = 0

        mbDontNavigateNow = False

       

       

       

    End Sub

     

     

     

    四、        菜单

    WEBBROWSER控件和INTERNET EXPLORER AUTOMATIONEXECWB方法,提供了很多命令给用户执行,命令作用在OLE对象上。但有很多命令执行对WEBBROWSER控件无效,具体的方法参数请看MSDN

    Private Sub mnuEdigCut_Click()

        brwWebBrowser.SetFocus

        On Error Resume Next

        brwWebBrowser.ExecWB OLECMDID_CUT, OLECMDEXECOPT_DODEFAULT

    剪切

    End Sub

     

    Private Sub mnuEditCopy_Click()

        On Error Resume Next

        brwWebBrowser.SetFocus

        brwWebBrowser.ExecWB OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT

    复制

    End Sub

     

    Private Sub mnuEditFind_Click()

        On Error Resume Next

        brwWebBrowser.SetFocus

        brwWebBrowser.ExecWB OLECMDID_FIND, OLECMDEXECOPT_DODEFAULT

        查找,(无效)

    End Sub

     

    Private Sub mnuEditPaste_Click()

        On Error Resume Next

        brwWebBrowser.SetFocus

        brwWebBrowser.ExecWB OLECMDID_PASTE, OLECMDEXECOPT_DODEFAULT

    粘贴

    End Sub

     

    Private Sub mnuEditSelectedAll_Click()

         brwWebBrowser.SetFocus

         brwWebBrowser.ExecWB OLECMDID_SELECTALL, OLECMDEXECOPT_DODEFAULT

        全选

    End Sub

     

    Private Sub mnuFileAttrib_Click()

        Me.brwWebBrowser.SetFocus

        On Error Resume Next

        brwWebBrowser.ExecWB OLECMDID_PROPERTIES, OLECMDEXECOPT_DODEFAULT

    显示网页的属性

    End Sub

     

     

    Private Sub mnuFileNew_Click()

        Dim frmNew As New frmMainExploer       新建窗口

        frmNew.Show

        Set frmNew = Nothing

    End Sub

     

    Private Sub mnuFileOpen_Click()

       

    '    brwWebBrowser.SetFocus

    '    On Error Resume Next

    '    brwWebBrowser.ExecWB OLECMDID_OPEN, OLECMDEXECOPT_DODEFAULT

        打开

    以下是用原始的方式打开

        Dim sFile As String

     

     

        With dlgCommonDialog

            .DialogTitle = "打开网页"

            .CancelError = False

            'ToDo: 设置 common dialog 控件的标志和属性

            .Filter = "HTML文件(*.html,*.htm)|*.html;*htm|文本文件(*.txt)|*.txt|Asp文件(*.asp)|*.asp" & _

                    "|图形文件(*.bmp;*.jpg;*.jpeg;*.gif)|*.bmp;*.jpg;*.jpeg;*.gif|所有文件(*.*)|*.*"

            .ShowOpen

            If Len(.filename) = 0 Then

                Exit Sub

            End If

            sFile = .filename

        End With

        'ToDo: 添加处理打开的文件的代码

        brwWebBrowser.Navigate sFile

       

    End Sub

     

     

     

    Private Sub mnuFilePrint_Click()

        brwWebBrowser.SetFocus

        On Error Resume Next

        brwWebBrowser.ExecWB OLECMDID_PRINT, OLECMDEXECOPT_DODEFAULT

    打印

    End Sub

     

    Private Sub mnuFileSave_Click()

     

        brwWebBrowser.SetFocus

        On Error Resume Next

        brwWebBrowser.ExecWB OLECMDID_SAVE, OLECMDEXECOPT_DODEFAULT

     保存

     以下是用原始的方式保存网页

    ' Dim sFile As String

    '

    ' With dlgCommonDialog

    '   .DialogTitle = "保存"

    '   .Filter = "HTML文件(*.html,*.htm)|*.html;*htm|文本文件(*.txt)|*.txt|Asp文件(*.asp)|*.asp" & _

    '            "|图形文件(*.bmp;*.jpg;*.jpeg;*.gif)|*.bmp;*.jpg;*.jpeg;*.gif|所有文件(*.*)|*.*"

    '   .ShowSave

    ' End With

     

     End Sub

      


    最新回复(0)