这些天编写一个浏览器。 积累了一些经验。一楼留给百度。请各位朋友不要回复。谢谢。

很多做自己的浏览器首先想解决的就是不弹出 IE新窗口。添加一个Webbrowser把Index改为0。再编写Webbrowser的NewWindow2事件这代码是云霞散人提供的。在这里首先谢谢他。Dim I As Long Private Sub Form_Load() WebBrowser1(I).Navigate "www.hao123.com" End Sub Private Sub WebBrowser1_NewWindow2(index As Integer, ppDisp As Object, Cancel As Boolean) I = I + 1 Load WebBrowser1(I) Set ppDisp = WebBrowser1(I).Application WebBrowser1(I).Visible = True WebBrowser1(I).ZOrder End Sub

还有就是让浏览器中的控件编程XP风格。当然如果你的系统是98就不必了。Private m_hMod As Long Private m_hMod2 As Long Private Declare Function InitCommonControlsEx Lib "comctl32.dll" (iccex As tagInitCommonControlsEx) As Boolean Private Type tagInitCommonControlsEx lngSize As Long lngICC As Long End Type Private Const ICC_USEREX_CLASSES = &H200 Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long Private Sub Command1_Click()WebBrowser1.Navigate "www.baidu.com"End Sub Private Sub Form_Initialize() On Error Resume Next Dim iccex As tagInitCommonControlsEx iccex.lngSize = LenB(iccex) iccex.lngICC = ICC_USEREX_CLASSES InitCommonControlsEx iccex m_hMod = LoadLibrary("shell32.dll") m_hMod2 = LoadLibrary("explorer.exe") End Sub Private Sub Form_Terminate() On Error Resume Next If m_hMod Then FreeLibrary m_hMod If m_hMod2 Then FreeLibrary m_hMod2 End Sub

还有如果是弹出窗口，用一楼的方法用自己的程序打开的话，往往容易出脚本错误提示。弹出一个警告框，影响了操作。只要把Webbrowser的Silent属性改成True就行了。

如果你的Webbroswer是随窗口改变大小的。而有些网页是限制窗口大小的。下面这个网站就有一个弹出窗口是限制大小的。http://www.miibeian.gov.cn/是给我朋友测试的时候 才发现问题的。 如果限制了大小，而你的Webbrowser又是随窗口而改变大小，这种窗口往往会挤成一团。下面这个方法可以解决这个问题，而且窗口会随Webrowser改变大小，而不是在自己所限制的大小中，内容也没出现错误。Private Sub WB_DownloadComplete(Index As Integer)If WB(IndexBusy = False ThenDim a As ObjectSet a = WB(Index).Document'可见宽度= a.body.clientWidthEnd IfEnd Sub本来我上面是测试得到可见宽度的。谁知道我也没获取也没设置，只是写上这么几句，问题就解决了。

这段代码可以判断Webbrowser是否可以前进和后退： Private Sub Command1_Click() '前进按钮WebBrowser1.GoForward End Sub Private Sub Command2_Click() '后退按钮WebBrowser1.GoBack End Sub Private Sub Form_Load() WebBrowser1.Navigate "http://www.applevb.com" End Sub Private Sub WebBrowser1_CommandStateChange(ByVal Command As Long, ByVal Enable As Boolean) If (Command = CSC_NAVIGATEBACK) Then Command2.Enabled = Enable End If If (Command = CSC_NAVIGATEFORWARD) Then Command1.Enabled = Enable End If End Sub

''去掉Webbrowser上的滚动条Private Sub mnuScroll1_Click() '注意：必须在网页完全显示之后才可以运行 if WebBrowser1.Busy=False ThenWebBrowser1.Document.body.Scroll = "no" '不显示滚动条ENd IfEnd Sub Private Sub mnuScroll2_Click() if WebBrowser1.Busy=False Then'注意：必须在网页完全显示之后才可以运行 WebBrowser1.Document.body.Scroll = "Auto" '显示滚动条ENd IfEnd Sub

获得Webbrowser中被选中的内容:Private Sub Command1_Click() Dim objSelection Dim objTxtRange Set objSelection = WebBrowser1.Document.selection If Not (objSelection Is Nothing) Then Set objTxtRange = objSelection.createRange If Not (objTxtRange Is Nothing) Then Debug.Print objTxtRange.htmlText Set objTxtRange = Nothing End If Set objSelection = Nothing End If End Sub Private Sub Form_Load() WebBrowser1.Navigate "http://www.baidu.com" End Sub

'一些常用的功能保存webbrowser中的HTML内容 Dim oPF As IPersistFile Set oPF = WebBrowser1.Document oPF.Save "TheFileNameHere.htm", FalseWebBrowser1.ExecWB用处参数 WB.ExecWB(4,1) 4,1 保存网页 4,2 保存网页(可以重新命名) 6,1 直接打印 6,2 直接打印 7,1 打印预览 7,2 打印预览 8,1 选择参数 8,2 选择参数 10,1 查看页面属性 10,2 查看页面属性 17,1 全选 17,2 全选 22,1 重新载入当前页 22,2 重新载入当前页

