1
0
mirror of https://e.coding.net/circlecloud/LoadFirstPic.git synced 2024-12-29 08:18:50 +00:00
LoadFirstPic/Frm_Download.frm
j502647092 73f013a62b 新增旺铺首页导出功能,细节优化...
Signed-off-by: j502647092 <jtb1@163.com>
2015-07-01 15:31:22 +08:00

187 lines
5.4 KiB
Plaintext

VERSION 5.00
Begin VB.Form Frm_Download
Caption = "首图下载"
ClientHeight = 4800
ClientLeft = 60
ClientTop = 345
ClientWidth = 11565
LinkTopic = "Form1"
ScaleHeight = 4800
ScaleWidth = 11565
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
Caption = "清空"
Height = 300
Left = 0
TabIndex = 2
Top = 540
Width = 1020
End
Begin 导出商品首图.TzProgressBar pb
Height = 255
Left = 1080
Top = 570
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 = 255
Left = 1065
Top = 300
Width = 10440
_ExtentX = 18415
_ExtentY = 450
ForeColor = 16777088
End
Begin VB.CommandButton dlc
Caption = "下载"
Height = 300
Left = 0
TabIndex = 1
Top = 255
Width = 1020
End
Begin 导出商品首图.TzListBox SName
Height = 1335
Left = -15
TabIndex = 0
Top = 840
Width = 3810
_ExtentX = 6720
_ExtentY = 2355
End
Begin 导出商品首图.TzListBox UName
Height = 1170
Left = 0
TabIndex = 4
Top = 2175
Width = 3795
_ExtentX = 6694
_ExtentY = 2064
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
Private sd As Boolean
Private Savetime As Double
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()
On Error Resume Next
If UName.ListCount = 0 Then MsgBox ("请先检索商品链接!"): Exit Sub
Dim I
Dim UseTime As Double
If folder = "" Then folder = InputBox("请输入 日期-首图-公司名称-阿里账号-提单人名称!", , Format(Now, "m.d") & "-首图-公司名称-阿里账号-提单人名称")
If folder = Format(Now, "m.d") & "-首图-公司名称-阿里账号-提单人名称" Then Exit Sub: MsgBox "未修改文件夹名称,已取消导出!"
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 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)
Me.Hide
Cancel = True
End Sub
'itempicurl (ix), App.Path & "\" & folder.Text & "\" & itemname(ix).Text & ".jpg"
Private Sub Form_Resize()
On Error Resume Next
folder.Left = dlc.Left + dlc.Width + 10
folder.Width = Me.Width - dl.Left - 20
folder.Top = 0
dl.Left = dlc.Left + dlc.Width + 10
dl.Width = Me.Width - dl.Left - 20
dl.Top = 300
pb.Left = dlc.Left + dlc.Width + 10
pb.Width = Me.Width - dl.Left - 20
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
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