mirror of
https://e.coding.net/circlecloud/LoadFirstPic.git
synced 2024-12-29 08:18:50 +00:00
659 lines
21 KiB
Plaintext
659 lines
21 KiB
Plaintext
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
|
|
End If
|
|
tip:
|
|
MsgBox "请在阿里登录页面执行此操作..."
|
|
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
|