502647092/LoadFirstPic
1
0
Fork 0
mirror of https://e.coding.net/circlecloud/LoadFirstPic.git synced 2024-12-28 08:08:50 +00:00
Code Releases Activity

add form Frm_Download...

Browse Source 
Signed-off-by: j502647092 <jtb1@163.com>
This commit is contained in:
j502647092 2015-06-11 20:23:20 +08:00
parent ef86f828a9
commit 1acdc202c3
3 changed files with 358 additions and 284 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

165
Frm_Download.frm Normal file
View File

@ -0,0 +1,165 @@
VERSION 5.00
Begin VB.Form Frm_Download
Caption = "首图下载"
ClientHeight = 4800
ClientLeft = 60
ClientTop = 345
ClientWidth = 11565
LinkTopic = "Form1"
ScaleHeight = 4800
ScaleWidth = 11565
StartUpPosition = 3 '窗口缺省
Begin VB.CommandButton clear
Caption = "清空"
Height = 300
Left = 0
TabIndex = 3
Top = 285
Width = 1020
End
Begin 导出商品首图.TzProgressBar pb
Height = 255
Left = 1080
Top = 330
Width = 10440
_ExtentX = 18415
_ExtentY = 450
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Caption = "总进度"
BackColor = 8438015
StartColor = 8438015
End
Begin 导出商品首图.TzDownload dl
Height = 250
Left = 1065
Top = 60
Width = 10440
_ExtentX = 18415
_ExtentY = 450
ForeColor = 16777088
End
Begin VB.CommandButton dlc
Caption = "下载"
Height = 300
Left = 0
TabIndex = 2
Top = 0
Width = 1020
End
Begin 导出商品首图.TzListBox UName
Height = 1170
Left = 0
TabIndex = 0
Top = 2055
Width = 3795
_ExtentX = 6694
_ExtentY = 2064
End
Begin 导出商品首图.TzListBox SName
Height = 1335
Left = -15
TabIndex = 1
Top = 720
Width = 3810
_ExtentX = 6720
_ExtentY = 2355
End
End
Attribute VB_Name = "Frm_Download"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'=================================Sleep========================================
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Private Savetime As Double
Private sd As Boolean
Private Sub clear_Click()
SName.clear
UName.clear
End Sub
Private Sub dl_OnFinished(ByVal Result As Boolean)
sd = Result
End Sub
Private Sub dlc_Click()
Dim i
Dim folder As String
Dim usetime As Double
If folder = "" Then folder = InputBox("请输入 日期-首图-公司名称-阿里账号-提单人名称!", , Format(Now, "m.d") & "-首图-公司名称-阿里账号-提单人名称")
If folder = "" Then folder = Format(Now, "m.d") & "-首图-公司名称-阿里账号-提单人名称"
usetime = timeGetTime
For i = 0 To UName.ListCount - 1
red:
pb.Change i, "下载中 进度: " & i & "/" & pb.BarMax
UName.ListIndex = i
SName.ListIndex = i
dl.FileDownload UName.List(i), App.Path & "\" & folder & "\" & Trim(SName.List(i)) ' & ".jpg"
Do
Sleep 50
Loop Until dl.IsFree
If Not sd Then GoTo red
'Debug.Print Replace(Trim(SName.List(i)), " ", "")
Next
usetime = Format((timeGetTime - usetime) / 1000, "0.00")
pb.Change pb.BarMax, "下载完成 共下载" & pb.BarMax & "件产品首图 耗时" & usetime & "秒!", &H80FF80
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Me.Hide
Cancel = True
End Sub
'itempicurl (ix), App.Path & "\" & folder.Text & "\" & itemname(ix).Text & ".jpg"
Private Sub Form_Resize()
On Error Resume Next
SName.Left = 5
SName.Top = 600
SName.Height = Me.Height - 600
SName.Width = Me.Width / 2 - 10
UName.Left = Me.Width / 2 + 10
UName.Top = 600
UName.Height = Me.Height - 600
UName.Width = Me.Width / 2 - 10
dl.Left = dlc.Left + dlc.Width + 10
dl.Width = Me.Width - dl.Left - 20
dl.Top = 25
pb.Left = dlc.Left + dlc.Width + 10
pb.Width = Me.Width - dl.Left - 20
pb.Top = dl.Top + dl.Height + 50
End Sub
Public Sub Sleep(n As Long)
Savetime = timeGetTime
While timeGetTime < Savetime + n
DoEvents
Wend
End Sub
Private Sub SName_dblClick()
InputBox "", , SName.List(SName.ListIndex)
End Sub
Private Sub UName_AddItem()
pb.BarMax = UName.ListCount
pb.Change pb.BarMax, "以扫描到商品信息" & UName.ListCount & "条"
End Sub
Private Sub UName_dblClick()
InputBox "", , UName.List(UName.ListIndex)
End Sub

