以下内容是 TOM相册下载器的 Form1 的源代码,没有过多的解释,朋友们自己读一下,有需要交流的请联系.

VERSION 5.00
Object = "{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 = 12030
ClientLeft = 60
ClientTop = 345
ClientWidth = 13455
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 12030
ScaleWidth = 13455
StartUpPosition = 3 '窗口缺省
Begin SHDocVwCtl.WebBrowser WebBrowser2
Height = 9615
Left = 0
TabIndex = 13
Top = 0
Width = 13095
ExtentX = 23098
ExtentY = 16960
ViewMode = 0
Offline = 0
Silent = 0
RegisterAsBrowser= 0
RegisterAsDropTarget= 1
AutoArrange = 0 'False
NoClientEdge = 0 'False
AlignLeft = 0 'False
NoWebView = 0 'False
HideFileNames = 0 'False
SingleClick = 0 'False
SingleSelection = 0 'False
NoFolders = 0 'False
Transparent = 0 'False
ViewID = "{0057D0E0-3573-11CF-AE69-08002B2E1262}"
Location = "http:///"
End
Begin VB.CommandButton Command6
Caption = "查看图片"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 975
Left = 8760
TabIndex = 12
Top = 9840
Width = 3855
End
Begin VB.CommandButton Command5
Caption = "Command5"
Height = 375
Left = 4320
TabIndex = 11
Top = 7200
Width = 1335
End
Begin VB.CommandButton Command3
Caption = "Command3"
Height = 495
Left = 2040
TabIndex = 10
Top = 7080
Width = 1695
End
Begin VB.TextBox Text6
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 120
TabIndex = 9
Text = "http://photo.tom.com/picture/544861064/8338.html#544861064_8338"
Top = 10320
Width = 8295
End
Begin VB.ListBox List1
Height = 2040
Left = 9480
TabIndex = 8
Top = 120
Width = 3495
End
Begin VB.TextBox Text4
Height = 375
Left = 1080
TabIndex = 7
Text = "Text4"
Top = 8880
Visible = 0 'False
Width = 10575
End
Begin VB.CommandButton Command4
Caption = "清空 list 列表"
Height = 300
Left = 7680
TabIndex = 6
Top = 2280
Visible = 0 'False
Width = 2775
End
Begin VB.CommandButton Command2
Caption = "查看搜索到的图片"
Height = 615
Left = 4200
TabIndex = 5
Top = 5520
Width = 3015
End
Begin VB.TextBox Text3
Height = 375
Left = 1080
TabIndex = 4
Top = 8520
Visible = 0 'False
Width = 8295
End
Begin InetCtlsObjects.Inet Inet1
Left = 240
Top = 7920
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
End
Begin SHDocVwCtl.WebBrowser WebBrowser1
Height = 2535
Left = 120
TabIndex = 3
Top = 3000
Width = 6975
ExtentX = 12303
ExtentY = 4471
ViewMode = 0
Offline = 0
Silent = 0
RegisterAsBrowser= 0
RegisterAsDropTarget= 1
AutoArrange = 0 'False
NoClientEdge = 0 'False
AlignLeft = 0 'False
NoWebView = 0 'False
HideFileNames = 0 'False
SingleClick = 0 'False
SingleSelection = 0 'False
NoFolders = 0 'False
Transparent = 0 'False
ViewID = "{0057D0E0-3573-11CF-AE69-08002B2E1262}"
Location = "http:///"
End
Begin VB.TextBox Text2
Height = 2055
Left = 4680
MultiLine = -1 'True
TabIndex = 2
Top = 120
Width = 4695
End
Begin VB.CommandButton Command1
Caption = "提取 http 开头， jpg 结尾的项目 "
Height = 375
Left = 6000
TabIndex = 1
Top = 8040
Width = 6615
End
Begin VB.TextBox Text1
Height = 2055
Left = 120
MultiLine = -1 'True
TabIndex = 0
Top = 120
Width = 4575
End
Begin VB.Label Label1
Alignment = 2 'Center
Caption = "从浏览器的地址栏将TOM相册的第一张照片的地址复制粘贴到下面："
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 120
TabIndex = 14
Top = 9840
Width = 8295
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim cmd6 As Integer

Private Sub Command1_Click()
Dim strTemp As String
Dim i, j, k, m, n, tempArry, JieGuo, tempArry2
Dim strHead, strMid1, strMid2, strEnd As String
strHead = "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.Text
strTemp = WebBrowser1.Document.body.innerHTML
i = InStr(1, strTemp, strHead)
j = InStr(1, strTemp, strEnd)

If i = 0 Or j = 0 Then
MsgBox "相册查找错误", vbOKCancel
End
End 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 & "**************" & strTemp
tempArry = Split(strTemp, " ")
m = LBound(tempArry)
n = UBound(tempArry)
For i = m To n
If InStr(1, tempArry(i), "http://") And InStr(1, tempArry(i), ".jpg") And InStr(1, tempArry(i), "tomoimg.cn/0x0/") Then
List1.AddItem tempArry(i)
End If
Next i
'去除 list 中的相同项。
'QuChuListXiangTongXiang
Command2_Click
End Sub

Private Sub Command2_Click()
Dim strHTML, i
Dim strHead, strMid1, strMid2, strEnd As String
strHead = " &nbsp;<img alt="""
strMid1 = """ src="""
strMid2 = """> "
strEnd = " <br> &nbsp"
For i = 0 To List1.ListCount - 1
strHTML = strHTML + strHead + Text3.Text + strMid1 + List1.List(i) + strMid2 + Text3.Text + strEnd
Next i
Text2.Text = strHTML
'Open App.Path & "\tempFile.html" For Output As #1
Open "c:\tempFile.html" For Output As #1
Print #1, strHTML
Close #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.Clear
cmd6 = 1
WebBrowser1.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 = 0
End Sub

Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
If cmd6 = 1 Then
Command1_Click
'Command2_Click
cmd6 = 0
End If

End Sub

看完了, 别忘了点击 我的网页广告 支持 一下阿  !!