給自己的程序增加網頁瀏覽功能（續）

領測軟件測試網

 給自己的程序增加網頁瀏覽功能（續）

 

Private Sub mnuFileSaveAs_Click()

   

brwWebBrowser.SetFocus

On Error Resume Next

brwWebBrowser.ExecWB OLECMDID_SAVEAS, OLECMDEXECOPT_DODEFAULT

‘MILY: 宋體; mso-ascii-font-family: 'Times New Roman'; mso-hansi-font-family: 'Times New Roman'">另存為   

    ‘以下是用原始的方式另存為

'    Dim sFile As String

'

'

'    With dlgCommonDialog

'        .DialogTitle = "另存為..."

'        .CancelError = False

'        '.FileName = Me.brwWebBrowser.LocationName

'        'ToDo: 設置 common dialog 控件的標志和屬性

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

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

'        .ShowSave

'        If Len(.FileName) = 0 Then

'            Exit Sub

'        End If

'        sFile = .FileName

'    End With

'    'ToDo: 添加處理打開的文件的代碼

'    brwWebBrowser.Navigate sFile

'

'    'To Do Save As ...

   

End Sub

 

Private Sub mnuFileSetPage_Click()

    brwWebBrowser.SetFocus

    On Error Resume Next

    brwWebBrowser.ExecWB OLECMDID_PAGESETUP, OLECMDEXECOPT_DODEFAULT

‘頁面設置

End Sub

 

Private Sub mnuFileView_Click()

    brwWebBrowser.SetFocus

    On Error Resume Next

    brwWebBrowser.ExecWB OLECMDID_PRINTPREVIEW, OLECMDEXECOPT_DODEFAULT

    ‘打印預覽

End Sub

 

Private Sub mnuFileWork_Click()

 

    Me.mnuFileWork.Checked = Not Me.mnuFileWork.Checked

    Me.brwWebBrowser.Offline = Me.mnuFileWork.Checked

    ‘脫機

End Sub

 

 

 

一、        WEBBROWSER控件

WEBBROWSER控件不但可以打開網頁，還可以打開很多其他格式的文件和瀏覽硬盤上的文件。這得益于MS的OLE政策。

當瀏覽一個網頁時，右鍵菜單中的在新窗口打開時，缺省是用IE打開，下面代碼是控制用個人的瀏覽器打開。

Private Sub brwWebBrowser_NewWindow2(ppDisp As Object, Cancel As Boolean)

    Dim frmWB As frmMainExploer

    Set frmWB = New frmMainExploer

   

    frmWB.brwWebBrowser.RegisterAsBrowser = True

    Set ppDisp = frmWB.brwWebBrowser.Object

   

    frmWB.Visible = True

   

End Sub

 

更新窗口標題

Private Sub brwWebBrowser_TitleChange(ByVal Text As String)

    Me.Caption = Text

End Sub

 

在網頁中可能會有關閉窗口的按扭，點擊它會關閉我們的WEBBROWSER控件的實例，以下代碼就是避免情況的發生。

Private Sub brwWebBrowser_WindowClosing(ByVal IsChildWindow As Boolean, Cancel As Boolean)

    If IsChildWindow = False Then

   

        Cancel = True

    Else

        Cancel = False

   

    End If

End Sub

 

無用代碼

Private Sub mnuHelpTest_Click()

   

    brwWebBrowser.SetFocus

    On Error Resume Next

    brwWebBrowser.ExecWB OLECMDID_NEW, OLECMDEXECOPT_DODEFAULT

   

End Sub

 

用了SHELL打開INTERNET選項的控制面板，也可以用SHDOCVW.DLL提供的API打開。

Private Sub mnuToolOption_Click()

    Dim dblReturn As Double

    dblReturn = Shell("rundll32.exe shell32.dll,Control_RunDLL inetcpl.cpl,,0", 5)

 

End Sub

 

全屏顯示，對于WEBBROWSER控件無效。

Private Sub mnuViewFullScreen_Click()

    Me.brwWebBrowser.ExecWB OLECMDID_ZOOM, OLECMDEXECOPT_DODEFAULT

End Sub

 

 

 

 

二、        INTERNET EXPLORER AUTOMATION

 

下面代碼顯示怎樣控制一個INTERNET EXPLORER AUTOMATION的實例。

Dim ie As SHDocVw.InternetExplorer

'

'    Set ie = CreateObject("InternetExplorer.Application")       ‘創建一個實例

'    ie.Navigate2 "C:\"

'    ie.FullScreen = False       ‘是否全屏

'    ie.Visible = True

'    ie.ToolBar = True    ‘是否顯示工具條

'    ie.MenuBar = True           ‘是否顯示菜單

'    ie.StatusBar = True              ‘是否顯示狀態條

'    ie.Resizable = False    ‘是否可變窗口大小。

'在IE6中，增加了個人欄，加上搜索欄、收藏夾和歷史共有四個瀏覽條。以下是控制顯示以下四個瀏覽條的代碼。

'    IE.ShowBrowserBar "{30D02401-6A81-11D0-8274-00C04FD5AE38}", True

'

'    IE.ShowBrowserBar "{EFA24E61-B078-11D0-89E4-00C04FC9E26E}", True

'

'    ie.ShowBrowserBar "{EFA24E62-B078-11D0-89E4-00C04FC9E26E}", True

'

'    ie.ShowBrowserBar "{EFA24E63-B078-11D0-89E4-00C04FC9E26E}", True

 

 

三、        MSHTML中的語法解釋

以下是利用了MSHTML.DLL的語法分析功能， 模仿《程序員大本營2001》中的BORLAND�？�中的查找所有鏈結的代碼。

Dim strFilePath As String

 Dim WithEvents MyIE  As SHDocVw.InternetExplorer

 

