修复错误的图片导致死循环下载...

Signed-off-by: j502647092 <jtb1@163.com>

Frm_Download.frm

@@ -1,22 +1,14 @@
 VERSION 5.00
 Begin VB.Form Frm_Download 
    Caption         =   "首图下载"
-   ClientHeight    =   4800
+   ClientHeight    =   4845
    ClientLeft      =   60
    ClientTop       =   345
    ClientWidth     =   11565
    LinkTopic       =   "Form1"
-   ScaleHeight     =   4800
+   ScaleHeight     =   4845
    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
@@ -70,22 +62,50 @@ Begin VB.Form Frm_Download
       Width           =   1020
    End
    Begin 导出商品首图.TzListBox SName 
-      Height          =   1335
-      Left            =   -15
+      Height          =   4095
+      Left            =   0
       TabIndex        =   0
       Top             =   840
-      Width           =   3810
-      _ExtentX        =   6720
-      _ExtentY        =   2355
+      Width           =   6015
+      _ExtentX        =   10610
+      _ExtentY        =   7223
    End
    Begin 导出商品首图.TzListBox UName 
-      Height          =   1170
-      Left            =   0
+      Height          =   4020
+      Left            =   6015
       TabIndex        =   4
-      Top             =   2175
-      Width           =   3795
-      _ExtentX        =   6694
-      _ExtentY        =   2064
+      Top             =   840
+      Width           =   5505
+      _ExtentX        =   9710
+      _ExtentY        =   7091
+   End
+   Begin VB.CommandButton fl 
+      Caption         =   "文件夹"
+      Height          =   270
+      Left            =   0
+      TabIndex        =   5
+      Top             =   0
+      Width           =   1020
+   End
+   Begin VB.ListBox errnlist 
+      Height          =   420
+      ItemData        =   "Frm_Download.frx":0000
+      Left            =   3720
+      List            =   "Frm_Download.frx":0002
+      TabIndex        =   6
+      Top             =   2265
+      Visible         =   0   'False
+      Width           =   1215
+   End
+   Begin VB.ListBox errulist 
+      Height          =   420
+      ItemData        =   "Frm_Download.frx":0004
+      Left            =   8115
+      List            =   "Frm_Download.frx":0006
+      TabIndex        =   7
+      Top             =   2370
+      Visible         =   0   'False
+      Width           =   1215
    End
 End
 Attribute VB_Name = "Frm_Download"
@@ -107,27 +127,50 @@ Private Sub dl_OnFinished(ByVal Result As Boolean)
 End Sub
 
 Private Sub dlc_Click()
-    On Error Resume Next
+    'On Error Resume Next
     If UName.ListCount = 0 Then MsgBox ("请先检索商品链接!"): Exit Sub
-    Dim I
+
+    Dim I As Long
     Dim UseTime As Double
-    If folder = "" Then folder = InputBox("请输入 日期-首图-公司名称-阿里账号-提单人名称!", , Format(Now, "m.d") & "-首图-公司名称-阿里账号-提单人名称")
-    If folder = Format(Now, "m.d") & "-首图-公司名称-阿里账号-提单人名称" Then Exit Sub: MsgBox "未修改文件夹名称,已取消导出!"
+    
+    If folder = "" Or folder = Format(Now, "m.d") & "-首图-公司名称-阿里账号-提单人名称" Then folder = InputBox("请输入 日期-首图-公司名称-阿里账号-提单人名称!", , Format(Now, "m.d") & "-首图-公司名称-阿里账号-提单人名称")
+    If folder = Format(Now, "m.d") & "-首图-公司名称-阿里账号-提单人名称" Then MsgBox "未修改文件夹名称,已取消导出!": Exit Sub
     UseTime = timeGetTime
+    
     For I = 0 To UName.ListCount - 1
+        Dim failure
+        failure = 0
 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"
+        dl.FileDownload UName.List(I), App.Path & "\" & folder & "\" & Trim(SName.List(I))
         Do
             Sleep 50
         Loop Until dl.IsFree
