1 用Webbrowser获取网页中的全部Script
2
3 Public Function ReadScript( vWeb As WebBrowser) As String
4 Dim Item As Object, S As String
5 Dim Num As Integer
6 If vWeb.object.Document Is Nothing Then Exit Function
7 Num = 0
8 For Each Item In vWeb.object.Document.scripts
9 Num = Num + 1
10 S = S + "===========" + Str(Num) + "===========" + vbCrLf
11 S = S + Item.innerHTML + vbCrLf
12 S = S + "======================================" + vbCrLf + vbCrLf + vbCrLf
13 Next Item
14 ReadScript = S
15
16 set Item=Nothing
17 End Function
18
19 WebBrowser控件禁止右键
20 看到很多关于WebBrowser控件禁止右键的提问，回复的方法很多，其中有提到使用微软提供的Webbrowser扩展COM服务器对象（WBCustomizer.dll），但是该方法在我们想使用Webbrowser编辑网页（Webbrowser1.Document.execCommand "editMode"）的时候有很多弊端，比如不能显示选中的文本等。另有些方法也就不用一一列举了。
21
22 这儿我想提到的是关于MSHTML.HTMLDocument
23
24 引用Microsoft HTML OBject Library
25
26 Rem ＃窗体代码＃
27
28 Dim WithEvents M_Dom As MSHTML.HTMLDocument
29 Private Function M_Dom_oncontextmenu() As Boolean
30 M_Dom_oncontextmenu = False
31 End Function
32
33 Private Sub Webbrowser1_DownloadComplete()
34 Set M_Dom = Webbrowser1.Document
35 End Sub
36
37 Rem 好了，右键菜单没有了
38
39
40 ========================================
41
42 控件调用和获得收藏夹里面
43
44 基本上用 specialfolder(6 ) 就可以得到收藏夹的路径, 然后你可以用dir去循环读入每个目录,然后dir里面的file, file的名字就是你要的收藏的名字, 路径可以自己根据从上面得到的路径去得到.
45 如果你不用dir也可以用vb的dir控件.
46 Private Type SHITEMID
47 cb As Long
48 abID As Byte
49 End Type
50
51 Public Type ITEMIDLIST
52 mkid As SHITEMID
53 End Type
54 Public Function SpecialFolder(ByRef CSIDL As Long) As String
55 'locate the favorites folder
56 Dim R As Long
57 Dim sPath As String
58 Dim IDL As ITEMIDLIST
59 Const NOERROR = 0
60 Const MAX_LENGTH = 260
61 R = SHGetSpecialFolderLocation(MDIMain.hwnd, CSIDL, IDL)
62 If R = NOERROR Then
63 sPath = Space$(MAX_LENGTH)
64 R = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal sPath)
65 If R Then
66 SpecialFolder = Left$(sPath, InStr(sPath, vbNullChar) - 1)
67 End If
68 End If
69 End Function
70 =================================================＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
71 全屏
72
73 是的,webbrowser本生是一个控件, 你要它全屏,就是要它所在的窗体全屏, 可以用setwindowlong取消窗体的 title, 用Call ShowWindow(FindWindow("Shell_traywnd", ""), 0) 隐藏tray,就是下边那个包含开始那一行. 用Call ShowWindow(FindWindow("Shell_traywnd", ""), 9) 恢复. 够详细了吧.
74
75 然后在form1.windowstate = 2 就可以了.
76
77 ============================================================
78 选择网页上的内容。
79 Private Sub Command1_Click()
80 '请先选中一些内容
81 Me.WebBrowser1.ExecWB OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT
82 MsgBox Clipboard.GetText
83 End Sub
84
85 ==============================================================
86 用IE来下载文件
87 Private Declare Function DoFileDownload Lib "shdocvw.dll" (ByVal lpszFile As String) As Long
88
89
90 Private Sub Command1_Click()
91
92 Dim sDownload As String
93
94 sDownload = StrConv(Text1.Text, vbUnicode)
95 Call DoFileDownload(sDownload)
96
97 End Sub
98
99 Private Sub Form_Load()
100 Text1.Text = "http://www.chat.ru/~softdaily/fo-ag162.zip"
101 Form1.Caption = "Audiograbber 1.62 Full"
102 Text2.Text = "http://www6.50megs.com/audiograbber/demos/cr-ag161.zip"
103 End Sub
104
105
106 ============================================================
107
108 我要动态加载和删除WebBrowser控件应该怎么做？
109
110 Private Sub Command1_Click()
111 Form1.Controls.Add "shell.explorer.2", "NewWeb", Form1
112 With Form1!NewWeb
113 .Visible = True
114 .Width = 10000
115 .Height = 10000
116 .Left = 0
117 .Top = 0
118 .Navigate2 "www.csdn.net"
119 End With
120 End Sub
121
122 Private Sub Command2_Click()
123 Controls.Remove Form1!newweb
124 End Sub
125
126 Form1.Controls.Add "shell.explorer.2", newweb(newweb.Count), Form1
127 With Form1!newweb(newweb.Count)
128 .Visible = True
129 .Width = 1000
130 .Height = 1000
131 .Left = newweb(newweb.Count - 1).Left + newweb(newweb.Count - 1).Width
132 .Top = 0
133 '.Navigate2 "www.csdn.net"
134 End With
135 为什么他说我
136 Form1.Controls.Add "shell.explorer.2", newweb(newweb.Count), Form1
137 这一行错误13 类型不匹配？
138 ps：我在form中已经有了一个newweb(0)控件
139
140
141 先为一个WebBrowser
142 Dim i As Integer
143 Private Sub AddWeb_Click()
144 For i = 1 To 10
145 Load NewWeb(i)
146 NewWeb(i).Top = i * 100
147 NewWeb(i).Left = i * 100
148 NewWeb(i).Visible = True
149 Next i
150 End Sub
151
152 Private Sub DelWeb_Click()
153 For i = 1 To 10
154 Unload NewWeb(i)
155 Next i
156 End Sub
157
158 =========================================================
159
160
161 一个把页面保存为MHT(即MHTML)文件
162 1、
163
164 谢谢楼上几位大侠！我现在将 pcwak(书剑狂生[MS MVP]) 大侠提供的资料贴出来，以供大家参考：
165 我终于找到一个把页面保存为MHT(即MHTML)文件的方法了!
166 首先，在工程中必须要引用一个库：
167 Library CDO
168 D:WINNTSystem32cdosys.dll
169 Microsoft CDO for Windows 2000 Library
170 其次，需要Stream对应的接口的支持，如果你一时找不到就使用支持这个的较新的ADO就行了，如
171 Library ADODB
172 D:Program FilesCommon Filessystemadomsado15.dll
173 Microsoft ActiveX Data Objects 2.5 Library
174 代码如下，十分简单(同时由于流的特点，显示在实际应用中没必要象本例中那样把文件保存到磁盘上就可直接转换为字符串或字节数组什么的处理的。
175
176 另，对于Microsoft CDO for Windows 2000 Library这个库，在WIN98中要怎么使用还没试过，感兴趣的朋友可以试试并跟帖，以丰富完善其内容：)
177
178 Private Sub Command1_Click()
179 ' Reference to Microsoft ActiveX Data Objects 2.5 Library
180 ' Reference to Microsoft CDO for Windows 2000 Library
181 Dim iMsg As New CDO.Message
182 Dim iConf As New CDO.Configuration
183 Dim objStream As ADODB.Stream
184
185 With iMsg
186 .CreateMHTMLBody "http://www.163.com/";, , _
187 "domainusername", _
188 "password"
189 Set objStream = .GetStream
190 Call objStream.SaveToFile("f:test.mht", adSaveCreateOverWrite)
191 End With
192 End Sub
193
194 2、
195
196
197 '首先加入对ADODB和CDO（Microsoft CDO for Windows 2000 Library，对应文件名为CDOSYS.dll）的引用
198 Private Sub Command1_Click()
199 Dim message As New CDO.message
200 Dim Outstream As ADODB.Stream
201 On Error GoTo myerr1
202 Call message.CreateMHTMLBody("http://www.csdn.net", CDO.CdoMHTMLFlags.cdoSuppressNone, "", "")
203 Set Outstream = message.GetStream
204 Call Outstream.SaveToFile("c:test.mht", ADODB.SaveOptionsEnum.adSaveCreateOverWrite)
205 MsgBox "完成"
206
207 Exit Sub
208 myerr1:
209 Set message = Nothing
210 Set Outstream = Nothing
211 End Sub
212
213 =====================================================
214
215
216
217 请问高手们怎样在WebBrowser控件调用收藏夹和在收藏夹里添加收藏
218 Option Explicit
219
220 Private Sub Command1_Click()
221 Dim ObjSUH As New ShellUIHelper
222 ObjSUH.AddFavorite "http://www.csdn.net", "CSDN"
223 Set ObjSUH = Nothing
224 End Sub
225
226 visual basic 6.0的浏览器插件使用技巧
227 取得网页中特定的链接
228 Private Sub Command1_Click()
229 WebBrowser1.Navigate "http://www.95557.com/svote.htm"
230 End Sub
231
232 Private Sub WebBrowser1_NavigateComplete2(ByVal pDisp As Object, URL As Variant)
233 Dim a
234
235 For Each a In WebBrowser1.Document.All
236 If a.tagname = "A" Then
237 If a.href = "http://tech.sina.com.cn/mobile/capture.shtml" Then
238 a.Click
239 End If
240 End If
241 Next
242 End Sub
243
244
245 Option Explicit
246 Private m_bDone As Boolean
247
248 Private Sub Command1_Click()
249 If m_bDone Then
250 Dim doc As IHTMLDocument2
251 Set doc = WebBrowser1.Document
252 Dim aLink As HTMLLinkElement
253 Set aLink = doc.links(0)
254 aLink.Click
255 End If
256 End Sub
257
258 Private Sub Form_Load()
259 WebBrowser1.Navigate "http://www.95557.com/svote.htm"
260 End Sub
261
262 Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
263 m_bDone = True
264 End Sub
265
266 ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
267
268 The following code can be used to query and delete files in the internet 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&.
269 Option Explicit
270 '--------------------------Types, consts and structures
271 Private Const ERROR_CACHE_FIND_FAIL As Long = 0
272 Private Const ERROR_CACHE_FIND_SUCCESS As Long = 1
273 Private Const ERROR_FILE_NOT_FOUND As Long = 2
274 Private Const ERROR_ACCESS_DENIED As Long = 5
275 Private Const ERROR_INSUFFICIENT_BUFFER As Long = 122
276 Private Const MAX_CACHE_ENTRY_INFO_SIZE As Long = 4096
277 Private Const LMEM_FIXED As Long = &H0
278 Private Const LMEM_ZEROINIT As Long = &H40
279 Public Enum eCacheType
280 eNormal = &H1&
281 eEdited = &H8&
282 eTrackOffline = &H10&
283 eTrackOnline = &H20&
284 eSticky = &H40&
285 eSparse = &H10000
286 eCookie = &H100000
287 eURLHistory = &H200000
288 eURLFindDefaultFilter = 0&
289 End Enum
290 Private Type FILETIME
291 dwLowDateTime As Long
292 dwHighDateTime As Long
293 End Type
294 Private Type INTERNET_CACHE_ENTRY_INFO
295 dwStructSize As Long
296 lpszSourceUrlName As Long
297 lpszLocalFileName As Long
298 CacheEntryType As Long 'Type of entry returned
299 dwUseCount As Long
300 dwHitRate As Long
301 dwSizeLow As Long
302 dwSizeHigh As Long
303 LastModifiedTime As FILETIME
304 ExpireTime As FILETIME
305 LastAccessTime As FILETIME
306 LastSyncTime As FILETIME
307 lpHeaderInfo As Long
308 dwHeaderInfoSize As Long
309 lpszFileExtension As Long
310 dwExemptDelta As Long
311 End Type
312 '--------------------------Internet Cache API
313 Private Declare Function FindFirstUrlCacheEntry Lib "Wininet.dll" Alias "FindFirstUrlCacheEntryA" (ByVal lpszUrlSearchPattern As String, lpFirstCacheEntryInfo As Any, lpdwFirstCacheEntryInfoBufferSize As Long) As Long
314 Private Declare Function FindNextUrlCacheEntry Lib "Wininet.dll" Alias "FindNextUrlCacheEntryA" (ByVal hEnumHandle As Long, lpNextCacheEntryInfo As Any, lpdwNextCacheEntryInfoBufferSize As Long) As Long
315 Private Declare Function FindCloseUrlCache Lib "Wininet.dll" (ByVal hEnumHandle As Long) As Long
316 Private Declare Function DeleteUrlCacheEntry Lib "Wininet.dll" Alias "DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Long
317 '--------------------------Memory API
318 Private Declare Function LocalAlloc Lib "kernel32" (ByVal uFlags As Long, ByVal uBytes As Long) As Long
319 Private Declare Function LocalFree Lib "kernel32" (ByVal hMem As Long) As Long
320 Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)
321 Private Declare Function lstrcpyA Lib "kernel32" (ByVal RetVal As String, ByVal Ptr As Long) As Long
322 Private Declare Function lstrlenA Lib "kernel32" (ByVal Ptr As Any) As Long
323 'Purpose : Deletes the specified internet cache file
324 'Inputs : sCacheFile The name of the cache file
325 'Outputs : Returns True on success.
326 'Author : Andrew Baker
327 'Date : 03/08/2000 19:14
328 'Notes :
329 'Revisions :
330 Function InternetDeleteCache(sCacheFile As String) As Boolean
331 InternetDeleteCache = CBool(DeleteUrlCacheEntry(sCacheFile))
332 End Function
333 'Purpose : Returns an array of files stored in the internet cache
334 'Inputs : eFilterType An enum which filters the files returned by their type
335 'Outputs : A one dimensional, one based, string array containing the names of the files
336 'Author : Andrew Baker
337 'Date : 03/08/2000 19:14
338 'Notes :
339 'Revisions :
340 Function InternetCacheList(Optional eFilterType As eCacheType = eNormal) As Variant
341 Dim ICEI As INTERNET_CACHE_ENTRY_INFO
342 Dim lhFile As Long, lBufferSize As Long, lptrBuffer As Long
343 Dim sCacheFile As String
344 Dim asURLs() As String, lNumEntries As Long
345 'Determine required buffer size
346 lBufferSize = 0
347 lhFile = FindFirstUrlCacheEntry(0&, ByVal 0&, lBufferSize)
348 If (lhFile = ERROR_CACHE_FIND_FAIL) And (Err.LastDllError = ERROR_INSUFFICIENT_BUFFER) Then
349 'Allocate memory for ICEI structure
350 lptrBuffer = LocalAlloc(LMEM_FIXED, lBufferSize)
351 If lptrBuffer Then
352 'Set a Long pointer to the memory location
353 CopyMemory ByVal lptrBuffer, lBufferSize, 4
354 'Call first find API passing it the pointer to the allocated memory
355 lhFile = FindFirstUrlCacheEntry(vbNullString, ByVal lptrBuffer, lBufferSize) '1 = success
356 If lhFile <> ERROR_CACHE_FIND_FAIL Then
357 'Loop through the cache
358 Do
359 'Copy data back to structure
360 CopyMemory ICEI, ByVal lptrBuffer, Len(ICEI)
361 If ICEI.CacheEntryType And eFilterType Then
362 sCacheFile = StrFromPtrA(ICEI.lpszSourceUrlName)
363 lNumEntries = lNumEntries + 1
364 If lNumEntries = 1 Then
365 ReDim asURLs(1 To 1)
366 Else
367 ReDim Preserve asURLs(1 To lNumEntries)
368 End If
369 asURLs(lNumEntries) = sCacheFile
370 End If
371 'Free memory associated with the last-retrieved file
372 Call LocalFree(lptrBuffer)
373 'Call FindNextUrlCacheEntry with buffer size set to 0.
374 'Call will fail and return required buffer size.
375 lBufferSize = 0
376 Call FindNextUrlCacheEntry(lhFile, ByVal 0&, lBufferSize)
377 'Allocate and assign the memory to the pointer
378 lptrBuffer = LocalAlloc(LMEM_FIXED, lBufferSize)
379 CopyMemory ByVal lptrBuffer, lBufferSize, 4&
380 Loop While FindNextUrlCacheEntry(lhFile, ByVal lptrBuffer, lBufferSize)
381 End If
382 End If
383 End If
384 'Free memory
385 Call LocalFree(lptrBuffer)
386 Call FindCloseUrlCache(lhFile)
387 InternetCacheList = asURLs
388 End Function
389 'Purpose : Converts a pointer an ansi string into a string.
390 'Inputs : lptrString A long pointer to a string held in memory
391 'Outputs : The string held at the specified memory address
392 'Author : Andrew Baker
393 'Date : 03/08/2000 19:14
394 'Notes :
395 'Revisions :
396 Function StrFromPtrA(ByVal lptrString As Long) As String
397 'Create buffer
398 StrFromPtrA = String$(lstrlenA(ByVal lptrString), 0)
399 'Copy memory
400 Call lstrcpyA(ByVal StrFromPtrA, ByVal lptrString)
401 End Function
402 'Demonstration routine
403 Sub Test()
404 Dim avURLs As Variant, vThisValue As Variant
405 On Error Resume Next
406 'Return an array of all internet cache files
407 avURLs = InternetCacheList
408 For Each vThisValue In avURLs
409 'Print files
410 Debug.Print CStr(vThisValue)
411 Next
412 'Return the an array of all cookies
413 avURLs = InternetCacheList(eCookie)
414 If MsgBox("Delete cookies?", vbQuestion + vbYesNo) = vbYes Then
415 For Each vThisValue In avURLs
416 'Delete cookies
417 InternetDeleteCache CStr(vThisValue)
418 Debug.Print "Deleted " & vThisValue
419 Next
420 Else
421 For Each vThisValue In avURLs
422 'Print cookie files
423 Debug.Print vThisValue
424 Next
425 End If
426 End Sub
427
428
429 ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
430 分析网页内容，取得 ")
431 If i <> 0 Then
432 sTemp = Right(sTemp, Len(sTemp) - i - 8)
433 End If
434 sTemp = outStr & sTemp
435 End If
436 Loop
437 WebBrowser1.Document.write sTemp
438 'Text2.Text = sTemp
439 End Sub
440
441
442 ====================================================
443
444 控制字体大小
445
446 webbrowser1 ExecWB OLECMDID_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER, CLng(4 - Index)
447
448 index=0-4表示从最大到最小~~
449
450 最小的话,index=4，呵呵
451
452 webbrowser1 ExecWB OLECMDID_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER,0
453 可以遍历页面，也可以~~
454
455 如果你只是想得到网页中的所有连接，这样就OK了~~
456
457 Option Explicit
458
459 Private Sub Command1_Click()
460 Command1.Enabled = False
461 WebBrowser1.Navigate2 Text1.Text
462 End Sub
463
464 Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
465
466 Dim x As Long
467 List1.Clear
468
469 For x = 0 To WebBrowser1.Document.Links.length - 1
470 List1.AddItem WebBrowser1.Document.Links.Item(x)
471 Next x
472 Command1.Enabled = True
473 End Sub
474
475 Private Sub WebBrowser1_StatusTextChange(ByVal Text As String)
476 Label3 = Text
477 End Sub
478
479
480
481 ==============================================================
482 Public Class Form1
483 Inherits System.Windows.Forms.Form
484
485 #Region " Windows Form Designer generated code "
486 'Omitted
487 #End Region
488
489 Private Sub Button1_Click(ByVal sender As System.Object, _
490 ByVal e As System.EventArgs) Handles Button1.Click
491 AxWebBrowser1.Navigate(TextBox1.Text)
492 End Sub
493
494 Private Sub AxWebBrowser1_NewWindow2(ByVal sender As Object, _
495 ByVal e As AxSHDocVw.DWebBrowserEvents2_NewWindow2Event) _
496 Handles AxWebBrowser1.NewWindow2
497 'MessageBox.Show(AxWebBrowser1.Height & ":" & AxWebBrowser1.Width)
498
499 'MessageBox.Show(doc.body.innerHTML)
500 Dim frmWB As Form1
501 frmWB = New Form1()
502
503 frmWB.AxWebBrowser1.RegisterAsBrowser = True
504 'frmWB.AxWebBrowser1.Navigate2("about:blank")
505 e.ppDisp = frmWB.AxWebBrowser1.Application
506 frmWB.Visible = True
507 'MessageBox.Show(frmWB.AxWebBrowser1.Height & ":" & frmWB.AxWebBrowser1.Width)
508 End Sub
509
510 Private Sub AxWebBrowser1_WindowSetHeight(ByVal sender As Object, _
511 ByVal e As AxSHDocVw.DWebBrowserEvents2_WindowSetHeightEvent) _
512 Handles AxWebBrowser1.WindowSetHeight
513 'MessageBox.Show("In SetHeight" & Me.Height & ":" & e.height)
514 Dim heightDiff As Integer
515 heightDiff = Me.Height - Me.AxWebBrowser1.Height
516 Me.Height = heightDiff + e.height
517 End Sub
518
519 Private Sub AxWebBrowser1_WindowSetWidth(ByVal sender As Object, _
520 ByVal e As AxSHDocVw.DWebBrowserEvents2_WindowSetWidthEvent) _
521 Handles AxWebBrowser1.WindowSetWidth
522 'MessageBox.Show("In SetWidth" & Me.Width & ":" & e.width)
523 Dim widthDiff As Integer
524 widthDiff = Me.Width - Me.AxWebBrowser1.Width
525 Me.Width = widthDiff + e.width
526 End Sub
527
528 End Class
529
530
531
532
533 ==============================================================
534 选择网页上的内容。
535
536 '引用 Microsoft HTML Object Library
537
538 Dim oDoc As HTMLDocument
539 Dim oElement As Object
540 Dim oTxtRgn As Object
541 Dim sSelectedText As String
542
543 Set oDoc = WebBrowser1.Document'获得文档对象
544 Set oElement = oDoc.getElementById("T1")'获得ID="T1"的对象
545 Set oTxtRgn = oDoc.selection.createRange'获得文档当前正选择的区域对象
546
547 sSelectedText = oTxtRgn.Text'选择区域文本赋值
548
549 oElement.Focus'"T1"对象获得焦点
550
551 oElement.Select'全选对象"T1"
552
553 Debug.Print "你选择了文本：" & sSelectedText
554
555
556 上面这段儿还附送了其他功能，呵呵。精简一下是这样：
557 Dim oDoc As Object
558 Dim oTxtRgn As Object
559 Dim sSelectedHTML As String
560
561 Set oDoc = WebBrowser1.Document '获得文档对象
562 Set oTxtRgn = oDoc.selection.createRange '获得文档当前正选择的区域对象
563
564 sSelectedHTML = oTxtRgn.htmlText '选择区域文本赋值
565
566 Text1.Text=sSelectedHTML '文本框显示抓取得HTML源码
567 ......'或者继续分析源码
568
569
570
571
2
3 Public Function ReadScript( vWeb As WebBrowser) As String
4 Dim Item As Object, S As String
5 Dim Num As Integer
6 If vWeb.object.Document Is Nothing Then Exit Function
7 Num = 0
8 For Each Item In vWeb.object.Document.scripts
9 Num = Num + 1
10 S = S + "===========" + Str(Num) + "===========" + vbCrLf
11 S = S + Item.innerHTML + vbCrLf
12 S = S + "======================================" + vbCrLf + vbCrLf + vbCrLf
13 Next Item
14 ReadScript = S
15
16 set Item=Nothing
17 End Function
18
19 WebBrowser控件禁止右键
20 看到很多关于WebBrowser控件禁止右键的提问，回复的方法很多，其中有提到使用微软提供的Webbrowser扩展COM服务器对象（WBCustomizer.dll），但是该方法在我们想使用Webbrowser编辑网页（Webbrowser1.Document.execCommand "editMode"）的时候有很多弊端，比如不能显示选中的文本等。另有些方法也就不用一一列举了。
21
22 这儿我想提到的是关于MSHTML.HTMLDocument
23
24 引用Microsoft HTML OBject Library
25
26 Rem ＃窗体代码＃
27
28 Dim WithEvents M_Dom As MSHTML.HTMLDocument
29 Private Function M_Dom_oncontextmenu() As Boolean
30 M_Dom_oncontextmenu = False
31 End Function
32
33 Private Sub Webbrowser1_DownloadComplete()
34 Set M_Dom = Webbrowser1.Document
35 End Sub
36
37 Rem 好了，右键菜单没有了
38
39
40 ========================================
41
42 控件调用和获得收藏夹里面
43
44 基本上用 specialfolder(6 ) 就可以得到收藏夹的路径, 然后你可以用dir去循环读入每个目录,然后dir里面的file, file的名字就是你要的收藏的名字, 路径可以自己根据从上面得到的路径去得到.
45 如果你不用dir也可以用vb的dir控件.
46 Private Type SHITEMID
47 cb As Long
48 abID As Byte
49 End Type
50
51 Public Type ITEMIDLIST
52 mkid As SHITEMID
53 End Type
54 Public Function SpecialFolder(ByRef CSIDL As Long) As String
55 'locate the favorites folder
56 Dim R As Long
57 Dim sPath As String
58 Dim IDL As ITEMIDLIST
59 Const NOERROR = 0
60 Const MAX_LENGTH = 260
61 R = SHGetSpecialFolderLocation(MDIMain.hwnd, CSIDL, IDL)
62 If R = NOERROR Then
63 sPath = Space$(MAX_LENGTH)
64 R = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal sPath)
65 If R Then
66 SpecialFolder = Left$(sPath, InStr(sPath, vbNullChar) - 1)
67 End If
68 End If
69 End Function
70 =================================================＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
71 全屏
72
73 是的,webbrowser本生是一个控件, 你要它全屏,就是要它所在的窗体全屏, 可以用setwindowlong取消窗体的 title, 用Call ShowWindow(FindWindow("Shell_traywnd", ""), 0) 隐藏tray,就是下边那个包含开始那一行. 用Call ShowWindow(FindWindow("Shell_traywnd", ""), 9) 恢复. 够详细了吧.
74
75 然后在form1.windowstate = 2 就可以了.
76
77 ============================================================
78 选择网页上的内容。
79 Private Sub Command1_Click()
80 '请先选中一些内容
81 Me.WebBrowser1.ExecWB OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT
82 MsgBox Clipboard.GetText
83 End Sub
84
85 ==============================================================
86 用IE来下载文件
87 Private Declare Function DoFileDownload Lib "shdocvw.dll" (ByVal lpszFile As String) As Long
88
89
90 Private Sub Command1_Click()
91
92 Dim sDownload As String
93
94 sDownload = StrConv(Text1.Text, vbUnicode)
95 Call DoFileDownload(sDownload)
96
97 End Sub
98
99 Private Sub Form_Load()
100 Text1.Text = "http://www.chat.ru/~softdaily/fo-ag162.zip"
101 Form1.Caption = "Audiograbber 1.62 Full"
102 Text2.Text = "http://www6.50megs.com/audiograbber/demos/cr-ag161.zip"
103 End Sub
104
105
106 ============================================================
107
108 我要动态加载和删除WebBrowser控件应该怎么做？
109
110 Private Sub Command1_Click()
111 Form1.Controls.Add "shell.explorer.2", "NewWeb", Form1
112 With Form1!NewWeb
113 .Visible = True
114 .Width = 10000
115 .Height = 10000
116 .Left = 0
117 .Top = 0
118 .Navigate2 "www.csdn.net"
119 End With
120 End Sub
121
122 Private Sub Command2_Click()
123 Controls.Remove Form1!newweb
124 End Sub
125
126 Form1.Controls.Add "shell.explorer.2", newweb(newweb.Count), Form1
127 With Form1!newweb(newweb.Count)
128 .Visible = True
129 .Width = 1000
130 .Height = 1000
131 .Left = newweb(newweb.Count - 1).Left + newweb(newweb.Count - 1).Width
132 .Top = 0
133 '.Navigate2 "www.csdn.net"
134 End With
135 为什么他说我
136 Form1.Controls.Add "shell.explorer.2", newweb(newweb.Count), Form1
137 这一行错误13 类型不匹配？
138 ps：我在form中已经有了一个newweb(0)控件
139
140
141 先为一个WebBrowser
142 Dim i As Integer
143 Private Sub AddWeb_Click()
144 For i = 1 To 10
145 Load NewWeb(i)
146 NewWeb(i).Top = i * 100
147 NewWeb(i).Left = i * 100
148 NewWeb(i).Visible = True
149 Next i
150 End Sub
151
152 Private Sub DelWeb_Click()
153 For i = 1 To 10
154 Unload NewWeb(i)
155 Next i
156 End Sub
157
158 =========================================================
159
160
161 一个把页面保存为MHT(即MHTML)文件
162 1、
163
164 谢谢楼上几位大侠！我现在将 pcwak(书剑狂生[MS MVP]) 大侠提供的资料贴出来，以供大家参考：
165 我终于找到一个把页面保存为MHT(即MHTML)文件的方法了!
166 首先，在工程中必须要引用一个库：
167 Library CDO
168 D:WINNTSystem32cdosys.dll
169 Microsoft CDO for Windows 2000 Library
170 其次，需要Stream对应的接口的支持，如果你一时找不到就使用支持这个的较新的ADO就行了，如
171 Library ADODB
172 D:Program FilesCommon Filessystemadomsado15.dll
173 Microsoft ActiveX Data Objects 2.5 Library
174 代码如下，十分简单(同时由于流的特点，显示在实际应用中没必要象本例中那样把文件保存到磁盘上就可直接转换为字符串或字节数组什么的处理的。
175
176 另，对于Microsoft CDO for Windows 2000 Library这个库，在WIN98中要怎么使用还没试过，感兴趣的朋友可以试试并跟帖，以丰富完善其内容：)
177
178 Private Sub Command1_Click()
179 ' Reference to Microsoft ActiveX Data Objects 2.5 Library
180 ' Reference to Microsoft CDO for Windows 2000 Library
181 Dim iMsg As New CDO.Message
182 Dim iConf As New CDO.Configuration
183 Dim objStream As ADODB.Stream
184
185 With iMsg
186 .CreateMHTMLBody "http://www.163.com/";, , _
187 "domainusername", _
188 "password"
189 Set objStream = .GetStream
190 Call objStream.SaveToFile("f:test.mht", adSaveCreateOverWrite)
191 End With
192 End Sub
193
194 2、
195
196
197 '首先加入对ADODB和CDO（Microsoft CDO for Windows 2000 Library，对应文件名为CDOSYS.dll）的引用
198 Private Sub Command1_Click()
199 Dim message As New CDO.message
200 Dim Outstream As ADODB.Stream
201 On Error GoTo myerr1
202 Call message.CreateMHTMLBody("http://www.csdn.net", CDO.CdoMHTMLFlags.cdoSuppressNone, "", "")
203 Set Outstream = message.GetStream
204 Call Outstream.SaveToFile("c:test.mht", ADODB.SaveOptionsEnum.adSaveCreateOverWrite)
205 MsgBox "完成"
206
207 Exit Sub
208 myerr1:
209 Set message = Nothing
210 Set Outstream = Nothing
211 End Sub
212
213 =====================================================
214
215
216
217 请问高手们怎样在WebBrowser控件调用收藏夹和在收藏夹里添加收藏
218 Option Explicit
219
220 Private Sub Command1_Click()
221 Dim ObjSUH As New ShellUIHelper
222 ObjSUH.AddFavorite "http://www.csdn.net", "CSDN"
223 Set ObjSUH = Nothing
224 End Sub
225
226 visual basic 6.0的浏览器插件使用技巧
227 取得网页中特定的链接
228 Private Sub Command1_Click()
229 WebBrowser1.Navigate "http://www.95557.com/svote.htm"
230 End Sub
231
232 Private Sub WebBrowser1_NavigateComplete2(ByVal pDisp As Object, URL As Variant)
233 Dim a
234
235 For Each a In WebBrowser1.Document.All
236 If a.tagname = "A" Then
237 If a.href = "http://tech.sina.com.cn/mobile/capture.shtml" Then
238 a.Click
239 End If
240 End If
241 Next
242 End Sub
243
244
245 Option Explicit
246 Private m_bDone As Boolean
247
248 Private Sub Command1_Click()
249 If m_bDone Then
250 Dim doc As IHTMLDocument2
251 Set doc = WebBrowser1.Document
252 Dim aLink As HTMLLinkElement
253 Set aLink = doc.links(0)
254 aLink.Click
255 End If
256 End Sub
257
258 Private Sub Form_Load()
259 WebBrowser1.Navigate "http://www.95557.com/svote.htm"
260 End Sub
261
262 Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
263 m_bDone = True
264 End Sub
265
266 ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
267
268 The following code can be used to query and delete files in the internet 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&.
269 Option Explicit
270 '--------------------------Types, consts and structures
271 Private Const ERROR_CACHE_FIND_FAIL As Long = 0
272 Private Const ERROR_CACHE_FIND_SUCCESS As Long = 1
273 Private Const ERROR_FILE_NOT_FOUND As Long = 2
274 Private Const ERROR_ACCESS_DENIED As Long = 5
275 Private Const ERROR_INSUFFICIENT_BUFFER As Long = 122
276 Private Const MAX_CACHE_ENTRY_INFO_SIZE As Long = 4096
277 Private Const LMEM_FIXED As Long = &H0
278 Private Const LMEM_ZEROINIT As Long = &H40
279 Public Enum eCacheType
280 eNormal = &H1&
281 eEdited = &H8&
282 eTrackOffline = &H10&
283 eTrackOnline = &H20&
284 eSticky = &H40&
285 eSparse = &H10000
286 eCookie = &H100000
287 eURLHistory = &H200000
288 eURLFindDefaultFilter = 0&
289 End Enum
290 Private Type FILETIME
291 dwLowDateTime As Long
292 dwHighDateTime As Long
293 End Type
294 Private Type INTERNET_CACHE_ENTRY_INFO
295 dwStructSize As Long
296 lpszSourceUrlName As Long
297 lpszLocalFileName As Long
298 CacheEntryType As Long 'Type of entry returned
299 dwUseCount As Long
300 dwHitRate As Long
301 dwSizeLow As Long
302 dwSizeHigh As Long
303 LastModifiedTime As FILETIME
304 ExpireTime As FILETIME
305 LastAccessTime As FILETIME
306 LastSyncTime As FILETIME
307 lpHeaderInfo As Long
308 dwHeaderInfoSize As Long
309 lpszFileExtension As Long
310 dwExemptDelta As Long
311 End Type
312 '--------------------------Internet Cache API
313 Private Declare Function FindFirstUrlCacheEntry Lib "Wininet.dll" Alias "FindFirstUrlCacheEntryA" (ByVal lpszUrlSearchPattern As String, lpFirstCacheEntryInfo As Any, lpdwFirstCacheEntryInfoBufferSize As Long) As Long
314 Private Declare Function FindNextUrlCacheEntry Lib "Wininet.dll" Alias "FindNextUrlCacheEntryA" (ByVal hEnumHandle As Long, lpNextCacheEntryInfo As Any, lpdwNextCacheEntryInfoBufferSize As Long) As Long
315 Private Declare Function FindCloseUrlCache Lib "Wininet.dll" (ByVal hEnumHandle As Long) As Long
316 Private Declare Function DeleteUrlCacheEntry Lib "Wininet.dll" Alias "DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Long
317 '--------------------------Memory API
318 Private Declare Function LocalAlloc Lib "kernel32" (ByVal uFlags As Long, ByVal uBytes As Long) As Long
319 Private Declare Function LocalFree Lib "kernel32" (ByVal hMem As Long) As Long
320 Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)
321 Private Declare Function lstrcpyA Lib "kernel32" (ByVal RetVal As String, ByVal Ptr As Long) As Long
322 Private Declare Function lstrlenA Lib "kernel32" (ByVal Ptr As Any) As Long
323 'Purpose : Deletes the specified internet cache file
324 'Inputs : sCacheFile The name of the cache file
325 'Outputs : Returns True on success.
326 'Author : Andrew Baker
327 'Date : 03/08/2000 19:14
328 'Notes :
329 'Revisions :
330 Function InternetDeleteCache(sCacheFile As String) As Boolean
331 InternetDeleteCache = CBool(DeleteUrlCacheEntry(sCacheFile))
332 End Function
333 'Purpose : Returns an array of files stored in the internet cache
334 'Inputs : eFilterType An enum which filters the files returned by their type
335 'Outputs : A one dimensional, one based, string array containing the names of the files
336 'Author : Andrew Baker
337 'Date : 03/08/2000 19:14
338 'Notes :
339 'Revisions :
340 Function InternetCacheList(Optional eFilterType As eCacheType = eNormal) As Variant
341 Dim ICEI As INTERNET_CACHE_ENTRY_INFO
342 Dim lhFile As Long, lBufferSize As Long, lptrBuffer As Long
343 Dim sCacheFile As String
344 Dim asURLs() As String, lNumEntries As Long
345 'Determine required buffer size
346 lBufferSize = 0
347 lhFile = FindFirstUrlCacheEntry(0&, ByVal 0&, lBufferSize)
348 If (lhFile = ERROR_CACHE_FIND_FAIL) And (Err.LastDllError = ERROR_INSUFFICIENT_BUFFER) Then
349 'Allocate memory for ICEI structure
350 lptrBuffer = LocalAlloc(LMEM_FIXED, lBufferSize)
351 If lptrBuffer Then
352 'Set a Long pointer to the memory location
353 CopyMemory ByVal lptrBuffer, lBufferSize, 4
354 'Call first find API passing it the pointer to the allocated memory
355 lhFile = FindFirstUrlCacheEntry(vbNullString, ByVal lptrBuffer, lBufferSize) '1 = success
356 If lhFile <> ERROR_CACHE_FIND_FAIL Then
357 'Loop through the cache
358 Do
359 'Copy data back to structure
360 CopyMemory ICEI, ByVal lptrBuffer, Len(ICEI)
361 If ICEI.CacheEntryType And eFilterType Then
362 sCacheFile = StrFromPtrA(ICEI.lpszSourceUrlName)
363 lNumEntries = lNumEntries + 1
364 If lNumEntries = 1 Then
365 ReDim asURLs(1 To 1)
366 Else
367 ReDim Preserve asURLs(1 To lNumEntries)
368 End If
369 asURLs(lNumEntries) = sCacheFile
370 End If
371 'Free memory associated with the last-retrieved file
372 Call LocalFree(lptrBuffer)
373 'Call FindNextUrlCacheEntry with buffer size set to 0.
374 'Call will fail and return required buffer size.
375 lBufferSize = 0
376 Call FindNextUrlCacheEntry(lhFile, ByVal 0&, lBufferSize)
377 'Allocate and assign the memory to the pointer
378 lptrBuffer = LocalAlloc(LMEM_FIXED, lBufferSize)
379 CopyMemory ByVal lptrBuffer, lBufferSize, 4&
380 Loop While FindNextUrlCacheEntry(lhFile, ByVal lptrBuffer, lBufferSize)
381 End If
382 End If
383 End If
384 'Free memory
385 Call LocalFree(lptrBuffer)
386 Call FindCloseUrlCache(lhFile)
387 InternetCacheList = asURLs
388 End Function
389 'Purpose : Converts a pointer an ansi string into a string.
390 'Inputs : lptrString A long pointer to a string held in memory
391 'Outputs : The string held at the specified memory address
392 'Author : Andrew Baker
393 'Date : 03/08/2000 19:14
394 'Notes :
395 'Revisions :
396 Function StrFromPtrA(ByVal lptrString As Long) As String
397 'Create buffer
398 StrFromPtrA = String$(lstrlenA(ByVal lptrString), 0)
399 'Copy memory
400 Call lstrcpyA(ByVal StrFromPtrA, ByVal lptrString)
401 End Function
402 'Demonstration routine
403 Sub Test()
404 Dim avURLs As Variant, vThisValue As Variant
405 On Error Resume Next
406 'Return an array of all internet cache files
407 avURLs = InternetCacheList
408 For Each vThisValue In avURLs
409 'Print files
410 Debug.Print CStr(vThisValue)
411 Next
412 'Return the an array of all cookies
413 avURLs = InternetCacheList(eCookie)
414 If MsgBox("Delete cookies?", vbQuestion + vbYesNo) = vbYes Then
415 For Each vThisValue In avURLs
416 'Delete cookies
417 InternetDeleteCache CStr(vThisValue)
418 Debug.Print "Deleted " & vThisValue
419 Next
420 Else
421 For Each vThisValue In avURLs
422 'Print cookie files
423 Debug.Print vThisValue
424 Next
425 End If
426 End Sub
427
428
429 ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
430 分析网页内容，取得 ")
431 If i <> 0 Then
432 sTemp = Right(sTemp, Len(sTemp) - i - 8)
433 End If
434 sTemp = outStr & sTemp
435 End If
436 Loop
437 WebBrowser1.Document.write sTemp
438 'Text2.Text = sTemp
439 End Sub
440
441
442 ====================================================
443
444 控制字体大小
445
446 webbrowser1 ExecWB OLECMDID_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER, CLng(4 - Index)
447
448 index=0-4表示从最大到最小~~
449
450 最小的话,index=4，呵呵
451
452 webbrowser1 ExecWB OLECMDID_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER,0
453 可以遍历页面，也可以~~
454
455 如果你只是想得到网页中的所有连接，这样就OK了~~
456
457 Option Explicit
458
459 Private Sub Command1_Click()
460 Command1.Enabled = False
461 WebBrowser1.Navigate2 Text1.Text
462 End Sub
463
464 Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
465
466 Dim x As Long
467 List1.Clear
468
469 For x = 0 To WebBrowser1.Document.Links.length - 1
470 List1.AddItem WebBrowser1.Document.Links.Item(x)
471 Next x
472 Command1.Enabled = True
473 End Sub
474
475 Private Sub WebBrowser1_StatusTextChange(ByVal Text As String)
476 Label3 = Text
477 End Sub
478
479
480
481 ==============================================================
482 Public Class Form1
483 Inherits System.Windows.Forms.Form
484
485 #Region " Windows Form Designer generated code "
486 'Omitted
487 #End Region
488
489 Private Sub Button1_Click(ByVal sender As System.Object, _
490 ByVal e As System.EventArgs) Handles Button1.Click
491 AxWebBrowser1.Navigate(TextBox1.Text)
492 End Sub
493
494 Private Sub AxWebBrowser1_NewWindow2(ByVal sender As Object, _
495 ByVal e As AxSHDocVw.DWebBrowserEvents2_NewWindow2Event) _
496 Handles AxWebBrowser1.NewWindow2
497 'MessageBox.Show(AxWebBrowser1.Height & ":" & AxWebBrowser1.Width)
498
499 'MessageBox.Show(doc.body.innerHTML)
500 Dim frmWB As Form1
501 frmWB = New Form1()
502
503 frmWB.AxWebBrowser1.RegisterAsBrowser = True
504 'frmWB.AxWebBrowser1.Navigate2("about:blank")
505 e.ppDisp = frmWB.AxWebBrowser1.Application
506 frmWB.Visible = True
507 'MessageBox.Show(frmWB.AxWebBrowser1.Height & ":" & frmWB.AxWebBrowser1.Width)
508 End Sub
509
510 Private Sub AxWebBrowser1_WindowSetHeight(ByVal sender As Object, _
511 ByVal e As AxSHDocVw.DWebBrowserEvents2_WindowSetHeightEvent) _
512 Handles AxWebBrowser1.WindowSetHeight
513 'MessageBox.Show("In SetHeight" & Me.Height & ":" & e.height)
514 Dim heightDiff As Integer
515 heightDiff = Me.Height - Me.AxWebBrowser1.Height
516 Me.Height = heightDiff + e.height
517 End Sub
518
519 Private Sub AxWebBrowser1_WindowSetWidth(ByVal sender As Object, _
520 ByVal e As AxSHDocVw.DWebBrowserEvents2_WindowSetWidthEvent) _
521 Handles AxWebBrowser1.WindowSetWidth
522 'MessageBox.Show("In SetWidth" & Me.Width & ":" & e.width)
523 Dim widthDiff As Integer
524 widthDiff = Me.Width - Me.AxWebBrowser1.Width
525 Me.Width = widthDiff + e.width
526 End Sub
527
528 End Class
529
530
531
532
533 ==============================================================
534 选择网页上的内容。
535
536 '引用 Microsoft HTML Object Library
537
538 Dim oDoc As HTMLDocument
539 Dim oElement As Object
540 Dim oTxtRgn As Object
541 Dim sSelectedText As String
542
543 Set oDoc = WebBrowser1.Document'获得文档对象
544 Set oElement = oDoc.getElementById("T1")'获得ID="T1"的对象
545 Set oTxtRgn = oDoc.selection.createRange'获得文档当前正选择的区域对象
546
547 sSelectedText = oTxtRgn.Text'选择区域文本赋值
548
549 oElement.Focus'"T1"对象获得焦点
550
551 oElement.Select'全选对象"T1"
552
553 Debug.Print "你选择了文本：" & sSelectedText
554
555
556 上面这段儿还附送了其他功能，呵呵。精简一下是这样：
557 Dim oDoc As Object
558 Dim oTxtRgn As Object
559 Dim sSelectedHTML As String
560
561 Set oDoc = WebBrowser1.Document '获得文档对象
562 Set oTxtRgn = oDoc.selection.createRange '获得文档当前正选择的区域对象
563
564 sSelectedHTML = oTxtRgn.htmlText '选择区域文本赋值
565
566 Text1.Text=sSelectedHTML '文本框显示抓取得HTML源码
567 ......'或者继续分析源码
568
569
570
571