页中特定链接
Private Sub Command1_Click
WebBrowser1.Navigate \"\"
End Sub

Private Sub WebBrowser1_NavigateComplete2(ByVal pDisp As Object, URL As Variant)
Dim a

For Each a In WebBrowser1.Document.All
If a.tagname = \"A\" Then
If a.href = \"\" Then
a.Click
End If
End If
Next
End Sub


Option Explicit
Private m_bDone As Boolean

Private Sub Command1_Click
If m_bDone Then
Dim doc As IHTMLDocument2
Set doc = WebBrowser1.Document
Dim aLink As HTMLLinkElement
Set aLink = doc.links(0)
aLink.Click
End If
End Sub

Private Sub Form_Load
WebBrowser1.Navigate \"\"
End Sub

Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
m_bDone = True
End Sub

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

The following code can be used to query and delete files in the ernet cache (including cookies). A demonstration routine can be found at the bottom of this post. Note, the enumerated type eCacheType is not supported in Excel 97, but can be changed to a list of Public Constants eg. Public Const eNormal = &H1&.
Option Explicit
´--------------------------Types, consts and structures
Private Const ERROR_CACHE_FIND_FAIL As Long = 0
Private Const ERROR_CACHE_FIND_SUCCESS As Long = 1
Private Const ERROR_FILE_NOT_FOUND As Long = 2
Private Const ERROR_ACCESS_DENIED As Long = 5
Private Const ERROR_INSUFFICIENT_BUFFER As Long = 122
Private Const MAX_CACHE_ENTRY_INFO_SIZE As Long = 4096
Private Const LMEM_FIXED As Long = &H0
Private Const LMEM_ZEROINIT As Long = &H40
Public Enum eCacheType
eNormal = &H1&
eEdited = &H8&
eTrackOffline = &H10&
eTrackOnline = &H20&
eSticky = &H40&
eSparse = &H10000
eCookie = &H100000
eURLHistory = &H200000
eURLFindDefaultFilter = 0&
End Enum
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type INTERNET_CACHE_ENTRY_INFO
dwStructSize As Long
lpszSourceUrlName As Long
lpszLocalFileName As Long
CacheEntryType As Long ´Type of entry ed
dwUseCount As Long
dwHitRate As Long
dwSizeLow As Long
dwSizeHigh As Long
LastModiedTime As FILETIME
ExpireTime As FILETIME
LastAccessTime As FILETIME
LastSyncTime As FILETIME
lpHeaderInfo As Long
dwHeaderInfoSize As Long
lpszFileExtension As Long
dwExemptDelta As Long
End Type
´--------------------------Internet Cache API
Private Declare Function FindFirstUrlCacheEntry Lib \"Wininet.dll\" Alias \"FindFirstUrlCacheEntryA\" (ByVal lpszUrlSearchPattern As String, lpFirstCacheEntryInfo As Any, lpdwFirstCacheEntryInfoBufferSize As Long) As Long
Private Declare Function FindNextUrlCacheEntry Lib \"Wininet.dll\" Alias \"FindNextUrlCacheEntryA\" (ByVal hEnumHandle As Long, lpNextCacheEntryInfo As Any, lpdwNextCacheEntryInfoBufferSize As Long) As Long
Private Declare Function FindCloseUrlCache Lib \"Wininet.dll\" (ByVal hEnumHandle As Long) As Long
Private Declare Function DeleteUrlCacheEntry Lib \"Wininet.dll\" Alias \"DeleteUrlCacheEntryA\" (ByVal lpszUrlName As String) As Long
´--------------------------Memory API
Private Declare Function LocalAlloc Lib \"kernel32\" (ByVal uFlags As Long, ByVal uBytes As Long) As Long
Private Declare Function LocalFree Lib \"kernel32\" (ByVal hMem As Long) As Long
Private Declare Sub CopyMemory Lib \"kernel32\" Alias \"RtlMoveMemory\" (pDest As Any, pSource As Any, ByVal dwLength As Long)
Private Declare Function lstrcpyA Lib \"kernel32\" (ByVal RetVal As String, ByVal Ptr As Long) As Long
Private Declare Function lstrlenA Lib \"kernel32\" (ByVal Ptr As Any) As Long
´Purpose : Deletes the specied ernet cache file
´Inputs : sCacheFile The name of the cache file
´Outputs : Returns True _disibledevent=>


