昨天在百度的知道看到一个朋友向批量下载 TOM 的相册。我就用了一下午的时间，改造了 原来的 搜狐博客下载，上传过来大家分享。 网络的批量下载是很多朋友喜欢的，我很久没有再考虑这些，这次的程序很适合100张以内的照片下载，如果照片张数过多，在下载的时候耗费资源多，会显得有些迟钝。   使用方法： 1。找到喜欢的相册，打开他的第一张图片。 2。复制地址栏的地址。 3。粘贴到指定位置。 4。点击查看图片。 5。在一个新的页面里看多所有的图片了，在文件菜单 点击 另存为 —— —— 把网页全部存在指定位置，就获得了所有图片。   以下内容是 TOM相册下载器的 Form1 的源代码,没有过多的解释,朋友们自己读一下,有需要交流的请联系.     VERSION 5.00Object = "{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}#1.1#0"; "ieframe.dll"Object = "{48E59290-9880-11CF-9754-00AA00C00908}#1.0#0"; "msinet.ocx"Begin VB.Form Form1 Caption = "Form1"ClientHeight = 12030ClientLeft = 60ClientTop = 345ClientWidth = 13455LinkTopic = "Form1"MaxButton = 0 'FalseScaleHeight = 12030ScaleWidth = 13455StartUpPosition = 3 '窗口缺省Begin SHDocVwCtl.WebBrowser WebBrowser2 Height = 9615Left = 0TabIndex = 13Top = 0Width = 13095ExtentX = 23098ExtentY = 16960ViewMode = 0Offline = 0Silent = 0RegisterAsBrowser= 0RegisterAsDropTarget= 1AutoArrange = 0 'FalseNoClientEdge = 0 'FalseAlignLeft = 0 'FalseNoWebView = 0 'FalseHideFileNames = 0 'FalseSingleClick = 0 'FalseSingleSelection = 0 'FalseNoFolders = 0 'FalseTransparent = 0 'FalseViewID = "{0057D0E0-3573-11CF-AE69-08002B2E1262}"Location = "http:///"EndBegin VB.CommandButton Command6 Caption = "查看图片"BeginProperty Font Name = "宋体"Size = 12Charset = 134Weight = 400Underline = 0 'FalseItalic = 0 'FalseStrikethrough = 0 'FalseEndPropertyHeight = 975Left = 8760TabIndex = 12Top = 9840Width = 3855EndBegin VB.CommandButton Command5 Caption = "Command5"Height = 375Left = 4320TabIndex = 11Top = 7200Width = 1335EndBegin VB.CommandButton Command3 Caption = "Command3"Height = 495Left = 2040TabIndex = 10Top = 7080Width = 1695EndBegin VB.TextBox Text6 BeginProperty Font Name = "宋体"Size = 12Charset = 134Weight = 400Underline = 0 'FalseItalic = 0 'FalseStrikethrough = 0 'FalseEndPropertyHeight = 495Left = 120TabIndex = 9Text = "http://photo.tom.com/picture/544861064/8338.html#544861064_8338"Top = 10320Width = 8295EndBegin VB.ListBox List1 Height = 2040Left = 9480TabIndex = 8Top = 120Width = 3495EndBegin VB.TextBox Text4 Height = 375Left = 1080TabIndex = 7Text = "Text4"Top = 8880Visible = 0 'FalseWidth = 10575EndBegin VB.CommandButton Command4 Caption = "清空 list 列表"Height = 300Left = 7680TabIndex = 6Top = 2280Visible = 0 'FalseWidth = 2775EndBegin VB.CommandButton Command2 Caption = "查看搜索到的图片"Height = 615Left = 4200TabIndex = 5Top = 5520Width = 3015EndBegin VB.TextBox Text3 Height = 375Left = 1080TabIndex = 4Top = 8520Visible = 0 'FalseWidth = 8295EndBegin InetCtlsObjects.Inet Inet1 Left = 240Top = 7920_ExtentX = 1005_ExtentY = 1005_Version = 393216EndBegin SHDocVwCtl.WebBrowser WebBrowser1 Height = 2535Left = 120TabIndex = 3Top = 3000Width = 6975ExtentX = 12303ExtentY = 4471ViewMode = 0Offline = 0Silent = 0RegisterAsBrowser= 0RegisterAsDropTarget= 1AutoArrange = 0 'FalseNoClientEdge = 0 'FalseAlignLeft = 0 'FalseNoWebView = 0 'FalseHideFileNames = 0 'FalseSingleClick = 0 'FalseSingleSelection = 0 'FalseNoFolders = 0 'FalseTransparent = 0 'FalseViewID = "{0057D0E0-3573-11CF-AE69-08002B2E1262}"Location = "http:///"EndBegin VB.TextBox Text2 Height = 2055Left = 4680MultiLine = -1 'TrueTabIndex = 2Top = 120Width = 4695EndBegin VB.CommandButton Command1 Caption = "提取 http 开头， jpg 结尾的项目 "Height = 375Left = 6000TabIndex = 1Top = 8040Width = 6615EndBegin VB.TextBox Text1 Height = 2055Left = 120MultiLine = -1 'TrueTabIndex = 0Top = 120Width = 4575EndBegin VB.Label Label1 Alignment = 2 'CenterCaption = "从浏览器的地址栏将TOM相册的第一张照片的地址复制粘贴到下面："BeginProperty Font Name = "宋体"Size = 12Charset = 134Weight = 400Underline = 0 'FalseItalic = 0 'FalseStrikethrough = 0 'FalseEndPropertyHeight = 375Left = 120TabIndex = 14Top = 9840Width = 8295EndEndAttribute VB_Name = "Form1"Attribute VB_GlobalNameSpace = FalseAttribute VB_Creatable = FalseAttribute VB_PredeclaredId = TrueAttribute VB_Exposed = FalseOption ExplicitDim cmd6 As Integer Private Sub Command1_Click()Dim strTemp As StringDim i, j, k, m, n, tempArry, JieGuo, tempArry2Dim strHead, strMid1, strMid2, strEnd As StringstrHead = "var ImageList = {"strMid1 = """ src="""strMid2 = """> "strEnd = "当前图片索引"'Text1.Text = WebBrowser1.Document.selection.createRange'Text1.Text = WebBrowser1.Document.body.innerText'Text1.Text = WebBrowser1.Document.body.innerHTML'strTemp = Text1.TextstrTemp = WebBrowser1.Document.body.innerHTMLi = InStr(1, strTemp, strHead)j = InStr(1, strTemp, strEnd) If i = 0 Or j = 0 ThenMsgBox "相册查找错误", vbOKCancelEndEnd If strTemp = Left(strTemp, j)strTemp = Right(strTemp, Len(strTemp) - i)   strTemp = Replace(strTemp, """", " ")'strTemp = Replace(strTemp, """,""title""", " ")   While InStr(1, strTemp, "　 ")strTemp = Replace(strTemp, " ", " ")Wend' Text1.Text = WebBrowser1.LocationURL & "**************" & strTemptempArry = Split(strTemp, " ")m = LBound(tempArry)n = UBound(tempArry)For i = m To nIf InStr(1, tempArry(i), "http://") And InStr(1, tempArry(i), ".jpg") And InStr(1, tempArry(i), "tomoimg.cn/0x0/") ThenList1.AddItem tempArry(i)End IfNext i'去除 list 中的相同项。'QuChuListXiangTongXiangCommand2_ClickEnd Sub Private Sub Command2_Click()Dim strHTML, iDim strHead, strMid1, strMid2, strEnd As StringstrHead = " &nbsp;<img alt="""strMid1 = """ src="""strMid2 = """> "strEnd = " <br> &nbsp"For i = 0 To List1.ListCount - 1strHTML = strHTML + strHead + Text3.Text + strMid1 + List1.List(i) + strMid2 + Text3.Text + strEndNext iText2.Text = strHTML'Open App.Path & "\tempFile.html" For Output As #1Open "c:\tempFile.html" For Output As #1Print #1, strHTMLClose #1 Shell "C:\Program Files\Internet Explorer\iexplore.exe" + " c:\tempFile.html", vbMaximizedFocus List1.Clear'Shell "C:\Program Files\Internet Explorer\iexplore.exe" + " " & App.Path & "\tempFile.html"'WebBrowser2.Navigate2 "c:\tempFile.html"End Sub Private Sub Command6_Click()List1.Clearcmd6 = 1WebBrowser1.Navigate Text6.Text End Sub Private Sub Form_Load()WebBrowser2.Navigate "http://yuletupian.com/tupianxiazaiqi.htm"WebBrowser1.Navigate "http://yuletupian.com/tupianxiazaiqi.htm"End Sub Private Sub Text6_Change()cmd6 = 0End Sub Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)If cmd6 = 1 ThenCommand1_Click'Command2_Clickcmd6 = 0End If End Sub 看完了, 别忘了点击 我的网页广告 支持 一下阿  !!     souhu 搜狐博客下载器 下载地址 源码下载   TOM TOK相册下载器 下载地址 源码下载   Google 谷歌搜索图片下载器 下载地址 源码下载   欢迎使用 希望能提出您宝贵的意见，相互提高学习。

评论