LoadFirstPic/Frm_Index.frm

VERSION 5.00
Begin VB.Form Frm_Index 
   Caption         =   "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ҳ<EFBFBD><D2B3>ͼ<EFBFBD><CDBC>ȡ"
   ClientHeight    =   3285
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3285
   ScaleWidth      =   4680
   StartUpPosition =   2  '<27><>Ļ<EFBFBD><C4BB><EFBFBD><EFBFBD>
   Begin <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ʒ<EFBFBD><C6B7>ͼ.TzListBox itemlist 
      Height          =   3165
      Left            =   -15
      TabIndex        =   0
      Top             =   255
      Width           =   4710
      _ExtentX        =   8308
      _ExtentY        =   5583
   End
   Begin <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ʒ<EFBFBD><C6B7>ͼ.TzProgressBar pb 
      Height          =   255
      Left            =   15
      Top             =   0
      Width           =   4665
      _ExtentX        =   8229
      _ExtentY        =   450
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "<22><><EFBFBD><EFBFBD>"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      BackColor       =   16777088
      StartColor      =   16777088
   End
   Begin <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ʒ<EFBFBD><C6B7>ͼ.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 "δ<><CEB4>ȡ<EFBFBD><C8A1><EFBFBD>κ<EFBFBD><CEBA><EFBFBD>Ʒ<EFBFBD><C6B7>Ϣ,<2C><>ȷ<EFBFBD><C8B7><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ڴ<EFBFBD><DAB4><EFBFBD>!", 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, "<22><><EFBFBD><EFBFBD>ȡ<EFBFBD><C8A1>ͼ<EFBFBD><CDBC>Ϣ" & 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, "<22><><EFBFBD><EFBFBD>ȡ<EFBFBD><C8A1>ͼ<EFBFBD><CDBC>Ϣ" & pb.BarMax & "<22><>,<2C>뵽<EFBFBD><EBB5BD>ͼ<EFBFBD><CDBC><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ͼ!"
    Frm_Download.Show
    MsgBox "<22><><EFBFBD><EFBFBD>ȡ<EFBFBD><C8A1>ͼ<EFBFBD><CDBC>Ϣ" & pb.BarMax & "<22><>,<2C>뵽<EFBFBD><EBB5BD>ͼ<EFBFBD><CDBC><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ͼ!"
    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