分享
 
 
 

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

王朝vb·作者佚名  2006-01-08
窄屏简体版  字體: |||超大  

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

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

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有