|  
  给自己的程序增加网页浏览功能 
有很多文章介绍了怎样在自己的程序中加入浏览网页的功能,我也曾经用VB制作自己的浏览器。大多是利用了SHDOCVW.DLL中的WEBBROWSER控件和INTERNET EXPLORER AUTOMATION。Shdocvw.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 AUTOMATION的EXECWB方法,提供了很多命令给用户执行,命令作用在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 
     
 
  |