VERSION 5.00
Object = "{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}#1.1#0"; "ieframe.dll"
Begin VB.Form Frm_Main 
   Caption         =   "导出首图"
   ClientHeight    =   9390
   ClientLeft      =   120
   ClientTop       =   450
   ClientWidth     =   19035
   LinkTopic       =   "Form1"
   ScaleHeight     =   9390
   ScaleWidth      =   19035
   StartUpPosition =   2  '屏幕中心
   Begin 导出商品首图.TzButton getindex 
      Height          =   300
      Left            =   12360
      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            =   11130
      Top             =   90
      Width           =   1215
      _ExtentX        =   2143
      _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            =   14745
      TabIndex        =   16
      Top             =   90
      Width           =   1000
   End
   Begin VB.CommandButton loginadmin 
      Caption         =   "登录后台"
      Height          =   300
      Left            =   13755
      TabIndex        =   15
      Top             =   90
      Width           =   1000
   End
   Begin 导出商品首图.Frm_Tols Frm 
      Height          =   240
      Left            =   9390
      Top             =   4575
      Visible         =   0   'False
      Width           =   240
      _ExtentX        =   423
      _ExtentY        =   423
   End
   Begin VB.CommandButton oa 
      Caption         =   "OA"
      Height          =   300
      Left            =   8700
      TabIndex        =   10
      Top             =   90
      Width           =   600
   End
   Begin SHDocVwCtl.WebBrowser web 
      Height          =   915
      Index           =   2
      Left            =   9750
      TabIndex        =   9
      Top             =   1350
      Width           =   1155
      ExtentX         =   2037
      ExtentY         =   1614
      ViewMode        =   0
      Offline         =   0
      Silent          =   0
      RegisterAsBrowser=   1
      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 SHDocVwCtl.WebBrowser web 
      Height          =   915
      Index           =   1
      Left            =   8580
      TabIndex        =   2
      Top             =   1335
      Width           =   1155
      ExtentX         =   2037
      ExtentY         =   1614
      ViewMode        =   0
      Offline         =   0
      Silent          =   0
      RegisterAsBrowser=   1
      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.ListBox List2 
      Height          =   780
      Left            =   45
      TabIndex        =   7
      Top             =   9315
      Width           =   17145
   End
   Begin VB.TextBox urlT 
      Height          =   270
      Index           =   2
      Left            =   8700
      TabIndex        =   6
      Text            =   "2"
      Top             =   480
      Width           =   7710
   End
   Begin VB.TextBox urlT 
      Height          =   270
      Index           =   1
      Left            =   945
      TabIndex        =   4
      Text            =   "1"
      Top             =   480
      Width           =   7710
   End
   Begin VB.TextBox urlT 
      Height          =   270
      Index           =   0
      Left            =   945
      TabIndex        =   3
      Text            =   "Text1"
      Top             =   105
      Width           =   7710
   End
   Begin SHDocVwCtl.WebBrowser web 
      Height          =   7665
      Index           =   0
      Left            =   45
      TabIndex        =   1
      Top             =   1335
      Width           =   8535
      ExtentX         =   15055
      ExtentY         =   13520
      ViewMode        =   0
      Offline         =   0
      Silent          =   0
      RegisterAsBrowser=   1
      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 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            =   15855
      TabIndex        =   8
      Top             =   150
      Width           =   360
   End
   Begin VB.Label Label5 
      AutoSize        =   -1  'True
      Caption         =   "网页链接:"
      Height          =   180
      Left            =   120
      TabIndex        =   5
      Top             =   525
      Width           =   810
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "主页链接:"
      Height          =   180
      Left            =   120
      TabIndex        =   0
      Top             =   150
      Width           =   810
   End
End
Attribute VB_Name = "Frm_Main"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Savetime As Double
Dim strURL As String
Dim uid As String
Dim username As String
Dim password As String
Dim showmsg As Boolean
Dim gsmc As String

Dim assistpid As Long
Dim assisthWnd As Long

Private Sub alibaba_Click()
    web(0).Navigate2 "http://work.1688.com/home/page/index.htm#nav/home"
End Sub

'
Private Sub Form_Load()
    web(0).Navigate "http://192.168.0.8:83/"
End Sub

Private Sub Form_Resize()
    On Error Resume Next
    Dim lefthg
    web(0).Top = 900
    lefthg = Me.Height - web(0).Top

    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
    Next
End Sub