-        If Not sd Then GoTo red
-        'Debug.Print Replace(Trim(SName.List(i)), " ", "")
+        If Not sd Then
+            failure = failure + 1
+            If failure > 2 Then
+                errnlist.AddItem SName.List(I)
+                errulist.AddItem UName.List(I)
+            Else
+                GoTo red
+            End If
+        End If
     Next
+    
     UseTime = Format((timeGetTime - UseTime) / 1000, "0.00")
-    pb.Change pb.BarMax, "下载完成 共下载" & pb.BarMax & "件产品首图 耗时" & UseTime & "秒!", &H80FF80
+    pb.Change pb.BarMax, "下载完成 共下载" & pb.BarMax & "件产品首图 耗时" & UseTime & "秒!" & IIf(errnlist.ListCount = 0, "", "下载失败 " & errnlist.ListCount & "张"), IIf(errnlist.ListCount = 0, &H80FF80, vbRed)
+    Sleep 200
+
+    If errnlist.ListCount > 0 Then
+        Frm_Err.ErrMsg = "下载期间发生错误导致以下图片下载失败!" & vbCrLf
+        For I = 0 To errnlist.ListCount
+            Frm_Err.ErrMsg = Frm_Err.ErrMsg & errnlist.List(I) & "  " & errulist.List(I) & vbCrLf
+        Next
+        Frm_Err.Show 1
+    End If
+
     Shell "explorer.exe /n,/select," & App.Path & "\" & folder & "\", vbNormalFocus
 End Sub
 
@@ -161,13 +204,13 @@ Private Sub Form_Resize()
     
     SName.Left = 5
     SName.Top = pb.Top + pb.Height + 50
-    SName.Height = Me.Height - 600
+    SName.Height = Me.Height - 1200
     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
+    UName.Top = SName.Top
+    UName.Height = SName.Height
+    UName.Width = SName.Width
 
     dlc.Top = dl.Top
     clear.Top = pb.Top

Frm_Err.frm

@@ -0,0 +1,32 @@
+VERSION 5.00
+Begin VB.Form Frm_Err 
+   Caption         =   "ÏÂÔØ´íÎóÊý¾Ý"
+   ClientHeight    =   2595
+   ClientLeft      =   60
+   ClientTop       =   345
+   ClientWidth     =   7380
+   LinkTopic       =   "Form1"
+   ScaleHeight     =   2595
+   ScaleWidth      =   7380
+   StartUpPosition =   3  '´°¿Úȱʡ
+   Begin VB.TextBox ErrMsg 
+      Height          =   3000
+      Left            =   0
+      MultiLine       =   -1  'True
+      ScrollBars      =   3  'Both
+      TabIndex        =   0
+      Top             =   0
+      Width           =   7500
+   End
+End
+Attribute VB_Name = "Frm_Err"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+Option Explicit
+
+Private Sub Form_Resize()
+    ErrMsg.Width = Me.Width
+    ErrMsg.Height = Me.Height
+End Sub

Frm_Index.frm

@@ -55,21 +55,21 @@ 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
+    If itemlist.ListCount > 0 And pb.BarValue = pb.BarMax Then getitem Else MsgBox "未获取到任何商品信息" & vbCrLf & "请确认用主浏览窗口打开旺铺首页!", vbCritical: Unload Me
 End Sub
 
 Private Sub getitem()
-    Dim I As Long
+    Dim i As Long
     pb.BarValue = 0
     pb.BarMax = itemlist.ListCount
-    For I = 0 To itemlist.ListCount - 1
+    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
+        pb.Change i, "已提取首图信息" & i & "/" & pb.BarMax
         
-        html = XmlHttp.GetData(itemlist.List(I), ResponseBodyToText)
+        html = XmlHttp.GetData(itemlist.List(i), ResponseBodyToText)
         
         If html = "" Then GoTo nii
         Dim st As Long