//各种尺寸 s += "\r\n网页可见区域宽："+ document.body.clientWidth; s += "\r\n网页可见区域高："+ document.body.clientHeight; s += "\r\n网页可见区域高："+ document.body.offsetWeight +" (包括边线的宽)"; s += "\r\n网页可见区域高："+ document.body.offsetHeight +" (包括边线的宽)"; s += "\r\n网页正文全文宽："+ document.body.scrollWidth; s += "\r\n网页正文全文高："+ document.body.scrollHeight; s += "\r\n网页被卷去的高："+ document.body.scrollTop; s += "\r\n网页被卷去的左："+ document.body.scrollLeft; s += "\r\n网页正文部分上："+ window.screenTop; s += "\r\n网页正文部分左："+ window.screenLeft; s += "\r\n屏幕分辨率的高："+ window.screen.height; s += "\r\n屏幕分辨率的宽："+ window.screen.width; s += "\r\n屏幕可用工作区高度："+ window.screen.availHeight; s += "\r\n屏幕可用工作区宽度："+ window.screen.availWidth; 使用方法:在DownloadComplate以后先判断Webbrowser.Busy是否为False然后Dim m as Objectset m=WebBrowser1.Document'例如使用上面的那行s += "\r\n网页可见区域宽："+ document.body.clientWidth; 则是这样使用Msgbox a.Body.clientWidth; End If

防止网页中的Java关闭网页时关掉WebbrowserPrivate Sub WB_WindowClosing(index As Integer, ByVal IsChildWindow As Boolean, Cancel As Boolean)Cancel = True '取消关闭，还可以添加其他事件End Sub'我这里的是数组，所以有有Index

顶!!! 希望加精!

请教一下楼主 多窗口是如果实现的?

Dim I As Long Private Sub Form_Load() WebBrowser1(I).Navigate "www.hao123.com" End Sub Private Sub WebBrowser1_NewWindow2(index As Integer, ppDisp As Object, Cancel As Boolean) I = I + 1 Load WebBrowser1(I) Set ppDisp = WebBrowser1(I).Application WebBrowser1(I).Visible = True WebBrowser1(I).ZOrder End Sub 这是一个数组，当弹出新窗口时，Load一个Webbrowser来打开。当然，你也可以创建一个子窗口，新窗口时用子窗口打开。

获取源文件:Dim doc, objhtml As ObjectDim i As IntegerDim strhtml As StringDim nHwnd, eHwnd As LongIf WB(OldIdx).Busy = False Then Set doc = WB(OldIdx).Document i = 0 Set objhtml = doc.body.createtextrange() If Not IsNull(objhtml) Then strhtml = objhtml.htmltext Shell "Notepad.exe", vbNormalFocus nHwnd = FindWindow("Notepad", "无标题 - 记事本") eHwnd = FindWindowEx(nHwnd, 0&, "Edit", "") SendMessage eHwnd, WM_SETTEXT, 0, ByVal strhtml End IfEnd If

上面的:strhtml = objhtml.htmltext 你可以把下面的Sendmessage去掉。把strhtml改成要在里面显示的控件，例如Text1.Text=objhtml.htmltext 就能在自己的控件中显示。注意一定要WB下载完毕，就是Busy=False才行。Set doc = WB(OldIdx).Document 我上面的WB(OldIdx)是一个数组，请自己改。

WB.ExecWB OLECMDID_CUT, OLECMDEXECOPT_DODEFAULT '剪切WB.ExecWB OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT '复制WB(OldIdx).ExecWB OLECMDID_PASTE, OLECMDEXECOPT_DODEFAULT '粘贴'Sorry,因为是时不时帖一点，所以有点凌乱，请自己整理。我都是做到哪，就说到哪。

关于查找：查找的方法最菜的就是发送Ctrl+F键，不过简单又使用。先让WB.SetFocus然后Sendkeys "^f"就模拟按下了Ctrl+F查找功能。只要WB支持的快捷键，你都可以使用。Ctrl+P打印Ctrl+X剪切Ctrl+C复制Ctrl+V粘贴Ctrl+N用IE打开当前页面，即使你用了NewWindows2来限制IE弹出也无效

很实用，多谢楼主。

取得网页中特定的链接Private Sub Command1_Click()WebBrowser1.Navigate "http://www.95557.com/svote.htm"End SubPrivate Sub WebBrowser1_NavigateComplete2(ByVal pDisp As Object, URL As Variant)Dim aFor Each a In WebBrowser1.Document.AllIf a.tagname = "A" ThenIf a.href = "http://tech.sina.com.cn/mobile/capture.shtml" Thena.ClickEnd IfEnd IfNextEnd SubOption ExplicitPrivate m_bDone As BooleanPrivate Sub Command1_Click()If m_bDone ThenDim doc As IHTMLDocument2Set doc = WebBrowser1.DocumentDim aLink As HTMLLinkElementSet aLink = doc.links(0)aLink.ClickEnd IfEnd SubPrivate Sub Form_Load()WebBrowser1.Navigate "http://www.95557.com/svote.htm"End SubPrivate Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)m_bDone = TrueEnd Sub