502647092/LoadFirstPic
1
0
Fork 0
mirror of https://e.coding.net/circlecloud/LoadFirstPic.git synced 2024-12-29 08:18:50 +00:00
Code Releases Activity

add tip while use fastlogin...

Browse Source 
Signed-off-by: j502647092 <jtb1@163.com>
This commit is contained in:
j502647092 2015-07-13 15:07:56 +08:00
parent a9883a3ec9
commit b49532d171
1 changed files with 49 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

95
Frm_Main.frm
View File

@ -12,7 +12,7 @@ Begin VB.Form Frm_Main
StartUpPosition = 2 '屏幕中心 StartUpPosition = 2 '屏幕中心
Begin 导出商品首图.TzButton getindex Begin 导出商品首图.TzButton getindex
Height = 300 Height = 300
Left = 12165 Left = 12360
Top = 90 Top = 90
Width = 1305 Width = 1305
_ExtentX = 2302 _ExtentX = 2302
@ -33,12 +33,12 @@ Begin VB.Form Frm_Main
End End
Begin 导出商品首图.TzButton lookitem Begin 导出商品首图.TzButton lookitem
Height = 300 Height = 300
Left = 11205 Left = 11130
Top = 90 Top = 90
Width = 945 Width = 1215
_ExtentX = 1667 _ExtentX = 2143
_ExtentY = 529 _ExtentY = 529
Caption = "下载商品" Caption = "下载商品首图"
BackColor = 65280 BackColor = 65280
StartColor = 65280 StartColor = 65280
FinshColor = 8454016 FinshColor = 8454016
@ -79,7 +79,7 @@ Begin VB.Form Frm_Main
Begin VB.CommandButton putpwd Begin VB.CommandButton putpwd
Caption = "填写密码" Caption = "填写密码"
Height = 300 Height = 300
Left = 14610 Left = 14745
TabIndex = 16 TabIndex = 16
Top = 90 Top = 90
Width = 1000 Width = 1000
@ -87,7 +87,7 @@ Begin VB.Form Frm_Main
Begin VB.CommandButton loginadmin Begin VB.CommandButton loginadmin
Caption = "登录后台" Caption = "登录后台"
Height = 300 Height = 300
Left = 13620 Left = 13755
TabIndex = 15 TabIndex = 15
Top = 90 Top = 90
Width = 1000 Width = 1000
@ -250,7 +250,7 @@ Begin VB.Form Frm_Main
AutoSize = -1 'True AutoSize = -1 'True
Caption = "页数" Caption = "页数"
Height = 180 Height = 180
Left = 15930 Left = 15855
TabIndex = 8 TabIndex = 8
Top = 150 Top = 150
Width = 360 Width = 360
@ -309,18 +309,18 @@ Private Sub Form_Resize()
web(0).Width = Me.Width - 50 web(0).Width = Me.Width - 50
web(0).Height = lefthg - 250 web(0).Height = lefthg - 250
web(0).Left = 10 web(0).Left = 10
Dim i As Long Dim I As Long
For i = 1 To web.UBound For I = 1 To web.UBound
web(i).Width = Me.Width / 3 * 2 - 50 web(I).Width = Me.Width / 3 * 2 - 50
web(i).Top = web(0).Top + lefthg / 2 web(I).Top = web(0).Top + lefthg / 2
web(i).Height = lefthg / 2 web(I).Height = lefthg / 2
web(i).Left = 10 web(I).Left = 10
Next Next
End Sub End Sub
Private Sub getfp(webb As WebBrowser) Private Sub getfp(webb As WebBrowser)
On Error Resume Next On Error Resume Next
Dim i, J, vDoc Dim I, J, vDoc
Dim ix As Long Dim ix As Long
Dim itemname, itemurl Dim itemname, itemurl
ix = webb.index ix = webb.index
@ -335,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 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 Frm_Download.UName.AddItemNotSame(itemurl) Then
If Not (Frm_Download.SName.AddItemNotSame(resetfilename(Trim(itemname) & ".jpg"))) 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 End If
End If End If
@ -376,20 +376,20 @@ Private Sub getindex_Click()
Me.Caption = "Load Complete" Me.Caption = "Load Complete"
showweb (0) showweb (0)
Dim vDoc, vTag_2, vTag_1, vTag, vTag1, vTag2, vTXT Dim vDoc, vTag_2, vTag_1, vTag, vTag1, vTag2, vTXT
Dim i As Integer Dim I As Integer
Set vDoc = web(0).Document Set vDoc = web(0).Document
On Error Resume Next On Error Resume Next
Dim alll As Long Dim alll As Long
alll = vDoc.All.Length alll = vDoc.All.Length
On Error GoTo 0 On Error GoTo 0
For i = 2 To alll - 1 For I = 2 To alll - 1
On Error Resume Next On Error Resume Next
Set vTag_2 = vDoc.All(i - 2) Set vTag_2 = vDoc.All(I - 2)
Set vTag_1 = vDoc.All(i - 1) Set vTag_1 = vDoc.All(I - 1)
Set vTag = vDoc.All(i) Set vTag = vDoc.All(I)
Set vTag1 = vDoc.All(i + 1) Set vTag1 = vDoc.All(I + 1)
Set vTag2 = vDoc.All(i + 2) Set vTag2 = vDoc.All(I + 2)
Select Case UCase(vDoc.All(i).TagName) Select Case UCase(vDoc.All(I).TagName)
Case "TD" Case "TD"
Case "A" Case "A"
'商品列表批量获取信息 '商品列表批量获取信息
@ -410,10 +410,10 @@ End Sub
Private Sub Label5_Click() Private Sub Label5_Click()
On Error Resume Next On Error Resume Next
Dim i As Long Dim I As Long
For i = web.LBound To web.UBound For I = web.LBound To web.UBound
web(i).Stop web(I).Stop
web(i).Tag = True web(I).Tag = True
Next Next
End Sub End Sub
@ -444,10 +444,10 @@ Private Sub putpwd_Click()
Doc.getElementById("TPL_username_1").Value = username Doc.getElementById("TPL_username_1").Value = username
Doc.getElementById("TPL_password_1").Type = "hidden" Doc.getElementById("TPL_password_1").Type = "hidden"
Doc.getElementById("TPL_password_1").Value = password Doc.getElementById("TPL_password_1").Value = password
Exit Sub
End If End If
Exit Sub
tip: tip:
MsgBox "请在阿里页面执行此操作..." MsgBox "请在阿里登录页面执行此操作..."
End Sub End Sub
Private Sub urlT_DblClick(index As Integer) Private Sub urlT_DblClick(index As Integer)
@ -481,6 +481,9 @@ End Sub
Private Sub loginadmin_Click() Private Sub loginadmin_Click()
'On Error Resume Next 'On Error Resume Next
Dim isuse
isuse = MsgBox("当前功能不稳定" & vbCrLf & "仅在无法用阿里助手登录时使用!" & vbCrLf & "是否继续?", vbExclamation + vbYesNo)
If isuse = vbNo Then Exit Sub
Dim jj Dim jj
'If InStr(1, mm.LocationURL, "alilogin.aspx") Then 'If InStr(1, mm.LocationURL, "alilogin.aspx") Then
If uid <> "" And username <> "" Then If uid <> "" And username <> "" Then
@ -554,7 +557,7 @@ Private Sub web_DownloadComplete(index As Integer)
Me.Caption = "Load Complete" Me.Caption = "Load Complete"
showweb (index) showweb (index)
Dim vDoc, vTag_2, vTag_1, vTag, vTag1, vTag2, vTXT Dim vDoc, vTag_2, vTag_1, vTag, vTag1, vTag2, vTXT
Dim i As Integer Dim I As Integer
Set vDoc = web(index).Document Set vDoc = web(index).Document
On Error Resume Next On Error Resume Next
If InStr(1, web(index).LocationURL, "alilogin.aspx") Then If InStr(1, web(index).LocationURL, "alilogin.aspx") Then
@ -565,18 +568,18 @@ Private Sub web_DownloadComplete(index As Integer)
Dim alll As Long Dim alll As Long
alll = vDoc.All.Length alll = vDoc.All.Length
On Error GoTo 0 On Error GoTo 0
For i = 2 To alll - 1 For I = 2 To alll - 1
On Error Resume Next On Error Resume Next
Set vTag_2 = vDoc.All(i - 2) Set vTag_2 = vDoc.All(I - 2)
Set vTag_1 = vDoc.All(i - 1) Set vTag_1 = vDoc.All(I - 1)
Set vTag = vDoc.All(i) Set vTag = vDoc.All(I)
Set vTag1 = vDoc.All(i + 1) Set vTag1 = vDoc.All(I + 1)
Set vTag2 = vDoc.All(i + 2) Set vTag2 = vDoc.All(I + 2)
If InStr(1, web(index).LocationURL, "alilogin.aspx") Then If InStr(1, web(index).LocationURL, "alilogin.aspx") Then
uid = Mid(web(index).LocationURL, InStr(1, web(index).LocationURL, "?id=") + 4) uid = Mid(web(index).LocationURL, InStr(1, web(index).LocationURL, "?id=") + 4)
username = vDoc.getelementsbytagname("input")("TPL_username").Value username = vDoc.getelementsbytagname("input")("TPL_username").Value
End If End If
Select Case UCase(vDoc.All(i).TagName) Select Case UCase(vDoc.All(I).TagName)
Case "TD" Case "TD"
Case "A" Case "A"
'商品列表批量获取信息 '商品列表批量获取信息
@ -597,7 +600,7 @@ Private Sub web_DownloadComplete(index As Integer)
If Frm_Download.UName.AddItemNotSame(itemurl) Then If Frm_Download.UName.AddItemNotSame(itemurl) Then
pages.Caption = "以扫描到 " & Frm_Download.UName.ListCount & " 件商品!" pages.Caption = "以扫描到 " & Frm_Download.UName.ListCount & " 件商品!"
If Not (Frm_Download.SName.AddItemNotSame(resetfilename(Trim(vTag.Title) & ".jpg"))) Then 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 End If
End If End If
@ -610,7 +613,7 @@ 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 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 Frm_Download.UName.AddItemNotSame(itemurl) Then
If Not (Frm_Download.SName.AddItemNotSame(resetfilename(Trim(itemname) & ".jpg"))) 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 & " 件商品!" pages.Caption = "以扫描到 " & Frm_Download.UName.ListCount & " 件商品!"
End If End If
End If End If
@ -622,9 +625,9 @@ End Sub
Private Sub web_NewWindow2(index As Integer, ppDisp As Object, Cancel As Boolean) Private Sub web_NewWindow2(index As Integer, ppDisp As Object, Cancel As Boolean)
On Error Resume Next On Error Resume Next
Dim i Dim I
For i = 1 To web.UBound For I = 1 To web.UBound
If web(i).Tag Then Set ppDisp = web(i).object: showweb (i): pages = "已加载...": Exit Sub If web(I).Tag Then Set ppDisp = web(I).object: showweb (I): pages = "已加载...": Exit Sub
Next Next
pages = "未加载..." pages = "未加载..."
Cancel = True Cancel = True
@ -646,9 +649,9 @@ Public Function urlreset(ByVal url As String) As String
End Function End Function
Private Sub showweb(index As Long) Private Sub showweb(index As Long)
Dim i As Long Dim I As Long
For i = 1 To web.UBound For I = 1 To web.UBound
web(i).Visible = False web(I).Visible = False
List2.Visible = False List2.Visible = False
Next Next
web(index).Visible = True web(index).Visible = True