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 "未获取到任何商品信息" & vbCrLf & "请确认用主浏览窗口打开旺铺首页!", 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
        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")
            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