@@ -79,17 +79,19 @@ Private Sub getitem()
             en = InStr(st, html, """")
             itemurl = urlreset(Mid(html, st, en - st))
         End If
+        If itemurl = "" Then GoTo nii
         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")
+                Frm_Download.SName.AddItemNotSame resetfilename((Trim(itemname) & i) & ".jpg")
             End If
         End If
-        itemlist.ListIndex = I
+        itemlist.ListIndex = i
 nii:
     Next
     pb.Change pb.BarMax, "已提取首图信息" & pb.BarMax & "张,请到首图下载下载首图!"

Frm_Main.frm

@@ -10,13 +10,87 @@ Begin VB.Form Frm_Main
    ScaleHeight     =   9390
    ScaleWidth      =   19035
    StartUpPosition =   2  '屏幕中心
-   Begin VB.CommandButton getindex 
-      Caption         =   "首页商品"
+   Begin 导出商品首图.TzButton getindex 
       Height          =   300
-      Left            =   12735
-      TabIndex        =   15
+      Left            =   12165
+      Top             =   90
+      Width           =   1305
+      _ExtentX        =   2302
+      _ExtentY        =   529
+      Caption         =   "旺铺首页商品"
+      BackColor       =   16776960
+      StartColor      =   16776960
+      FinshColor      =   16777088
+      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
+         Name            =   "宋体"
+         Size            =   9
+         Charset         =   134
+         Weight          =   400
+         Underline       =   0   'False
+         Italic          =   0   'False
+         Strikethrough   =   0   'False
+      EndProperty
+   End
+   Begin 导出商品首图.TzButton lookitem 
+      Height          =   300
+      Left            =   11205
       Top             =   90
       Width           =   945
+      _ExtentX        =   1667
+      _ExtentY        =   529
+      Caption         =   "下载商品"
+      BackColor       =   65280
+      StartColor      =   65280
+      FinshColor      =   8454016
+      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
+         Name            =   "宋体"
+         Size            =   9
+         Charset         =   134
+         Weight          =   400
+         Underline       =   0   'False
+         Italic          =   0   'False
+         Strikethrough   =   0   'False
+      EndProperty
+   End
+   Begin VB.CommandButton pic 
+      Caption         =   "图片"
+      Height          =   300
+      Left            =   10455
+      TabIndex        =   13
+      Top             =   90
+      Width           =   600
+   End
+   Begin VB.CommandButton manager 
+      Caption         =   "商品"
+      Height          =   300
+      Left            =   9870
+      TabIndex        =   12
+      Top             =   90
+      Width           =   600
+   End
+   Begin VB.CommandButton alibaba 
+      Caption         =   "1688"
+      Height          =   300
+      Left            =   9285
+      TabIndex        =   11
+      Top             =   90
+      Width           =   600
+   End
+   Begin VB.CommandButton putpwd 
+      Caption         =   "填写密码"
+      Height          =   300
+      Left            =   14610
+      TabIndex        =   16
+      Top             =   90
+      Width           =   1000
+   End
+   Begin VB.CommandButton loginadmin 
+      Caption         =   "登录后台"
+      Height          =   300
+      Left            =   13620
+      TabIndex        =   15
+      Top             =   90
+      Width           =   1000
    End
    Begin 导出商品首图.Frm_Tols Frm 
       Height          =   240
@@ -27,45 +101,13 @@ Begin VB.Form Frm_Main
       _ExtentX        =   423
       _ExtentY        =   423
    End
-   Begin VB.CommandButton pic 
-      Caption         =   "图片"
-      Height          =   300
-      Left            =   10905
-      TabIndex        =   14
-      Top             =   90
-      Width           =   600
-   End
-   Begin VB.CommandButton manager 
-      Caption         =   "商品"
-      Height          =   300
-      Left            =   10170
-      TabIndex        =   13
-      Top             =   90
-      Width           =   600
-   End
-   Begin VB.CommandButton alibaba 
-      Caption         =   "1688"
-      Height          =   300
-      Left            =   9435
-      TabIndex        =   12
-      Top             =   90
-      Width           =   600
-   End
    Begin VB.CommandButton oa 
       Caption         =   "OA"
       Height          =   300
       Left            =   8700
-      TabIndex        =   11
-      Top             =   90
-      Width           =   600
-   End
-   Begin VB.CommandButton lookitem 
-      Caption         =   "查看商品"
-      Height          =   300
-      Left            =   11640
       TabIndex        =   10
       Top             =   90
-      Width           =   945
+      Width           =   600
    End
    Begin SHDocVwCtl.WebBrowser web 
       Height          =   915
@@ -179,11 +221,36 @@ Begin VB.Form Frm_Main
       ViewID          =   "{0057D0E0-3573-11CF-AE69-08002B2E1262}"
       Location        =   "http:///"
    End
+   Begin SHDocVwCtl.WebBrowser mm 
+      Height          =   945
+      Left            =   10950
+      TabIndex        =   14
+      Top             =   1320
+      Width           =   795
+      ExtentX         =   1402
+      ExtentY         =   1667
+      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.Label pages 
       AutoSize        =   -1  'True
       Caption         =   "页数"
       Height          =   180
-      Left            =   13920
+      Left            =   15930
       TabIndex        =   8
       Top             =   150
       Width           =   360
@@ -242,18 +309,18 @@ Private Sub Form_Resize()
     web(0).Width = Me.Width - 50
     web(0).Height = lefthg - 250
     web(0).Left = 10
-    Dim I As Long
-    For I = 1 To web.UBound
-        web(I).Width = Me.Width / 3 * 2 - 50
-        web(I).Top = web(0).Top + lefthg / 2
-        web(I).Height = lefthg / 2
-        web(I).Left = 10
+    Dim i As Long
+    For i = 1 To web.UBound
+        web(i).Width = Me.Width / 3 * 2 - 50
+        web(i).Top = web(0).Top + lefthg / 2
+        web(i).Height = lefthg / 2
+        web(i).Left = 10
     Next
 End Sub
 
 Private Sub getfp(webb As WebBrowser)
     On Error Resume Next
-    Dim I, J, vDoc
+    Dim i, J, vDoc
     Dim ix As Long
     Dim itemname, itemurl
     ix = webb.index
@@ -268,7 +335,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 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")
+                Frm_Download.SName.AddItemNotSame resetfilename((Trim(itemname) & i) & ".jpg")
             End If
         End If
     End If
@@ -309,20 +376,20 @@ Private Sub getindex_Click()
     Me.Caption = "Load Complete"
     showweb (0)
     Dim vDoc, vTag_2, vTag_1, vTag, vTag1, vTag2, vTXT
-    Dim I As Integer
+    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
+    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)
+        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"
             '商品列表批量获取信息
@@ -343,10 +410,10 @@ End Sub
 
 Private Sub Label5_Click()
     On Error Resume Next
-    Dim I As Long
-    For I = web.LBound To web.UBound
-        web(I).Stop
-        web(I).Tag = True
+    Dim i As Long
+    For i = web.LBound To web.UBound
+        web(i).Stop
+        web(i).Tag = True
     Next
 End Sub
 
@@ -369,6 +436,20 @@ Private Sub pic_Click()
     web(0).Navigate2 "http://picman.1688.com/album/album_list.htm?tracelog=work_1_m_albumManage"
 End Sub
 
+Private Sub putpwd_Click()
+    On Error GoTo tip
+    If username <> "" And password <> "" Then
+        Dim Doc
+        Set Doc = web(0).Document
+        Doc.getElementById("TPL_username_1").Value = username
+        Doc.getElementById("TPL_password_1").Type = "hidden"
+        Doc.getElementById("TPL_password_1").Value = password
+    End If
+    Exit Sub
+tip:
+    MsgBox "请在阿里页面执行此操作..."
+End Sub
+
 Private Sub urlT_DblClick(index As Integer)
     urlT(index).SelStart = 0
     urlT(index).SelLength = Len(urlT(index).Text)
@@ -380,7 +461,7 @@ End Sub
 
 Private Sub web_BeforeNavigate2(index As Integer, ByVal pDisp As Object, url As Variant, Flags As Variant, TargetFrameName As Variant, PostData As Variant, Headers As Variant, Cancel As Boolean)
     If url <> "http:///" And url <> "" And url <> "about:blank" Then urlT(index) = url
-    'List3.AddItem url
+    If InStr(1, url, "com/my") Then web(0).Navigate2 "http://work.1688.com/home/page/index.htm#nav/home"
 End Sub
 
 Private Sub web_DocumentComplete(index As Integer, ByVal pDisp As Object, url As Variant)
@@ -398,6 +479,69 @@ End Sub
 '    web(index).Silent = True
 'End Sub
 
+Private Sub loginadmin_Click()
+'On Error Resume Next
+    Dim jj
+    'If InStr(1, mm.LocationURL, "alilogin.aspx") Then
+    If uid <> "" And username <> "" Then
+        mm.Navigate "http://192.168.0.8:83/"
+        pages.Caption = "获取密码中..."
+        jj = MsgBox("公司名称: " & gsmc & vbCrLf & vbCrLf & "当前用户UID: " & uid & vbCrLf & "当前用户名称: " & username & vbCrLf _
+                  & "当前用户密码: 稍后获取..." & vbCrLf & vbCrLf & "是否继续登录?", vbExclamation + vbYesNo)
+        If jj = vbYes Then
+            Do Until Not mm.Busy
+                Sleep 10
+            Loop
+            mm.Navigate "javascript:document.getElementById('sixiAX').GetPW('" + uid + "','192.168.0.8:83')"
+            Do Until Not mm.Busy
+                Sleep 10
+            Loop
+            Sleep 500
+            password = mm.Document.body.innerhtml
+            If Len(username) > 0 And Len(password) > 0 Then
+                web(0).Navigate2 "http://login.1688.com/member/signout.htm"
+                Sleep 1000
+                Do Until Not mm.Busy
+                    Sleep 10
+                Loop
+                web(0).Navigate2 "https://login.taobao.com/member/login.jhtml?style=b2b&from=b2b&full_redirect=true"
+                Do Until Not web(0).Busy
+                    Sleep 10
+                Loop
+                Sleep 300
+                Dim Doc
+                Set Doc = web(0).Document
+                Doc.getElementById("TPL_username_1").Value = username
+                Doc.getElementById("TPL_password_1").Value = password
+                Sleep 100
+                Doc.getElementById("J_SubmitStatic").Click
+                Do Until Not web(0).Busy
+                    Sleep 10
+                Loop
+                Sleep 1000
+                Set Doc = web(0).Document
+                If InStr(1, Doc.body.innerhtml, "密码") Then
+                    MsgBox "请输入验证码!"
+                    Sleep 300
+                    Doc.getElementById("TPL_username_1").Value = username
+                    Doc.getElementById("TPL_password_1").Type = "hidden"
+                    Doc.getElementById("TPL_password_1").Value = password
+                    Exit Sub
+                End If
+                Sleep 1000
+                web(0).Navigate2 "http://work.1688.com/home/page/index.htm#nav/home"
+                Sleep 1000
+                If InStr(1, web(0), "com/member") Then web(0).Navigate2 "https://login.taobao.com/member/login.jhtml?style=b2b&from=b2b&full_redirect=true"
+                pages.Caption = "登录成功..."
+            Else
+                pages.Caption = "获取密码失败,请使用阿里助手登陆..."
+            End If
+        End If
+    Else
+        MsgBox "请先打开一次阿里助手!"
+    End If
+End Sub
+
 Private Sub web_DownloadComplete(index As Integer)
 'On Error Resume Next
     Dim target, Title, Class
@@ -410,9 +554,9 @@ Private Sub web_DownloadComplete(index As Integer)
     Me.Caption = "Load Complete"
     showweb (index)
     Dim vDoc, vTag_2, vTag_1, vTag, vTag1, vTag2, vTXT
-    Dim I As Integer
+    Dim i As Integer
     Set vDoc = web(index).Document
-    'On Error Resume Next
+    On Error Resume Next
     If InStr(1, web(index).LocationURL, "alilogin.aspx") Then
         uid = Mid(web(index).LocationURL, InStr(1, web(index).LocationURL, "?id=") + 4)
         username = vDoc.getelementsbytagname("input")("TPL_username").Value
@@ -421,14 +565,18 @@ Private Sub web_DownloadComplete(index As Integer)
     Dim alll As Long
     alll = vDoc.All.Length
     On Error GoTo 0
-    For I = 2 To alll - 1
+    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)
+        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)
+        If InStr(1, web(index).LocationURL, "alilogin.aspx") Then
+            uid = Mid(web(index).LocationURL, InStr(1, web(index).LocationURL, "?id=") + 4)
+            username = vDoc.getelementsbytagname("input")("TPL_username").Value
+        End If
+        Select Case UCase(vDoc.All(i).TagName)
         Case "TD"
         Case "A"
             '商品列表批量获取信息
@@ -447,8 +595,9 @@ Private Sub web_DownloadComplete(index As Integer)
                 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
+                        pages.Caption = "以扫描到 " & Frm_Download.UName.ListCount & " 件商品!"
                         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
@@ -461,7 +610,8 @@ 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 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")
+                            Frm_Download.SName.AddItemNotSame resetfilename((Trim(itemname) & i) & ".jpg")
+                            pages.Caption = "以扫描到 " & Frm_Download.UName.ListCount & " 件商品!"
                         End If
                     End If
                 End If
@@ -472,9 +622,9 @@ End Sub
 
 Private Sub web_NewWindow2(index As Integer, ppDisp As Object, Cancel As Boolean)
     On Error Resume Next
-    Dim I
-    For I = 1 To web.UBound
-        If web(I).Tag Then Set ppDisp = web(I).object: showweb (I): pages = "已加载...": Exit Sub
+    Dim i
+    For i = 1 To web.UBound
+        If web(i).Tag Then Set ppDisp = web(i).object: showweb (i): pages = "已加载...": Exit Sub
     Next
     pages = "未加载..."
     Cancel = True
@@ -490,14 +640,15 @@ Public Function urlreset(ByVal url As String) As String
     url = Replace(url, ".310x310", "")
     url = Replace(url, ".64x64", "")
     url = "http://i01.c.aliimg.com/" & url
+    If url = "http://i01.c.aliimg.com/" Then url = ""
     urlreset = url
     'Debug.Print url
 End Function
 
 Private Sub showweb(index As Long)
-    Dim I As Long
-    For I = 1 To web.UBound
-        web(I).Visible = False
+    Dim i As Long
+    For i = 1 To web.UBound
+        web(i).Visible = False
         List2.Visible = False
     Next
     web(index).Visible = True

首图导出工具.vbp

@@ -11,6 +11,8 @@ Module=MainBas; MainBas.bas
 UserControl=..\VB用户控件\Frm_Tols.ctl
 Form=Frm_Index.frm
 UserControl=..\VB用户控件\XmlHttp.ctl
+Form=Frm_Err.frm
+UserControl=..\VB用户控件\TzButton.ctl
 Startup="Frm_Main"
 HelpFile=""
 ExeName32="首图导出工具.exe"

首图导出工具.vbw

@@ -1,9 +1,11 @@
-Frm_Main = 1, 6, 1342, 663, , 44, 44, 1143, 418, C
-TzDownload = 0, 0, 0, 0, C, 0, 0, 984, 374, C
-TzListBox = 0, 0, 0, 0, C, 22, 22, 1006, 396, C
-Frm_Download = 362, 160, 1924, 817, , 72, 94, 1056, 468, C
+Frm_Main = 1, 6, 1532, 663, , 44, 44, 1405, 626, C
+TzDownload = 220, 220, 1649, 725, , 0, 0, 984, 374, C
+TzListBox = 44, 44, 1562, 489, , 22, 22, 1006, 396, C
+Frm_Download = 171, 26, 1733, 683, , 72, 94, 933, 618, C
 TzProgressBar = 66, 66, 1518, 635, , 44, 44, 1028, 418, C
 MainBas = 22, 22, 1363, 679, 
 Frm_Tols = 0, 0, 1341, 657, I, 132, 132, 1116, 506, C
-Frm_Index = 303, 221, 1644, 878, , 106, 189, 1447, 846, C
+Frm_Index = 154, 30, 1495, 687, , 106, 189, 1447, 846, C
 XmlHttp = 0, 0, 0, 0, C, 286, 286, 1627, 943, C
+Frm_Err = 198, 198, 1627, 703, C, 250, 205, 1679, 710, C
+TzButton = 0, 0, 0, 0, C, 220, 220, 1649, 725, C