Private Sub Command1_Click()

    On Error Resume Next

    Me.dlgOpen.ShowOpen

    strFilePath = dlgOpen.FileName

    Me.brwIE.Navigate2 strFilePath

   

End Sub

 

Private Sub Command2_Click()

'On Error Resume Next

    Dim doc As IHTMLDocument2   ‘IHTML文檔

    Set doc = Me.brwIE.Document

    Dim eles As IHTMLElementCollection              ‘IHTML元素集合

    Dim ele As IHTMLElement

    Dim strLink As String

    Dim ancho As IHTMLAnchorElement             ‘矛點元素

    Dim img As IHTMLImgElement

   

    Dim i As Integer

    i = 0

    List1.Clear

    If doc Is Nothing Then

       

'        MsgBox "Document is nothing!"

    Else

       

        Set eles = doc.All

        For Each ele In eles

            If ele.tagName = "A" Then

                strLink = ele.innerText

                If strLink = "" Then

                   strLink = "Empty!"

                End If

                Set ancho = ele

                strLink = strLink & " -- " & ancho.href

                List1.AddItem strLink

            End If

        Next

               

        Text1 = doc.mimeType

    End If

End Sub

 

Private Sub Form_Load()

    Set MyIE = CreateObject("InternetExplorer.Application")

    MyIE.Visible = True

End Sub

 

四、SHDOCVW.DLL和INETCPL中的API

 

Public Const MAX_PATH = 260

Public Const CSIDL_FAVORITES = &H6

 

Public Declare Function LaunchInternetControlPanel Lib "inetcpl.cpl" (ByVal hwndParent As Long) As Long

Public Declare Function LaunchConnectionDialog Lib "inetcpl.cpl" (ByVal hwndParent As Long) As Long

Public Declare Function LaunchSecurityDialog Lib "inetcpl.cpl" (ByVal hwndParent As Long) As Long

Public Declare Function LaunchSiteCertDialog Lib "inetcpl.cpl" (ByVal hwndParent As Long) As Long

Public Declare Function OpenFontsDialog Lib "inetcpl.cpl" (ByVal hwndParent As Long) As Long

 

Public Declare Function DoOrganizeFavDlg Lib "shdocvw.dll" (ByVal hwndParent As Long, ByVal lpszPath As String) As Long

Public Declare Function SHGetSpecialFolderPath Lib "shell32.dll" Alias "SHGetSpecialFolderPathA" (ByVal hwndOwner As Long, ByVal lpszPath As String, ByVal nFolder As Long, ByVal fCreate As Long) As Long

Public Declare Function DoAddToFavDlg Lib "shdocvw.dll" (ByVal hwndParent As Long, ByVal lpszPath As String) As Long

Public Declare Function AddUrlToFavorites Lib "shdocvw.dll" (ByVal hwndParent As Long, ByVal lpszPath As String) As Long       ‘這個函數的參數定義有問題。

 

'

 

'Private Sub Command1_Click()

'    Dim rc As Long

'’顯示INTERNET選項的控制面板

'    rc = LaunchInternetControlPanel(Me.hWnd)

'    Debug.Print GetLastError

'    If rc = 0 Then

'        MsgBox "LaunchInternetControlPanel failed!", vbExclamation

'    End If

'End Sub

'

'Private Sub Command2_Click()

'    Dim rc As Long

'’IE控制面板中的連接面板

'    rc = LaunchConnectionDialog(Me.hWnd)

'    Debug.Print GetLastError

'    If rc = 0 Then

'        MsgBox "LaunchConnectionDialog failed!", vbExclamation

'    End If

'End Sub

'

'Private Sub Command3_Click()

'    Dim rc As Long

'    Dim strFavPath As String * MAX_PATH

'’收藏夾所在的目錄

'    SHGetSpecialFolderPath Me.hWnd, strFavPath, CSIDL_FAVORITES, False

整理收藏夾

'    rc = DoOrganizeFavDlg(Me.hWnd, strFavPath)

'    Debug.Print GetLastError

'    If rc = 0 Then

'        MsgBox "DoOrganizeFavDlg failed!", vbExclamation

'    End If

'End Sub

'

'Private Sub Command4_Click()

'    Dim rc As Long

'

'    rc = LaunchSiteCertDialog(Me.hWnd)

'    Debug.Print GetLastError

'    If rc = 0 Then

'        MsgBox "LaunchSiteCertDialog failed!", vbExclamation

'    End If

'End Sub

'

'

'

'Private Sub Command6_Click()

'    Dim rc As Long

'    Dim strFavPath As String * MAX_PATH

'

'    SHGetSpecialFolderPath Me.hWnd, strFavPath, CSIDL_FAVORITES, False

‘添加到收藏夾，但這個函數的參數我沒有實驗處理，會出錯。

'    rc = AddUrlToFavorites(Me.hWnd, Trim(strFavPath))

'    Debug.Print GetLastError

'    If rc = 0 Then

'        MsgBox "DoOrganizeFavDlg failed!", vbExclamation

'    End If

'

'End Sub

總結

其實已經有很多文章寫了這方面的內容了，我還是把這些心得寫出來給大家分享。是因為想整理出一個比較全的東西來給大家參考。其實還有很多功能我還無法實現，例如，如何在WEBBROWSERCONTROL中屏蔽或改掉右鍵菜單，因為，WEBBROWSER CONTROL沒有提供HWND給我們用；還不知道怎樣取得WEBBROWSER控件中的網頁代碼，和實現全屏；在WEBBROWSER控件中查找；改變網頁文字的大小，和編碼等等。大家如果有什么新的發現，記得告訴我(mousebox@21cn.com)。

 

延伸閱讀

文章來源于領測軟件測試網 http://www.kjueaiud.com/