475
Frm_Main.frm
View File

@ -10,55 +10,51 @@ Begin VB.Form Frm_Main
ScaleHeight = 9390 ScaleHeight = 9390
ScaleWidth = 19035 ScaleWidth = 19035
StartUpPosition = 3 '窗口缺省 StartUpPosition = 3 '窗口缺省
Begin 导出商品首图.TzListBox UName Begin VB.CommandButton pic
Height = 1170 Caption = "图片"
Left = 8835 Height = 300
TabIndex = 28 Left = 11400
Top = 4440 TabIndex = 15
Width = 3795 Top = 90
_ExtentX = 6694 Width = 600
_ExtentY = 2064
End End
Begin 导出商品首图.TzListBox SName Begin VB.CommandButton manager
Height = 1335 Caption = "商品"
Left = 8835 Height = 300
TabIndex = 27 Left = 10500
Top = 3135 TabIndex = 14
Width = 3810 Top = 90
_ExtentX = 6720 Width = 600
_ExtentY = 2355
End End
Begin SHDocVwCtl.WebBrowser web Begin VB.CommandButton alibaba
Height = 915 Caption = "1688"
Index = 1 Height = 300
Left = 8580 Left = 9600
TabIndex = 8 TabIndex = 13
Top = 1335 Top = 90
Width = 1155 Width = 600
ExtentX = 2037 End
ExtentY = 1614 Begin VB.CommandButton oa
ViewMode = 0 Caption = "OA"
Offline = 0 Height = 300
Silent = 0 Left = 8700
RegisterAsBrowser= 1 TabIndex = 12
RegisterAsDropTarget= 1 Top = 90
AutoArrange = 0 'False Width = 600
NoClientEdge = 0 'False End
AlignLeft = 0 'False Begin VB.CommandButton lookitem
NoWebView = 0 'False Caption = "查看商品"
HideFileNames = 0 'False Height = 300
SingleClick = 0 'False Left = 12300
SingleSelection = 0 'False TabIndex = 11
NoFolders = 0 'False Top = 90
Transparent = 0 'False Width = 945
ViewID = "{0057D0E0-3573-11CF-AE69-08002B2E1262}"
Location = "http:///"
End End
Begin SHDocVwCtl.WebBrowser web Begin SHDocVwCtl.WebBrowser web
Height = 915 Height = 915
Index = 2 Index = 2
Left = 9750 Left = 9750
TabIndex = 26 TabIndex = 10
Top = 1350 Top = 1350
Width = 1155 Width = 1155
ExtentX = 2037 ExtentX = 2037
@ -80,143 +76,78 @@ Begin VB.Form Frm_Main
ViewID = "{0057D0E0-3573-11CF-AE69-08002B2E1262}" ViewID = "{0057D0E0-3573-11CF-AE69-08002B2E1262}"
Location = "http:///" Location = "http:///"
End End
Begin VB.CommandButton oa Begin SHDocVwCtl.WebBrowser web
Caption = "OA" Height = 915
Height = 300 Index = 1
Left = 16425 Left = 8580
TabIndex = 23 TabIndex = 2
Top = 60 Top = 1335
Width = 600 Width = 1155
End ExtentX = 2037
Begin VB.CommandButton alibaba ExtentY = 1614
Caption = "1688" ViewMode = 0
Height = 300 Offline = 0
Left = 16425 Silent = 0
TabIndex = 22 RegisterAsBrowser= 1
Top = 360 RegisterAsDropTarget= 1
Width = 600 AutoArrange = 0 'False
End NoClientEdge = 0 'False
Begin VB.CommandButton manager AlignLeft = 0 'False
Caption = "商品" NoWebView = 0 'False
Height = 300 HideFileNames = 0 'False
Left = 16425 SingleClick = 0 'False
TabIndex = 21 SingleSelection = 0 'False
Top = 660 NoFolders = 0 'False
Width = 600 Transparent = 0 'False
End ViewID = "{0057D0E0-3573-11CF-AE69-08002B2E1262}"
Begin VB.CommandButton pic Location = "http:///"
Caption = "图片"
Height = 300
Left = 16425
TabIndex = 20
Top = 960
Width = 600
End End
Begin VB.ListBox List1 Begin VB.ListBox List1
Height = 7620 Height = 7620
Left = 16830 Left = 16830
TabIndex = 18 TabIndex = 8
Top = 1695 Top = 1695
Width = 1035 Width = 1035
End End
Begin VB.ListBox List2 Begin VB.ListBox List2
Height = 780 Height = 780
Left = 45 Left = 45
TabIndex = 17 TabIndex = 7
Top = 9315 Top = 9315
Width = 17145 Width = 17145
End End
Begin VB.TextBox itempicurl
Height = 300
Index = 2
Left = 12810
TabIndex = 14
Top = 960
Width = 3600
End
Begin VB.TextBox itemname
Height = 300
Index = 2
Left = 9570
TabIndex = 13
Top = 960
Width = 2370
End
Begin VB.TextBox urlT Begin VB.TextBox urlT
Height = 270 Height = 270
Index = 2 Index = 2
Left = 8700 Left = 8700
TabIndex = 12 TabIndex = 6
Text = "2" Text = "2"
Top = 420 Top = 480
Width = 7710 Width = 7710
End End
Begin VB.TextBox urlT Begin VB.TextBox urlT
Height = 270 Height = 270
Index = 1 Index = 1
Left = 945 Left = 945
TabIndex = 10 TabIndex = 4
Text = "1" Text = "1"
Top = 420 Top = 480
Width = 7710 Width = 7710
End End
Begin VB.TextBox urlT Begin VB.TextBox urlT
Height = 270 Height = 270
Index = 0 Index = 0
Left = 945 Left = 945
TabIndex = 9 TabIndex = 3
Text = "Text1" Text = "Text1"
Top = 105 Top = 105
Width = 7710 Width = 7710
End End
Begin 导出商品首图.TzDownload dl
Height = 195
Index = 1
Left = 930
Top = 713
Width = 7710
_ExtentX = 13600
_ExtentY = 344
ForeColor = 33023
End
Begin VB.TextBox folder
Height = 300
Left = 9735
TabIndex = 6
Top = 90
Width = 6675
End
Begin VB.TextBox itemname
Height = 300
Index = 1
Left = 1815
TabIndex = 4
Top = 960
Width = 2370
End
Begin VB.TextBox itempicurl
Height = 300
Index = 1
Left = 5070
TabIndex = 2
Top = 960
Width = 3600
End
Begin 导出商品首图.TzDownload dl
Height = 195
Index = 2
Left = 8700
Top = 713
Width = 7710
_ExtentX = 13600
_ExtentY = 344
ForeColor = 33023
End
Begin SHDocVwCtl.WebBrowser web Begin SHDocVwCtl.WebBrowser web
Height = 7665 Height = 7665
Index = 0 Index = 0
Left = 45 Left = 45
TabIndex = 3 TabIndex = 1
Top = 1335 Top = 1335
Width = 8535 Width = 8535
ExtentX = 15055 ExtentX = 15055
@ -238,85 +169,22 @@ Begin VB.Form Frm_Main
ViewID = "{0057D0E0-3573-11CF-AE69-08002B2E1262}" ViewID = "{0057D0E0-3573-11CF-AE69-08002B2E1262}"
Location = "http:///" Location = "http:///"
End End
Begin VB.Label Label9
AutoSize = -1 'True
Caption = "首图信息:"
Height = 180
Left = 120
TabIndex = 25
Top = 1020
Width = 810
End
Begin VB.Label Label8
AutoSize = -1 'True
Caption = "下载状态:"
Height = 180
Left = 120
TabIndex = 24
Top = 720
Width = 810
End
Begin VB.Label pages Begin VB.Label pages
AutoSize = -1 'True AutoSize = -1 'True
Caption = "页数" Caption = "页数"
Height = 180 Height = 180
Left = 17310 Left = 13350
TabIndex = 19 TabIndex = 9
Top = 885 Top = 150
Width = 360 Width = 360
End End
Begin VB.Label Label7
AutoSize = -1 'True
Caption = "首图链接:"
Height = 180
Left = 11985
TabIndex = 16
Top = 1020
Width = 810
End
Begin VB.Label Label6
AutoSize = -1 'True
Caption = "商品名称:"
Height = 180
Left = 8760
TabIndex = 15
Top = 1020
Width = 810
End
Begin VB.Label Label5 Begin VB.Label Label5
AutoSize = -1 'True AutoSize = -1 'True
Caption = "网页链接:" Caption = "网页链接:"
Height = 180 Height = 180
Left = 120 Left = 120
TabIndex = 11
Top = 465
Width = 810
End
Begin VB.Label Label4
AutoSize = -1 'True
Caption = "文件夹名称:"
Height = 180
Left = 8700
TabIndex = 7
Top = 150
Width = 990
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "商品名称:"
Height = 180
Left = 990
TabIndex = 5 TabIndex = 5
Top = 1020 Top = 525
Width = 810
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "首图链接:"
Height = 180
Left = 4245
TabIndex = 1
Top = 1020
Width = 810 Width = 810
End End
Begin VB.Label Label1 Begin VB.Label Label1
@ -349,7 +217,7 @@ Private Sub Form_Resize()
On Error Resume Next On Error Resume Next
Dim lefthg Dim lefthg
web(0).Top = 1300 web(0).Top = 900
lefthg = Me.Height - web(0).Top lefthg = Me.Height - web(0).Top
web(0).Width = Me.Width - 50 web(0).Width = Me.Width - 50
@ -371,18 +239,7 @@ Private Sub Form_Resize()
' web(2).Top = web(0).Top + lefthg / 2 ' web(2).Top = web(0).Top + lefthg / 2
' web(2).Height = lefthg / 2 ' web(2).Height = lefthg / 2
' web(2).Left = 10 ' web(2).Left = 10
SName.Width = web(0).Width / 2
SName.Top = web(0).Top + lefthg / 2
SName.Height = lefthg / 3 * 2
SName.Left = 10
UName.Width = web(0).Width / 2
UName.Top = web(0).Top + lefthg / 2
UName.Height = lefthg / 3 * 2
UName.Left = 10 + SName.Width
List1.Left = Me.Width - List1.Width - 350 List1.Left = Me.Width - List1.Width - 350
List1.Height = lefthg - 350 List1.Height = lefthg - 350
List1.Top = web(0).Top List1.Top = web(0).Top
@ -392,39 +249,44 @@ Private Sub getfp(webb As WebBrowser)
On Error Resume Next On Error Resume Next
Dim i, J, vDoc Dim i, J, vDoc
Dim ix As Long Dim ix As Long
Dim itemname, itemurl
ix = webb.index ix = webb.index
Set vDoc = webb.Document Set vDoc = webb.Document
itemname(ix) = resetfilename(vDoc.getelementsbytagname("input")("subject").Value) itemname = resetfilename(vDoc.getelementsbytagname("input")("subject").Value)
ERR.Clear ERR.clear
itempicurl(ix) = vDoc.getelementsbytagname("input")("pictureUrl").Value itemurl = vDoc.getelementsbytagname("input")("pictureUrl").Value
If ERR <> 0 Then If ERR <> 0 Then
itempicurl(ix) = vDoc.getelementsbytagname("input")("pictureUrl")(0).Value itempicurl = vDoc.getelementsbytagname("input")("pictureUrl")(0).Value
End If End If
If folder = "" Then folder = InputBox("请输入 日期-首图-公司名称-阿里账号-提单人名称!", , Format(Now, "m.d") & "-首图-公司名称-阿里账号-提单人名称") If InStr(1, itemurl, "http") <> 0 And InStr(1, itemurl, "jpg") <> 0 And InStr(1, itemurl, ".com//") = 0 Then
If folder = "" Then folder = Format(Now, "m.d") & "-首图-公司名称-阿里账号-提单人名称" If Frm_Download.UName.AddItemNotSame(itemurl) Then
If Len(itemname(ix)) = 0 And Len(itempicurl(ix)) = 0 Then Exit Sub If Not (Frm_Download.SName.AddItemNotSame(resetfilename(Trim(itemname) & ".jpg"))) Then
For i = dl.LBound To dl.UBound Frm_Download.SName.AddItemNotSame resetfilename((Trim(itemname) & i) & ".jpg")
If dl(i).IsFree Then dl(i).FileDownload itempicurl(ix), App.Path & "\" & folder.Text & "\" & itemname(ix).Text & ".jpg": dl(i).Tag = False: Exit For End If
Next End If
itemname(ix) = "" End If
itempicurl(ix) = ""
End Sub End Sub
Private Function resetfilename(ByVal name As String) As String Private Function resetfilename(ByVal name As String) As String
name = Clear(name, "/") name = clear(name, "/")
name = Clear(name, "\") name = clear(name, "\")
name = Clear(name, "*") name = clear(name, "*")
name = Clear(name, "?") name = clear(name, "?")
name = Clear(name, "<") name = clear(name, "<")
name = Clear(name, ">") name = clear(name, ">")
resetfilename = name resetfilename = name
End Function End Function
Private Function Clear(name As String, p As String) As String Private Function clear(name As String, P As String) As String
Clear = Replace(name, p, "") clear = Replace(name, P, "")
End Function End Function
Private Sub Form_Unload(Cancel As Integer)
Unload Frm_Download
End Sub
Private Sub Label1_Click() Private Sub Label1_Click()
web(0).Visible = Not web(0).Visible web(0).Visible = Not web(0).Visible
showweb (0) showweb (0)
@ -449,7 +311,7 @@ Private Sub Label2_Click()
UCase(vTag_1.TagName) = "A" And _ UCase(vTag_1.TagName) = "A" And _
UCase(vTag1.TagName) = "DIV" And _ UCase(vTag1.TagName) = "DIV" And _
UCase(vTag2.TagName) = "DIV" Then UCase(vTag2.TagName) = "DIV" Then
If vTag.class = "next" Then vTag.Click If vTag.Class = "next" Then vTag.Click
End If End If
End Select End Select
Next Next
@ -464,6 +326,10 @@ Private Sub Label5_Click()
Next Next
End Sub End Sub
Private Sub lookitem_Click()
Frm_Download.Show
End Sub
Private Sub manager_Click() Private Sub manager_Click()
web(0).Navigate2 "http://offer.1688.com/offer/manage.htm?show_type=valid&tracelog=work_1_m_orderManage" web(0).Navigate2 "http://offer.1688.com/offer/manage.htm?show_type=valid&tracelog=work_1_m_orderManage"
End Sub End Sub
@ -508,15 +374,17 @@ End Sub
'End Sub 'End Sub
Private Sub web_DownloadComplete(index As Integer) Private Sub web_DownloadComplete(index As Integer)
Dim target, title, class Dim target, Title, Class
Dim itemurl As String
Dim itemname As String
web(index).Silent = True web(index).Silent = True
web(index).Tag = True web(index).Tag = True
urlT(index).Enabled = True urlT(index).Enabled = True
urlT(index).ForeColor = vbBlue urlT(index).ForeColor = vbBlue
Me.Caption = "Load Complete" Me.Caption = "Load Complete"
showweb (index) showweb (index)
List1.Clear List1.clear
List2.Clear List2.clear
Dim vDoc, vTag_2, vTag_1, vTag, vTag1, vTag2, vTXT Dim vDoc, vTag_2, vTag_1, vTag, vTag1, vTag2, vTXT
Dim i As Integer Dim i As Integer
Set vDoc = web(index).Document Set vDoc = web(index).Document
@ -532,59 +400,84 @@ Private Sub web_DownloadComplete(index As Integer)
Select Case UCase(vDoc.All(i).TagName) Select Case UCase(vDoc.All(i).TagName)
Case "TD" Case "TD"
Case "A" Case "A"
Dim st '商品列表批量获取信息
Dim en Dim st As Long
Dim en As Long
If UCase(vTag_2.TagName) = "INPUT" And _ If UCase(vTag_2.TagName) = "INPUT" And _
UCase(vTag_1.TagName) = "TD" And _ UCase(vTag_1.TagName) = "TD" And _
UCase(vTag1.TagName) = "IMG" And _ UCase(vTag1.TagName) = "IMG" And _
UCase(vTag2.TagName) = "TD" Then UCase(vTag2.TagName) = "TD" Then
If vTag.target = "_blank" Then st = InStr(1, vTag.innerhtml, "data-lazyload-src=""") + Len("data-lazyload-src=""") 'data-lazyload-src="http://
If SName.AddItemNotSame(vTag.title) Then st = InStr(st + 1, vTag.innerhtml, "/") + Len("/")
st = InStr(1, vTag.innerhtml, "data-lazyload-src=""") + Len("data-lazyload-src=""") en = InStr(st, vTag.innerhtml, "jpg") + 3
en = InStr(st, vTag.innerhtml, """") itemurl = Mid(vTag.innerhtml, st, en - st)
UName.AddItemNotSame Replace(Mid(vTag.innerhtml, st, en - st), ".64x64", "") itemurl = urlreset(itemurl)
'Debug.Print itemurl
If InStr(1, itemurl, "http") <> 0 And InStr(1, itemurl, "jpg") <> 0 And InStr(1, itemurl, ".com//") = 0 Then
If Frm_Download.UName.AddItemNotSame(itemurl) Then
If Not (Frm_Download.SName.AddItemNotSame(resetfilename(Trim(vTag.Title) & ".jpg"))) Then
Frm_Download.SName.AddItemNotSame resetfilename((Trim(vTag.Title) & i) & ".jpg")
End If
End If
End If
End If
Case "META"
'商品展示部分直接获取首图信息
If vTag.property = "og:image" And vTag1.property = "og:title" Then
itemurl = urlreset(vTag.content)
itemname = vTag1.content
If InStr(1, itemurl, "http") <> 0 And InStr(1, itemurl, "jpg") <> 0 And InStr(1, itemurl, ".com//") = 0 Then
If Frm_Download.UName.AddItemNotSame(itemurl) Then
If Not (Frm_Download.SName.AddItemNotSame(resetfilename(Trim(itemname) & ".jpg"))) Then
Frm_Download.SName.AddItemNotSame resetfilename((Trim(itemname) & i) & ".jpg")
End If
End If End If
End If End If
End If End If
' If UCase(vTag_2.TagName) = "DIV" And _
' UCase(vTag_1.TagName) = "DIV" And _
' UCase(vTag1.TagName) = "SPAN" And _
' UCase(vTag2.TagName) = "UL" Then
' If vTag.class = "btn-edit" And vTag.target = "_blank" And vTag.title = "修改" Then List2.AddItem vTag.href
' End If
Case "B"
'A SPAN　B B B
' If UCase(vTag_2.TagName) = "A" And _
' UCase(vTag_1.TagName) = "SPAN" And _
' UCase(vTag1.TagName) = "B" And _
' UCase(vTag2.TagName) = "B" Then
' Me.Caption = "当前的任务有" & vTag.innerhtml & "个!"
' End If
'http://192.168.0.8:83/app1/TaskLadingCn/List.aspx?k=&RearchType=0&UId=0&KfId=4986&MgId=0&mgbm=0&bumen=0&followup=&FState=0&tdtype=-1&FSpeed=0&FMgSpeed=0&FKfSpeed=1&attr=0&AttrBus=0&selDate=0&strDate=&endDate= ' <meta property="og:image" content="http://i00.c.aliimg.com/img/ibank/2015/897/991/2210199798_196219354.310x310.jpg"/>
'TD A IMG TD P '<meta property="og:title" content="12支铅笔塑料盒 20*22CM环保吸塑包装 多规格pvc吸塑泡壳加工"/>
Case "IMG"
If UCase(vTag_2.TagName) = "TD" And _ ' ' If UCase(vTag_2.TagName) = "DIV" And _
UCase(vTag_1.TagName) = "A" And _ ' ' UCase(vTag_1.TagName) = "DIV" And _
UCase(vTag1.TagName) = "TD" And _ ' ' UCase(vTag1.TagName) = "SPAN" And _
UCase(vTag2.TagName) = "p" Then ' ' UCase(vTag2.TagName) = "UL" Then
'List2.AddItem vTag_1.innerhtml ' ' If vTag.class = "btn-edit" And vTag.target = "_blank" And vTag.title = "修改" Then List2.AddItem vTag.href
Debug.Print vTag_1.innerhtml ' ' End If
Debug.Print vTag.src ' Case "B"
End If ' 'A SPAN　B B B
Case "EM" '
If UCase(vTag_2.TagName) = "A" And _ ' ' If UCase(vTag_2.TagName) = "A" And _
UCase(vTag_1.TagName) = "LI" And _ ' ' UCase(vTag_1.TagName) = "SPAN" And _
UCase(vTag1.TagName) = "INPUT" And _ ' ' UCase(vTag1.TagName) = "B" And _
UCase(vTag2.TagName) = "LI" Then ' ' UCase(vTag2.TagName) = "B" Then
pages = vTag.innerhtml ' ' Me.Caption = "当前的任务有" & vTag.innerhtml & "个!"
End If ' ' End If
'
' 'http://192.168.0.8:83/app1/TaskLadingCn/List.aspx?k=&RearchType=0&UId=0&KfId=4986&MgId=0&mgbm=0&bumen=0&followup=&FState=0&tdtype=-1&FSpeed=0&FMgSpeed=0&FKfSpeed=1&attr=0&AttrBus=0&selDate=0&strDate=&endDate=
' 'TD A IMG TD P
' Case "IMG"
' If UCase(vTag_2.TagName) = "TD" And _
' UCase(vTag_1.TagName) = "A" And _
' UCase(vTag1.TagName) = "TD" And _
' UCase(vTag2.TagName) = "p" Then
' 'List2.AddItem vTag_1.innerhtml
' Debug.Print vTag_1.innerhtml
' Debug.Print vTag.src
' End If
' Case "EM"
' If UCase(vTag_2.TagName) = "A" And _
' UCase(vTag_1.TagName) = "LI" And _
' UCase(vTag1.TagName) = "INPUT" And _
' UCase(vTag2.TagName) = "LI" Then
' pages = vTag.innerhtml
' End If
End Select End Select
Next Next
End Sub End Sub
Private Sub web_NewWindow2(index As Integer, ppDisp As Object, Cancel As Boolean) Private Sub web_NewWindow2(index As Integer, ppDisp As Object, Cancel As Boolean)
On Error Resume Next
Dim i Dim i
For i = 1 To web.UBound For i = 1 To web.UBound
If web(i).Tag Then Set ppDisp = web(i).Object: showweb (i): pages = "已加载...": Exit Sub If web(i).Tag Then Set ppDisp = web(i).Object: showweb (i): pages = "已加载...": Exit Sub
@ -593,6 +486,20 @@ Private Sub web_NewWindow2(index As Integer, ppDisp As Object, Cancel As Boolean
Cancel = True Cancel = True
End Sub End Sub
Public Function urlreset(ByVal url As String) As String
Dim st, en
'Debug.Print url
st = InStr(1, url, "http://") + Len("http://")
st = InStr(st + 1, url, "/") + Len("/")
en = InStr(st, url, "jpg") + 3
url = Mid(url, st, en - st)
url = Replace(url, ".310x310", "")
url = Replace(url, ".64x64", "")
url = "http://i01.c.aliimg.com/" & url
urlreset = url
'Debug.Print url
End Function
Private Sub showweb(index As Long) Private Sub showweb(index As Long)
Dim i As Long Dim i As Long
For i = 1 To web.UBound For i = 1 To web.UBound

2
首图导出工具.vbp
View File

@ -5,6 +5,8 @@ Reference=*\G{662901FC-6951-4854-9EB2-D9A2570F2B2E}#5.1#0#C:\Windows\system32\wi
Form=Frm_Main.frm Form=Frm_Main.frm
UserControl=..\VB用户控件\TzDownload.ctl UserControl=..\VB用户控件\TzDownload.ctl
UserControl=..\VB用户控件\TzListBox.ctl UserControl=..\VB用户控件\TzListBox.ctl
Form=Frm_Download.frm
UserControl=..\VB用户控件\TzProgressBar.ctl
Startup="Frm_Main" Startup="Frm_Main"
HelpFile="" HelpFile=""
ExeName32="首图导出工具.exe" ExeName32="首图导出工具.exe"