| > 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.DLL和INETCPL中的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控件中查找；改变网页文字的大小，和编码等等。大家如果有什么新的发现，记得告诉我(mousebox@21cn.com)。
上一页 [1] [2] | 
