mirror of
https://e.coding.net/circlecloud/LoadFirstPic.git
synced 2025-01-01 09:58:54 +00:00
新增旺铺首页导出功能,细节优化...
Signed-off-by: j502647092 <jtb1@163.com>
This commit is contained in:
parent
9874875b0e
commit
73f013a62b
105
Frm_Download.frm
105
Frm_Download.frm
@ -8,19 +8,34 @@ Begin VB.Form Frm_Download
|
|||||||
LinkTopic = "Form1"
|
LinkTopic = "Form1"
|
||||||
ScaleHeight = 4800
|
ScaleHeight = 4800
|
||||||
ScaleWidth = 11565
|
ScaleWidth = 11565
|
||||||
StartUpPosition = 3 '窗口缺省
|
StartUpPosition = 2 '屏幕中心
|
||||||
|
Begin VB.CommandButton fl
|
||||||
|
Caption = "文件夹"
|
||||||
|
Height = 270
|
||||||
|
Left = 0
|
||||||
|
TabIndex = 5
|
||||||
|
Top = 0
|
||||||
|
Width = 1020
|
||||||
|
End
|
||||||
|
Begin VB.TextBox folder
|
||||||
|
Height = 285
|
||||||
|
Left = 1065
|
||||||
|
TabIndex = 3
|
||||||
|
Top = 0
|
||||||
|
Width = 10455
|
||||||
|
End
|
||||||
Begin VB.CommandButton clear
|
Begin VB.CommandButton clear
|
||||||
Caption = "清空"
|
Caption = "清空"
|
||||||
Height = 300
|
Height = 300
|
||||||
Left = 0
|
Left = 0
|
||||||
TabIndex = 3
|
TabIndex = 2
|
||||||
Top = 285
|
Top = 540
|
||||||
Width = 1020
|
Width = 1020
|
||||||
End
|
End
|
||||||
Begin 导出商品首图.TzProgressBar pb
|
Begin 导出商品首图.TzProgressBar pb
|
||||||
Height = 255
|
Height = 255
|
||||||
Left = 1080
|
Left = 1080
|
||||||
Top = 330
|
Top = 570
|
||||||
Width = 10440
|
Width = 10440
|
||||||
_ExtentX = 18415
|
_ExtentX = 18415
|
||||||
_ExtentY = 450
|
_ExtentY = 450
|
||||||
@ -38,9 +53,9 @@ Begin VB.Form Frm_Download
|
|||||||
StartColor = 8438015
|
StartColor = 8438015
|
||||||
End
|
End
|
||||||
Begin 导出商品首图.TzDownload dl
|
Begin 导出商品首图.TzDownload dl
|
||||||
Height = 250
|
Height = 255
|
||||||
Left = 1065
|
Left = 1065
|
||||||
Top = 60
|
Top = 300
|
||||||
Width = 10440
|
Width = 10440
|
||||||
_ExtentX = 18415
|
_ExtentX = 18415
|
||||||
_ExtentY = 450
|
_ExtentY = 450
|
||||||
@ -50,28 +65,28 @@ Begin VB.Form Frm_Download
|
|||||||
Caption = "下载"
|
Caption = "下载"
|
||||||
Height = 300
|
Height = 300
|
||||||
Left = 0
|
Left = 0
|
||||||
TabIndex = 2
|
TabIndex = 1
|
||||||
Top = 0
|
Top = 255
|
||||||
Width = 1020
|
Width = 1020
|
||||||
End
|
End
|
||||||
Begin 导出商品首图.TzListBox UName
|
|
||||||
Height = 1170
|
|
||||||
Left = 0
|
|
||||||
TabIndex = 0
|
|
||||||
Top = 2055
|
|
||||||
Width = 3795
|
|
||||||
_ExtentX = 6694
|
|
||||||
_ExtentY = 2064
|
|
||||||
End
|
|
||||||
Begin 导出商品首图.TzListBox SName
|
Begin 导出商品首图.TzListBox SName
|
||||||
Height = 1335
|
Height = 1335
|
||||||
Left = -15
|
Left = -15
|
||||||
TabIndex = 1
|
TabIndex = 0
|
||||||
Top = 720
|
Top = 840
|
||||||
Width = 3810
|
Width = 3810
|
||||||
_ExtentX = 6720
|
_ExtentX = 6720
|
||||||
_ExtentY = 2355
|
_ExtentY = 2355
|
||||||
End
|
End
|
||||||
|
Begin 导出商品首图.TzListBox UName
|
||||||
|
Height = 1170
|
||||||
|
Left = 0
|
||||||
|
TabIndex = 4
|
||||||
|
Top = 2175
|
||||||
|
Width = 3795
|
||||||
|
_ExtentX = 6694
|
||||||
|
_ExtentY = 2064
|
||||||
|
End
|
||||||
End
|
End
|
||||||
Attribute VB_Name = "Frm_Download"
|
Attribute VB_Name = "Frm_Download"
|
||||||
Attribute VB_GlobalNameSpace = False
|
Attribute VB_GlobalNameSpace = False
|
||||||
@ -93,18 +108,18 @@ End Sub
|
|||||||
|
|
||||||
Private Sub dlc_Click()
|
Private Sub dlc_Click()
|
||||||
On Error Resume Next
|
On Error Resume Next
|
||||||
Dim i
|
If UName.ListCount = 0 Then MsgBox ("请先检索商品链接!"): Exit Sub
|
||||||
Dim folder As String
|
Dim I
|
||||||
Dim UseTime As Double
|
Dim UseTime As Double
|
||||||
If folder = "" Then folder = InputBox("请输入 日期-首图-公司名称-阿里账号-提单人名称!", , Format(Now, "m.d") & "-首图-公司名称-阿里账号-提单人名称")
|
If folder = "" Then folder = InputBox("请输入 日期-首图-公司名称-阿里账号-提单人名称!", , Format(Now, "m.d") & "-首图-公司名称-阿里账号-提单人名称")
|
||||||
If folder = "" Then folder = Format(Now, "m.d") & "-首图-公司名称-阿里账号-提单人名称"
|
If folder = Format(Now, "m.d") & "-首图-公司名称-阿里账号-提单人名称" Then Exit Sub: MsgBox "未修改文件夹名称,已取消导出!"
|
||||||
UseTime = timeGetTime
|
UseTime = timeGetTime
|
||||||
For i = 0 To UName.ListCount - 1
|
For I = 0 To UName.ListCount - 1
|
||||||
red:
|
red:
|
||||||
pb.Change i, "下载中 进度: " & i & "/" & pb.BarMax
|
pb.Change I, "下载中 进度: " & I & "/" & pb.BarMax
|
||||||
UName.ListIndex = i
|
UName.ListIndex = I
|
||||||
SName.ListIndex = i
|
SName.ListIndex = I
|
||||||
dl.FileDownload UName.List(i), App.Path & "\" & folder & "\" & Trim(SName.List(i)) ' & ".jpg"
|
dl.FileDownload UName.List(I), App.Path & "\" & folder & "\" & Trim(SName.List(I)) ' & ".jpg"
|
||||||
Do
|
Do
|
||||||
Sleep 50
|
Sleep 50
|
||||||
Loop Until dl.IsFree
|
Loop Until dl.IsFree
|
||||||
@ -115,6 +130,14 @@ red:
|
|||||||
pb.Change pb.BarMax, "下载完成 共下载" & pb.BarMax & "件产品首图 耗时" & UseTime & "秒!", &H80FF80
|
pb.Change pb.BarMax, "下载完成 共下载" & pb.BarMax & "件产品首图 耗时" & UseTime & "秒!", &H80FF80
|
||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
|
Private Sub fl_Click()
|
||||||
|
Shell "explorer.exe /n,/select," & App.Path & "\" & folder & "\", vbNormalFocus
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Private Sub Form_Load()
|
||||||
|
If folder = "" Then folder = Format(Now, "m.d") & "-首图-公司名称-阿里账号-提单人名称"
|
||||||
|
End Sub
|
||||||
|
|
||||||
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
|
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
|
||||||
Me.Hide
|
Me.Hide
|
||||||
Cancel = True
|
Cancel = True
|
||||||
@ -123,24 +146,30 @@ End Sub
|
|||||||
'itempicurl (ix), App.Path & "\" & folder.Text & "\" & itemname(ix).Text & ".jpg"
|
'itempicurl (ix), App.Path & "\" & folder.Text & "\" & itemname(ix).Text & ".jpg"
|
||||||
Private Sub Form_Resize()
|
Private Sub Form_Resize()
|
||||||
On Error Resume Next
|
On Error Resume Next
|
||||||
|
folder.Left = dlc.Left + dlc.Width + 10
|
||||||
SName.Left = 5
|
folder.Width = Me.Width - dl.Left - 20
|
||||||
SName.Top = 600
|
folder.Top = 0
|
||||||
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.Left = dlc.Left + dlc.Width + 10
|
||||||
dl.Width = Me.Width - dl.Left - 20
|
dl.Width = Me.Width - dl.Left - 20
|
||||||
dl.Top = 25
|
dl.Top = 300
|
||||||
|
|
||||||
pb.Left = dlc.Left + dlc.Width + 10
|
pb.Left = dlc.Left + dlc.Width + 10
|
||||||
pb.Width = Me.Width - dl.Left - 20
|
pb.Width = Me.Width - dl.Left - 20
|
||||||
pb.Top = dl.Top + dl.Height + 50
|
pb.Top = dl.Top + dl.Height + 50
|
||||||
|
|
||||||
|
SName.Left = 5
|
||||||
|
SName.Top = pb.Top + pb.Height + 50
|
||||||
|
SName.Height = Me.Height - 600
|
||||||
|
SName.Width = Me.Width / 2 - 10
|
||||||
|
|
||||||
|
UName.Left = Me.Width / 2 + 10
|
||||||
|
UName.Top = pb.Top + pb.Height + 50
|
||||||
|
UName.Height = Me.Height - 600
|
||||||
|
UName.Width = Me.Width / 2 - 10
|
||||||
|
|
||||||
|
dlc.Top = dl.Top
|
||||||
|
clear.Top = pb.Top
|
||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
Private Sub SName_dblClick()
|
Private Sub SName_dblClick()
|
||||||
|
130
Frm_Index.frm
Normal file
130
Frm_Index.frm
Normal file
@ -0,0 +1,130 @@
|
|||||||
|
VERSION 5.00
|
||||||
|
Begin VB.Form Frm_Index
|
||||||
|
Caption = "旺铺首页首图获取"
|
||||||
|
ClientHeight = 3285
|
||||||
|
ClientLeft = 60
|
||||||
|
ClientTop = 345
|
||||||
|
ClientWidth = 4680
|
||||||
|
LinkTopic = "Form1"
|
||||||
|
ScaleHeight = 3285
|
||||||
|
ScaleWidth = 4680
|
||||||
|
StartUpPosition = 2 '屏幕中心
|
||||||
|
Begin 导出商品首图.TzListBox itemlist
|
||||||
|
Height = 3165
|
||||||
|
Left = -15
|
||||||
|
TabIndex = 0
|
||||||
|
Top = 255
|
||||||
|
Width = 4710
|
||||||
|
_ExtentX = 8308
|
||||||
|
_ExtentY = 5583
|
||||||
|
End
|
||||||
|
Begin 导出商品首图.TzProgressBar pb
|
||||||
|
Height = 255
|
||||||
|
Left = 15
|
||||||
|
Top = 0
|
||||||
|
Width = 4665
|
||||||
|
_ExtentX = 8229
|
||||||
|
_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
|
||||||
|
BackColor = 16777088
|
||||||
|
StartColor = 16777088
|
||||||
|
End
|
||||||
|
Begin 导出商品首图.XmlHttp XmlHttp
|
||||||
|
Height = 240
|
||||||
|
Left = 1545
|
||||||
|
Top = 105
|
||||||
|
Visible = 0 'False
|
||||||
|
Width = 240
|
||||||
|
_ExtentX = 423
|
||||||
|
_ExtentY = 423
|
||||||
|
End
|
||||||
|
End
|
||||||
|
Attribute VB_Name = "Frm_Index"
|
||||||
|
Attribute VB_GlobalNameSpace = False
|
||||||
|
Attribute VB_Creatable = False
|
||||||
|
Attribute VB_PredeclaredId = True
|
||||||
|
Attribute VB_Exposed = False
|
||||||
|
Option Explicit
|
||||||
|
|
||||||
|
Private Sub Form_Activate()
|
||||||
|
If itemlist.ListCount > 0 And pb.BarValue = pb.BarMax Then getitem Else MsgBox "未获取到任何商品信息,请确认用主浏览窗口打开!", vbCritical: Unload Me
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Private Sub getitem()
|
||||||
|
Dim I As Long
|
||||||
|
pb.BarValue = 0
|
||||||
|
pb.BarMax = itemlist.ListCount
|
||||||
|
For I = 0 To itemlist.ListCount - 1
|
||||||
|
Dim html As String
|
||||||
|
Dim itemurl As String
|
||||||
|
Dim itemname As String
|
||||||
|
|
||||||
|
pb.Change I, "已提取首图信息" & I & "/" & pb.BarMax
|
||||||
|
|
||||||
|
html = XmlHttp.GetData(itemlist.List(I), ResponseBodyToText)
|
||||||
|
|
||||||
|
If html = "" Then GoTo nii
|
||||||
|
Dim st As Long
|
||||||
|
Dim en As Long
|
||||||
|
st = InStr(1, html, "image"" content=""") + Len("image"" content=""")
|
||||||
|
If st <> 0 Then
|
||||||
|
en = InStr(st, html, """")
|
||||||
|
itemurl = urlreset(Mid(html, st, en - st))
|
||||||
|
End If
|
||||||
|
st = InStr(en, html, "title"" content=""") + Len("title"" content=""")
|
||||||
|
If st <> 0 Then
|
||||||
|
en = InStr(st, html, """")
|
||||||
|
itemname = Mid(html, st, en - st)
|
||||||
|
End If
|
||||||
|
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
|
||||||
|
itemlist.ListIndex = I
|
||||||
|
nii:
|
||||||
|
Next
|
||||||
|
pb.Change pb.BarMax, "已提取首图信息" & pb.BarMax & "张,请到首图下载下载首图!"
|
||||||
|
Frm_Download.Show
|
||||||
|
MsgBox "已提取首图信息" & pb.BarMax & "张,请到首图下载下载首图!"
|
||||||
|
Unload Me
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Private Function resetfilename(ByVal name As String) As String
|
||||||
|
On Error Resume Next
|
||||||
|
name = pclear(name, "/")
|
||||||
|
name = pclear(name, "\")
|
||||||
|
name = pclear(name, "*")
|
||||||
|
name = pclear(name, "?")
|
||||||
|
name = pclear(name, "<")
|
||||||
|
name = pclear(name, ">")
|
||||||
|
name = pclear(name, ":")
|
||||||
|
resetfilename = name
|
||||||
|
End Function
|
||||||
|
|
||||||
|
Private Function pclear(name As String, P As String) As String
|
||||||
|
pclear = Replace(name, P, "")
|
||||||
|
End Function
|
||||||
|
|
||||||
|
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 = Replace(url, ".32x32", "")
|
||||||
|
url = "http://i01.c.aliimg.com/" & url
|
||||||
|
urlreset = url
|
||||||
|
'Debug.Print url
|
||||||
|
End Function
|
112
Frm_Main.frm
112
Frm_Main.frm
@ -9,7 +9,15 @@ Begin VB.Form Frm_Main
|
|||||||
LinkTopic = "Form1"
|
LinkTopic = "Form1"
|
||||||
ScaleHeight = 9390
|
ScaleHeight = 9390
|
||||||
ScaleWidth = 19035
|
ScaleWidth = 19035
|
||||||
StartUpPosition = 3 '´°¿Úȱʡ
|
StartUpPosition = 2 '屏幕中心
|
||||||
|
Begin VB.CommandButton getindex
|
||||||
|
Caption = "首页商品"
|
||||||
|
Height = 300
|
||||||
|
Left = 12735
|
||||||
|
TabIndex = 15
|
||||||
|
Top = 90
|
||||||
|
Width = 945
|
||||||
|
End
|
||||||
Begin 导出商品首图.Frm_Tols Frm
|
Begin 导出商品首图.Frm_Tols Frm
|
||||||
Height = 240
|
Height = 240
|
||||||
Left = 9390
|
Left = 9390
|
||||||
@ -175,7 +183,7 @@ Begin VB.Form Frm_Main
|
|||||||
AutoSize = -1 'True
|
AutoSize = -1 'True
|
||||||
Caption = "页数"
|
Caption = "页数"
|
||||||
Height = 180
|
Height = 180
|
||||||
Left = 12720
|
Left = 13920
|
||||||
TabIndex = 8
|
TabIndex = 8
|
||||||
Top = 150
|
Top = 150
|
||||||
Width = 360
|
Width = 360
|
||||||
@ -206,7 +214,7 @@ Attribute VB_PredeclaredId = True
|
|||||||
Attribute VB_Exposed = False
|
Attribute VB_Exposed = False
|
||||||
Option Explicit
|
Option Explicit
|
||||||
Private Savetime As Double
|
Private Savetime As Double
|
||||||
Dim strUrl As String
|
Dim strURL As String
|
||||||
Dim uid As String
|
Dim uid As String
|
||||||
Dim username As String
|
Dim username As String
|
||||||
Dim password As String
|
Dim password As String
|
||||||
@ -234,18 +242,18 @@ Private Sub Form_Resize()
|
|||||||
web(0).Width = Me.Width - 50
|
web(0).Width = Me.Width - 50
|
||||||
web(0).Height = lefthg - 250
|
web(0).Height = lefthg - 250
|
||||||
web(0).Left = 10
|
web(0).Left = 10
|
||||||
Dim i As Long
|
Dim I As Long
|
||||||
For i = 1 To web.UBound
|
For I = 1 To web.UBound
|
||||||
web(i).Width = Me.Width / 3 * 2 - 50
|
web(I).Width = Me.Width / 3 * 2 - 50
|
||||||
web(i).Top = web(0).Top + lefthg / 2
|
web(I).Top = web(0).Top + lefthg / 2
|
||||||
web(i).Height = lefthg / 2
|
web(I).Height = lefthg / 2
|
||||||
web(i).Left = 10
|
web(I).Left = 10
|
||||||
Next
|
Next
|
||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
Private Sub getfp(webb As WebBrowser)
|
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
|
Dim itemname, itemurl
|
||||||
ix = webb.index
|
ix = webb.index
|
||||||
@ -260,7 +268,7 @@ Private Sub getfp(webb As WebBrowser)
|
|||||||
If InStr(1, itemurl, "http") <> 0 And InStr(1, itemurl, "jpg") <> 0 And InStr(1, itemurl, ".com//") = 0 Then
|
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 Frm_Download.UName.AddItemNotSame(itemurl) Then
|
||||||
If Not (Frm_Download.SName.AddItemNotSame(resetfilename(Trim(itemname) & ".jpg"))) Then
|
If Not (Frm_Download.SName.AddItemNotSame(resetfilename(Trim(itemname) & ".jpg"))) Then
|
||||||
Frm_Download.SName.AddItemNotSame resetfilename((Trim(itemname) & i) & ".jpg")
|
Frm_Download.SName.AddItemNotSame resetfilename((Trim(itemname) & I) & ".jpg")
|
||||||
End If
|
End If
|
||||||
End If
|
End If
|
||||||
End If
|
End If
|
||||||
@ -288,6 +296,46 @@ Private Sub Form_Unload(Cancel As Integer)
|
|||||||
End
|
End
|
||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
|
Private Sub getindex_Click()
|
||||||
|
'detail.1688.com/offer/
|
||||||
|
'On Error Resume Next
|
||||||
|
Dim target, Title, Class
|
||||||
|
Dim itemurl As String
|
||||||
|
Dim itemname As String
|
||||||
|
web(0).Silent = True
|
||||||
|
web(0).Tag = True
|
||||||
|
urlT(0).Enabled = True
|
||||||
|
urlT(0).ForeColor = vbBlue
|
||||||
|
Me.Caption = "Load Complete"
|
||||||
|
showweb (0)
|
||||||
|
Dim vDoc, vTag_2, vTag_1, vTag, vTag1, vTag2, vTXT
|
||||||
|
Dim I As Integer
|
||||||
|
Set vDoc = web(0).Document
|
||||||
|
On Error Resume Next
|
||||||
|
Dim alll As Long
|
||||||
|
alll = vDoc.All.Length
|
||||||
|
On Error GoTo 0
|
||||||
|
For I = 2 To alll - 1
|
||||||
|
On Error Resume Next
|
||||||
|
Set vTag_2 = vDoc.All(I - 2)
|
||||||
|
Set vTag_1 = vDoc.All(I - 1)
|
||||||
|
Set vTag = vDoc.All(I)
|
||||||
|
Set vTag1 = vDoc.All(I + 1)
|
||||||
|
Set vTag2 = vDoc.All(I + 2)
|
||||||
|
Select Case UCase(vDoc.All(I).TagName)
|
||||||
|
Case "TD"
|
||||||
|
Case "A"
|
||||||
|
'商品列表批量获取信息
|
||||||
|
Dim a As String
|
||||||
|
a = vTag.href
|
||||||
|
If InStr(1, a, "detail.1688.com/offer/") > 0 Then
|
||||||
|
Frm_Index.itemlist.AddItemNotSame a
|
||||||
|
End If
|
||||||
|
End Select
|
||||||
|
Next
|
||||||
|
Frm_Index.Show
|
||||||
|
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)
|
||||||
@ -295,10 +343,10 @@ End Sub
|
|||||||
|
|
||||||
Private Sub Label5_Click()
|
Private Sub Label5_Click()
|
||||||
On Error Resume Next
|
On Error Resume Next
|
||||||
Dim i As Long
|
Dim I As Long
|
||||||
For i = web.LBound To web.UBound
|
For I = web.LBound To web.UBound
|
||||||
web(i).Stop
|
web(I).Stop
|
||||||
web(i).Tag = True
|
web(I).Tag = True
|
||||||
Next
|
Next
|
||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
@ -362,7 +410,7 @@ Private Sub web_DownloadComplete(index As Integer)
|
|||||||
Me.Caption = "Load Complete"
|
Me.Caption = "Load Complete"
|
||||||
showweb (index)
|
showweb (index)
|
||||||
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
|
||||||
'On Error Resume Next
|
'On Error Resume Next
|
||||||
If InStr(1, web(index).LocationURL, "alilogin.aspx") Then
|
If InStr(1, web(index).LocationURL, "alilogin.aspx") Then
|
||||||
@ -371,16 +419,16 @@ Private Sub web_DownloadComplete(index As Integer)
|
|||||||
End If
|
End If
|
||||||
On Error Resume Next
|
On Error Resume Next
|
||||||
Dim alll As Long
|
Dim alll As Long
|
||||||
alll = vDoc.All.length
|
alll = vDoc.All.Length
|
||||||
On Error GoTo 0
|
On Error GoTo 0
|
||||||
For i = 2 To alll - 1
|
For I = 2 To alll - 1
|
||||||
On Error Resume Next
|
On Error Resume Next
|
||||||
Set vTag_2 = vDoc.All(i - 2)
|
Set vTag_2 = vDoc.All(I - 2)
|
||||||
Set vTag_1 = vDoc.All(i - 1)
|
Set vTag_1 = vDoc.All(I - 1)
|
||||||
Set vTag = vDoc.All(i)
|
Set vTag = vDoc.All(I)
|
||||||
Set vTag1 = vDoc.All(i + 1)
|
Set vTag1 = vDoc.All(I + 1)
|
||||||
Set vTag2 = vDoc.All(i + 2)
|
Set vTag2 = vDoc.All(I + 2)
|
||||||
Select Case UCase(vDoc.All(i).TagName)
|
Select Case UCase(vDoc.All(I).TagName)
|
||||||
Case "TD"
|
Case "TD"
|
||||||
Case "A"
|
Case "A"
|
||||||
'商品列表批量获取信息
|
'商品列表批量获取信息
|
||||||
@ -400,7 +448,7 @@ Private Sub web_DownloadComplete(index As Integer)
|
|||||||
If InStr(1, itemurl, "http") <> 0 And InStr(1, itemurl, "jpg") <> 0 And InStr(1, itemurl, ".com//") = 0 Then
|
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 Frm_Download.UName.AddItemNotSame(itemurl) Then
|
||||||
If Not (Frm_Download.SName.AddItemNotSame(resetfilename(Trim(vTag.Title) & ".jpg"))) Then
|
If Not (Frm_Download.SName.AddItemNotSame(resetfilename(Trim(vTag.Title) & ".jpg"))) Then
|
||||||
Frm_Download.SName.AddItemNotSame resetfilename((Trim(vTag.Title) & i) & ".jpg")
|
Frm_Download.SName.AddItemNotSame resetfilename((Trim(vTag.Title) & I) & ".jpg")
|
||||||
End If
|
End If
|
||||||
End If
|
End If
|
||||||
End If
|
End If
|
||||||
@ -413,7 +461,7 @@ Private Sub web_DownloadComplete(index As Integer)
|
|||||||
If InStr(1, itemurl, "http") <> 0 And InStr(1, itemurl, "jpg") <> 0 And InStr(1, itemurl, ".com//") = 0 Then
|
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 Frm_Download.UName.AddItemNotSame(itemurl) Then
|
||||||
If Not (Frm_Download.SName.AddItemNotSame(resetfilename(Trim(itemname) & ".jpg"))) Then
|
If Not (Frm_Download.SName.AddItemNotSame(resetfilename(Trim(itemname) & ".jpg"))) Then
|
||||||
Frm_Download.SName.AddItemNotSame resetfilename((Trim(itemname) & i) & ".jpg")
|
Frm_Download.SName.AddItemNotSame resetfilename((Trim(itemname) & I) & ".jpg")
|
||||||
End If
|
End If
|
||||||
End If
|
End If
|
||||||
End If
|
End If
|
||||||
@ -424,9 +472,9 @@ 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
|
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
|
||||||
Next
|
Next
|
||||||
pages = "未加载..."
|
pages = "未加载..."
|
||||||
Cancel = True
|
Cancel = True
|
||||||
@ -447,9 +495,9 @@ Public Function urlreset(ByVal url As String) As String
|
|||||||
End Function
|
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
|
||||||
web(i).Visible = False
|
web(I).Visible = False
|
||||||
List2.Visible = False
|
List2.Visible = False
|
||||||
Next
|
Next
|
||||||
web(index).Visible = True
|
web(index).Visible = True
|
||||||
|
@ -1,5 +1,5 @@
|
|||||||
Type=Exe
|
Type=Exe
|
||||||
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\Windows\SysWow64\stdole2.tlb#OLE Automation
|
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\Windows\SysWOW64\stdole2.tlb#OLE Automation
|
||||||
Object={EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}#1.1#0; ieframe.dll
|
Object={EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}#1.1#0; ieframe.dll
|
||||||
Reference=*\G{662901FC-6951-4854-9EB2-D9A2570F2B2E}#5.1#0#C:\Windows\system32\winhttp.dll#Microsoft WinHTTP Services, version 5.1
|
Reference=*\G{662901FC-6951-4854-9EB2-D9A2570F2B2E}#5.1#0#C:\Windows\system32\winhttp.dll#Microsoft WinHTTP Services, version 5.1
|
||||||
Form=Frm_Main.frm
|
Form=Frm_Main.frm
|
||||||
@ -9,6 +9,8 @@ Form=Frm_Download.frm
|
|||||||
UserControl=..\VB用户控件\TzProgressBar.ctl
|
UserControl=..\VB用户控件\TzProgressBar.ctl
|
||||||
Module=MainBas; MainBas.bas
|
Module=MainBas; MainBas.bas
|
||||||
UserControl=..\VB用户控件\Frm_Tols.ctl
|
UserControl=..\VB用户控件\Frm_Tols.ctl
|
||||||
|
Form=Frm_Index.frm
|
||||||
|
UserControl=..\VB用户控件\XmlHttp.ctl
|
||||||
Startup="Frm_Main"
|
Startup="Frm_Main"
|
||||||
HelpFile=""
|
HelpFile=""
|
||||||
ExeName32="首图导出工具.exe"
|
ExeName32="首图导出工具.exe"
|
||||||
|
10
首图导出工具.vbw
10
首图导出工具.vbw
@ -1,7 +1,9 @@
|
|||||||
Frm_Main = 22, 22, 1006, 396, , 44, 44, 1143, 418, C
|
Frm_Main = 1, 6, 1342, 663, , 44, 44, 1143, 418, C
|
||||||
TzDownload = 0, 0, 0, 0, C, 0, 0, 984, 374, C
|
TzDownload = 0, 0, 0, 0, C, 0, 0, 984, 374, C
|
||||||
TzListBox = 0, 0, 0, 0, C, 22, 22, 1006, 396, C
|
TzListBox = 0, 0, 0, 0, C, 22, 22, 1006, 396, C
|
||||||
Frm_Download = 0, 0, 984, 374, , 110, 110, 1094, 484, C
|
Frm_Download = 511, 160, 1924, 817, , 72, 94, 1056, 468, C
|
||||||
TzProgressBar = 0, 0, 0, 0, C, 44, 44, 1028, 418, C
|
TzProgressBar = 0, 0, 0, 0, C, 44, 44, 1028, 418, C
|
||||||
MainBas = 88, 88, 1139, 462,
|
MainBas = 22, 22, 1363, 679,
|
||||||
Frm_Tols = 66, 66, 1050, 440, , 132, 132, 1116, 506, C
|
Frm_Tols = 0, 0, 1341, 657, I, 132, 132, 1116, 506, C
|
||||||
|
Frm_Index = 572, 229, 1913, 886, , 106, 189, 1447, 846, C
|
||||||
|
XmlHttp = 0, 0, 0, 0, C, 0, 0, 0, 0, C
|
||||||
|
Loading…
Reference in New Issue
Block a user