×

[VB.NET] 给自己的程序增加网页浏览功能

Kalet Kalet 发表于2009-03-20 12:00:13 浏览342 评论0

抢沙发发表评论

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

  有很多文章介绍了怎样在自己的程序中加入浏览网页的功能,我也曾经用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中有什么函数。

[VB.NET] 给自己的程序增加网页浏览功能

  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 "***"


  brwWebBrowser.*** ‘刷新


  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"

[VB.NET] 给自己的程序增加网页浏览功能

  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.***


  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

[VB.NET] 给自己的程序增加网页浏览功能

  End Sub



群贤毕至

访客