ITPub博客

首页 > IT基础架构 > 网络安全 > 给自己的程序增加网页浏览功能(续) (转)

给自己的程序增加网页浏览功能(续) (转)

原创 网络安全 作者:worldblog 时间:2007-12-09 10:38:55 0 删除 编辑
给自己的程序增加网页浏览功能(续) (转)[@more@]

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

 

Private Sub mnuFileSaveAs_Click()

 

brwwebBrowser.SetFocus

On Error Resume Next

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

 XML:namespace prefix = o ns = "urn:schemas-microsoft-com:Office:office" />

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打开INTE.NET选项的控制面板,也可以用SHDOCVW.DLL提供的api打开。

Private Sub mnuToolOption_Click()

  Dim dblReturn As Double

  dblReturn = Shell("rundll32.exe shell32.dll,Control_RunDLL .netcpl.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.DLLINETCPL中的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控件中查找;改变网页文字的大小,和编码等等。大家如果有什么新的发现,记得告诉我(Mailto:mousebox@21cn.com">mousebox@21cn.com)。

 


来自 “ ITPUB博客 ” ,链接:http://blog.itpub.net/10752043/viewspace-990435/,如需转载,请注明出处,否则将追究法律责任。

请登录后发表评论 登录
全部评论
  • 博文量
    6241
  • 访问量
    2463336