´Notes :
´Revisions :
Function InternetDeleteCache(sCacheFile As String) As Boolean
InternetDeleteCache = CBool(DeleteUrlCacheEntry(sCacheFile))
End Function
´Purpose : Returns an .gif' /> of files stored in the ernet cache
´Inputs : eFilterType An enum which filters the files ed by their type
´Outputs : A _disibledevent=>Dim ICEI As INTERNET_CACHE_ENTRY_INFO
Dim lhFile As Long, lBufferSize As Long, lptrBuffer As Long
Dim sCacheFile As String
Dim asURLs As String, lNumEntries As Long
´Determine required buffer size
lBufferSize = 0
lhFile = FindFirstUrlCacheEntry(0&, ByVal 0&, lBufferSize)
If (lhFile = ERROR_CACHE_FIND_FAIL) And (Err.LastDllError = ERROR_INSUFFICIENT_BUFFER) Then
´Allocate memory for ICEI structure
lptrBuffer = LocalAlloc(LMEM_FIXED, lBufferSize)
If lptrBuffer Then
´Set a Long poer to the memory location
CopyMemory ByVal lptrBuffer, lBufferSize, 4
´Call first find API passing it the poer to the allocated memory
lhFile = FindFirstUrlCacheEntry(vbNullString, ByVal lptrBuffer, lBufferSize) ´1 = success
If lhFile <> ERROR_CACHE_FIND_FAIL Then
´Loop through the cache
Do
´Copy data back to structure
CopyMemory ICEI, ByVal lptrBuffer, Len(ICEI)
If ICEI.CacheEntryType And eFilterType Then
sCacheFile = StrFromPtrA(ICEI.lpszSourceUrlName)
lNumEntries = lNumEntries + 1
If lNumEntries = 1 Then
ReDim asURLs(1 To 1)
Else
ReDim Preserve asURLs(1 To lNumEntries)
End If
asURLs(lNumEntries) = sCacheFile
End If
´Free memory associated with the last-retrieved file
Call LocalFree(lptrBuffer)
´Call FindNextUrlCacheEntry with buffer size to 0.
´Call will fail and required buffer size.
lBufferSize = 0
Call FindNextUrlCacheEntry(lhFile, ByVal 0&, lBufferSize)
´Allocate and assign the memory to the poer
lptrBuffer = LocalAlloc(LMEM_FIXED, lBufferSize)
CopyMemory ByVal lptrBuffer, lBufferSize, 4&
Loop While FindNextUrlCacheEntry(lhFile, ByVal lptrBuffer, lBufferSize)
End If
End If
End If
´Free memory
Call LocalFree(lptrBuffer)
Call FindCloseUrlCache(lhFile)
InternetCacheList = asURLs
End Function
´Purpose : Converts a poer an ansi o a .
´Inputs : lptrString A long poer to a held in memory
´Outputs : The held at the specied memory address
´Author : Andrew Baker
´Date : 03/08/2000 19:14
´Notes :
´Revisions :
Function StrFromPtrA(ByVal lptrString As Long) As String
´Create buffer
StrFromPtrA = String$(lstrlenA(ByVal lptrString), 0)
´Copy memory
Call lstrcpyA(ByVal StrFromPtrA, ByVal lptrString)
End Function
´Demonstration routine
Sub Test
Dim avURLs As Variant, vThisValue As Variant
On Error Resume Next
´Return an .gif' /> of all ernet cache files
avURLs = InternetCacheList
For Each vThisValue In avURLs
´Pr files
Debug.Pr CStr(vThisValue)
Next
´Return the an .gif' /> of all cookies
avURLs = InternetCacheList(eCookie)
If MsgBox(\"Delete cookies?\", vbQuestion + vbYesNo) = vbYes Then
For Each vThisValue In avURLs
´Delete cookies
InternetDeleteCache CStr(vThisValue)
Debug.Pr \"Deleted \" & vThisValue
Next
Else
For Each vThisValue In avURLs
´Pr cookie files
Debug.Pr vThisValue
Next
End If
End Sub


＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
分析网页内容取得<SCRIPT>
Option Explicit

Private Sub Form_Load
WebBrowser1.Navigate \"\"
End Sub

Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
Dim sTemp As String
Dim outStr As String
Dim i As Integer
Dim beginPos As Long
Dim endPos As Long



sTemp = WebBrowser1.Document.documentelement.InnerHTML
´Text1.Text = sTemp
i = 1
Do While i <> 0
i = InStr(1, sTemp, \"<SCRIPT\")
If i <> 0 Then
outStr = Left(sTemp, i - 1)
sTemp = Right(sTemp, Len(sTemp) - i - 6)
i = InStr(1, sTemp, \"</SCRIPT>\")
If i <> 0 Then
sTemp = Right(sTemp, Len(sTemp) - i - 8)
End If
sTemp = outStr & sTemp
End If
Loop
WebBrowser1.Document.write sTemp
´Text2.Text = sTemp
End Sub



=



在\"通用\"里定义dim myhWnd as long,dim i as eger
然后
dim Win as form2
Win = form2
Win.Show
Set ppDisp = Win.form2.object

redim myhWnd(i) as long
myhwnd(i)=Win.hwnd
i=i+1



----------------------------------------------------------------



-----------------------------------------------------------------------------------------



=
控制字体大小

webbrowser1 ExecWB OLECMDID_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER, CLng(4 - Index)

index=0-4表示从最大到最小~~

最小话,index=4呵呵

webbrowser1 ExecWB OLECMDID_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER,0
可以遍历页面也可以~~

如果你只是想得到网页中所有连接这样就OK了~~

Option Explicit

Private Sub Command1_Click
Command1.Enabled = False
WebBrowser1.Navigate2 Text1.Text
End Sub

Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)

Dim x As Long
List1.Clear

For x = 0 To WebBrowser1.Document.Links.length - 1
List1.AddItem WebBrowser1.Document.Links.Item(x)
Next x
Command1.Enabled = True
End Sub

Private Sub WebBrowser1_StatusTextChange(ByVal Text As String)
Label3 = Text
End Sub





Public Class Form1
Inherits .Windows.Forms.Form

#Region \" Windows Form Designer generated code \"
´Omitted
#End Region

Private Sub Button1_Click(ByVal sender As .Object, _
ByVal e As .EventArgs) Handles Button1.Click
AxWebBrowser1.Navigate(TextBox1.Text)
End Sub

Private Sub AxWebBrowser1_NewWindow2(ByVal sender As Object, _
ByVal e As AxSHDocVw.DWebBrowserEvents2_NewWindow2Event) _
Handles AxWebBrowser1.NewWindow2
´MessageBox.Show(AxWebBrowser1.Height & \":\" & AxWebBrowser1.Width)

´MessageBox.Show(doc.body.innerHTML)
Dim frmWB As Form1
frmWB = New Form1

frmWB.AxWebBrowser1.RegisterAsBrowser = True
´frmWB.AxWebBrowser1.Navigate2(\"about:blank\")
e.ppDisp = frmWB.AxWebBrowser1.Application
frmWB.Visible = True
´MessageBox.Show(frmWB.AxWebBrowser1.Height & \":\" & frmWB.AxWebBrowser1.Width)
End Sub

Private Sub AxWebBrowser1_WindowSetHeight(ByVal sender As Object, _
ByVal e As AxSHDocVw.DWebBrowserEvents2_WindowSetHeightEvent) _
Handles AxWebBrowser1.WindowSetHeight
´MessageBox.Show(\"In SetHeight\" & Me.Height & \":\" & e.height)


Dim heightDf As Integer
heightDf = Me.Height - Me.AxWebBrowser1.Height
Me.Height = heightDf + e.height
End Sub

Private Sub AxWebBrowser1_WindowSetWidth(ByVal sender As Object, _
ByVal e As AxSHDocVw.DWebBrowserEvents2_WindowSetWidthEvent) _
Handles AxWebBrowser1.WindowSetWidth
´MessageBox.Show(\"In SetWidth\" & Me.Width & \":\" & e.width)
Dim widthDf As Integer
widthDf = Me.Width - Me.AxWebBrowser1.Width
Me.Width = widthDf + e.width
End Sub

End Class






=
替换TEXTBOX菜单
Public Declare Function GetWindowLong Lib \"user32\" Alias _
\"GetWindowLongA\" (ByVal hWnd As Long, ByVal nIndex As
Long) _
As Long
Public Declare Function SetWindowLong Lib \"user32\" Alias _
\"SetWindowLongA\" (ByVal hWnd As Long, ByVal nIndex As
Long, _
ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc Lib \"user32\" Alias _
\"CallWindowProcA\" (ByVal lpPrevWndFunc As Long, ByVal hWnd
_
As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal _
lParam As Long) As Long
Public Function SubClass_WndMessage(ByVal hWnd As _
OLE_HANDLE,ByVal Msg As OLE_HANDLE, ByVal wParam As
OLE_HANDLE, _
ByVal lParam As Long) As Long
If Msg <> WM_CONTEXTMENU Then
SubClass_WndMessage = CallWindowProc(OldWinProc, _
hWnd, Msg,wParam, lParam)
´ 如果消息不是WM_CONTEXTMENU就系统窗口处理
Exit Function
End If
SubClass_WndMessage = True


End Function

>>步骤4----在窗体中加入如下代码:
Private Const GWL_WNDPROC = (-4)

Private Sub Text1_MouseDown(Button As Integer, Sht As _
Integer, X As Single, Y As Single)

If Button = 1 Then Exit Sub
OldWinProc = GetWindowLong(Text1.hWnd, GWL_WNDPROC)
´ 取得窗口地址
Call SetWindowLong(Text1.hWnd, GWL_WNDPROC, AddressOf _
SubClass_WndMessage)
´ 用SubClass_WndMessage代替窗口处理消息
End Sub

Private Sub Text1_MouseUp(Button As Integer, Sht _
As Integer, X As Single, Y As Single)
If Button = 1 Then Exit Sub
Call SetWindowLong(Text1.hWnd, GWL_WNDPROC, OldWinProc)
´ 恢复窗口默认
PopupMenu a
´ 弹出自定义菜单
End Sub



选择网页上内容

´引用 Microsoft HTML Object Library

Dim oDoc As HTMLDocument
Dim oElement As Object
Dim oTxtRgn As Object
Dim sSelectedText As String

Set oDoc = WebBrowser1.Document´获得文档对象
Set oElement = oDoc.getElementById(\"T1\")´获得ID=\"T1\"对象
Set oTxtRgn = oDoc.selection.createRange´获得文档当前正选择区域对象

sSelectedText = oTxtRgn.Text´选择区域文本赋值

oElement.Focus´\"T1\"对象获得焦点

oElement.Select´全选对象\"T1\"

Debug.Pr \"你选择了文本:\" & sSelectedText


上面这段儿还附送了其他功能呵呵精简下是这样:
Dim oDoc As Object
Dim oTxtRgn As Object
Dim sSelectedHTML As String

Set oDoc = WebBrowser1.Document ´获得文档对象
Set oTxtRgn = oDoc.selection.createRange ´获得文档当前正选择区域对象

sSelectedHTML = oTxtRgn.htmlText ´选择区域文本赋值

Text1.Text=sSelectedHTML ´文本框显示抓取得HTML源码
......´或者继续分析源码



Private Declare Function URLDownloadToFile Lib \"urlmon\" _
Alias \"URLDownloadToFileA\" _
(ByVal pCaller As Long, _
ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserved As Long, _
ByVal lpfnCB As Long) As Long



Private Sub Command1_Click

Dim sourceUrl As String
Dim targetFile As String
Dim hfile As Long

sourceUrl = \"?姓名=张&性别=女\"
targetFile = \"c:\\temp\\xxx.html\"
hfile = URLDownloadToFile(0&, sourceUrl, targetFile, 0&, 0&)

End Sub

URLDownloadToFile:
介绍说明:
Downloads bits from the Internet and saves them to a file.

适用于:
VB4-32,5,6
声明:
Declare Function URLDownloadToFile Lib \"urlmon\" Alias \"URLDownloadToFileA\" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

操作系统支持:
Requires Windows NT 4.0 or later; Requires Windows 95 or later

库文件
Urlmon
参数:

pCaller:
Address of the controlling IUnknown erface of the calling Microsoft?ActiveX?component ( the caller is an ActiveX component). If the calling application is not an ActiveX component, this value can be to NULL. Otherwise, the caller is a Component Object Model (COM) object that is contained in another component (such as an ActiveX control within the context of an HTML page). This parameter represents the outermost IUnknown of the calling component. The function attempts the download within the context of the ActiveX client framework and allows the caller´s container to receive callbacks _disibledevent=>

Option Explicit
Enum OLECMDID
OLECMDID_OPEN = 1
OLECMDID_NEW = 2
OLECMDID_SAVE = 3
OLECMDID_SAVEAS = 4
OLECMDID_SAVECOPYAS = 5
OLECMDID_PRINT = 6
OLECMDID_PRINTPREVIEW = 7
OLECMDID_PAGESETUP = 8
OLECMDID_SPELL = 9
OLECMDID_PROPERTIES = 10
OLECMDID_CUT = 11
OLECMDID_COPY = 12
OLECMDID_PASTE = 13
OLECMDID_PASTESPECIAL = 14
OLECMDID_UNDO = 15
OLECMDID_REDO = 16
OLECMDID_SELECTALL = 17
OLECMDID_CLEARSELECTION = 18
OLECMDID_ZOOM = 19
OLECMDID_GETZOOMRANGE = 20
OLECMDID_UPDATECOMMANDS = 21
OLECMDID_REFRESH = 22
OLECMDID_STOP = 23
OLECMDID_HIDETOOLBARS = 24
OLECMDID_SETPROGRESSMAX = 25
OLECMDID_SETPROGRESSPOS = 26
OLECMDID_SETPROGRESSTEXT = 27
OLECMDID_SETTITLE = 28
OLECMDID_SETDOWNLOADSTATE = 29
OLECMDID_STOPDOWNLOAD = 30
OLECMDID_ONTOOLBARACTIVATED = 31
OLECMDID_FIND = 32
OLECMDID_DELETE = 33
OLECMDID_HTTPEQUIV = 34
OLECMDID_HTTPEQUIV_DONE = 35
OLECMDID_ENABLE_INTERACTION = 36
OLECMDID_ONUNLOAD = 37
End Enum

Enum OLECMDF
OLECMDF_SUPPORTED = 1
OLECMDF_ENABLED = 2
OLECMDF_LATCHED = 4
OLECMDF_NINCHED = 8
End Enum

Enum OLECMDEXECOPT
OLECMDEXECOPT_DODEFAULT = 0
OLECMDEXECOPT_PROMPTUSER = 1
OLECMDEXECOPT_DONTPROMPTUSER = 2
OLECMDEXECOPT_SHOWHELP = 3


End Enum

Private Sub brwSaveAs_Click
_disibledevent=> DoEvents
Web1(SSTab1.Tab).ExecWB OLECMDID_SAVEAS, OLECMDEXECOPT_DONTPROMPTUSER, \"aa\", \"(*.txt)\"
If Err.Number <> 0 Then
MsgBox \"无法另存新文件！\"
End If
Screen.MousePoer = vbDefault
End Sub

帮不了你了这是webbrowser相关些资料希望对你有用
=
把WEBBROWSER1装到PICTURE里面

Set Me.WebBrowser1.Container = Me.Picture1