Private Sub getfp(webb As WebBrowser)
    On Error Resume Next
    Dim i, J, vDoc
    Dim ix As Long
    Dim itemname, itemurl
    ix = webb.Index
    Set vDoc = webb.Document
    itemname = resetfilename(vDoc.getelementsbytagname("input")("subject").Value)
    ERR.clear
    itemurl = vDoc.getelementsbytagname("input")("pictureUrl").Value
    If ERR <> 0 Then
        itemurl = vDoc.getelementsbytagname("input")("pictureUrl")(0).Value
    End If

    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")
            End If
        End If
    End If

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

Private Sub Form_Unload(Cancel As Integer)
    Unload Frm_Download
    End
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()
    web(0).Visible = Not web(0).Visible
    showweb (0)
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
    Next
End Sub

Private Sub lookitem_Click()
    Frm_Download.Show
End Sub

Private Sub manager_Click()
    web(0).Navigate2 "http://offer.1688.com/offer/manage.htm?show_type=valid&tracelog=work_1_m_orderManage"
End Sub

'http://picman.1688.com/album/album_list.htm?tracelog=work_1_m_albumManage
'http://offer.1688.com/offer/manage.htm?show_type=valid&tracelog=work_1_m_orderManage
'http://login.1688.com/member/signout.htm
Private Sub oa_Click()
    web(0).Navigate2 "http://192.168.0.8:83/"
End Sub

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
        Exit Sub
    Else
        MsgBox "请先获取帐号登录信息!"
        Exit Sub
    End If
tip:
    MsgBox "请在阿里登录页面执行此操作...错误代码: " & ERR.Number & " 错误描述: " & ERR.Description
End Sub

Private Sub urlT_DblClick(Index As Integer)
    urlT(Index).SelStart = 0
    urlT(Index).SelLength = Len(urlT(Index).Text)
End Sub

Private Sub urlT_KeyPress(Index As Integer, KeyAscii As Integer)
    If KeyAscii = 13 Then web(Index).Navigate2 urlT(Index).Text
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
    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)
    On Error Resume Next
    If InStr(1, url, "operator=edit") Then Call getfp(web(Index))
End Sub

Private Sub web_DownloadBegin(Index As Integer)
    web(Index).Tag = False
    urlT(Index).Enabled = False
    Me.Caption = "Loading..."
End Sub

'Private Sub web_DownloadBegin(index As Integer)
'    web(index).Silent = True
'End Sub

Private Sub loginadmin_Click()
'On Error Resume Next
    Dim isuse
    isuse = MsgBox("当前功能不稳定" & vbCrLf & "仅在无法用阿里助手登录时使用!" & vbCrLf & "是否继续?", vbExclamation + vbYesNo)
    If isuse = vbNo Then Exit Sub
    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
    Dim itemurl As String
    Dim itemname As String
    web(Index).Silent = True
    web(Index).Tag = True
    urlT(Index).Enabled = True
    urlT(Index).ForeColor = vbBlue
    Me.Caption = "Load Complete"
    showweb (Index)
    Dim vDoc, vTag_2, vTag_1, vTag, vTag1, vTag2, vTXT
    Dim i As Integer
    Set vDoc = web(Index).Document
    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
    End If
    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)
        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"
            '商品列表批量获取信息
            If vTag.Title = "查看公司详细信息" Then gsmc = vTag1.innerhtml
            Dim st As Long
            Dim en As Long
            If UCase(vTag_2.TagName) = "INPUT" And _
               UCase(vTag_1.TagName) = "TD" And _
               UCase(vTag1.TagName) = "IMG" And _
               UCase(vTag2.TagName) = "TD" Then
                st = InStr(1, vTag.innerhtml, "data-lazyload-src=""") + Len("data-lazyload-src=""")    'data-lazyload-src="http://
                st = InStr(st + 1, vTag.innerhtml, "/") + Len("/")
                en = InStr(st, vTag.innerhtml, "jpg") + 3
                itemurl = Mid(vTag.innerhtml, st, en - st)
                itemurl = urlreset(itemurl)
                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")
                        End If
                    End If
                End If
            End If
        Case "META"
            '商品展示部分直接获取首图信息
            If vTag.Property = "og:image" And vTag1.Property = "og:title" Then
                itemurl = urlreset(vTag.content)
                itemname = vTag1.content
                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")
                            pages.Caption = "以扫描到 " & Frm_Download.UName.ListCount & " 件商品!"
                        End If
                    End If
                End If
            End If
        End Select
    Next
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
    Next
    pages = "未加载..."
    Cancel = True
End Sub

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 = "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
        List2.Visible = False
    Next
    web(Index).Visible = True
End Sub