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

给自己的程序增加网页浏览功能（续） Private Sub mnuFileSaveAs_Click() brwWebBrowser.SetFocusOn Error Resume NextbrwWebBrowser.ExecWB OLECMDID_SAVEAS, OLECMDEXECOPT_DODEFAULT‘另存为 ‘以下是用原始的方式另存为' 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 IfEnd 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_DODEFAULTEnd 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 IfEnd Sub Private Sub Form_Load() Set MyIE = CreateObject("InternetExplorer.Application") MyIE.Visible = TrueEnd Sub四、SHDOCVW.DLL和INETCPL中的API Public Const MAX_PATH = 260Public Const CSIDL_FAVORITES = &H6 Public Declare Function LaunchInternetControlPanel Lib "inetcpl.cpl" (ByVal hwndParent As Long) As LongPublic Declare Function LaunchConnectionDialog Lib "inetcpl.cpl" (ByVal hwndParent As Long) As LongPublic Declare Function LaunchSecurityDialog Lib "inetcpl.cpl" (ByVal hwndParent As Long) As LongPublic Declare Function LaunchSiteCertDialog Lib "inetcpl.cpl" (ByVal hwndParent As Long) As LongPublic 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 LongPublic 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 LongPublic Declare Function DoAddToFavDlg Lib "shdocvw.dll" (ByVal hwndParent As Long, ByVal lpszPath As String) As LongPublic 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)。