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

更新部分界面...

Browse Source 
Signed-off-by: 502647092 <jtb1@163.com>
This commit is contained in:
502647092 2015-12-25 17:16:31 +08:00
parent b49532d171
commit 8d238f585d
3 changed files with 86 additions and 83 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

131
Frm_Main.frm
View File

@ -309,21 +309,21 @@ 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
Set vDoc = webb.Document Set vDoc = webb.Document
itemname = resetfilename(vDoc.getelementsbytagname("input")("subject").Value) itemname = resetfilename(vDoc.getelementsbytagname("input")("subject").Value)
ERR.clear ERR.clear
@ -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
@ -445,33 +445,36 @@ Private Sub putpwd_Click()
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 Exit Sub
Else
MsgBox "请先获取帐号登录信息!"
Exit Sub
End If End If
tip: tip:
MsgBox "请在阿里登录页面执行此操作..." MsgBox "请在阿里登录页面执行此操作...错误代码: " & ERR.Number & " 错误描述: " & ERR.Description
End Sub End Sub
Private Sub urlT_DblClick(index As Integer) Private Sub urlT_DblClick(Index As Integer)
urlT(index).SelStart = 0 urlT(Index).SelStart = 0
urlT(index).SelLength = Len(urlT(index).Text) urlT(Index).SelLength = Len(urlT(Index).Text)
End Sub End Sub
Private Sub urlT_KeyPress(index As Integer, KeyAscii As Integer) Private Sub urlT_KeyPress(Index As Integer, KeyAscii As Integer)
If KeyAscii = 13 Then web(index).Navigate2 urlT(index).Text If KeyAscii = 13 Then web(Index).Navigate2 urlT(Index).Text
End Sub 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) 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 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" If InStr(1, url, "com/my") Then web(0).Navigate2 "http://work.1688.com/home/page/index.htm#nav/home"
End Sub End Sub
Private Sub web_DocumentComplete(index As Integer, ByVal pDisp As Object, url As Variant) Private Sub web_DocumentComplete(Index As Integer, ByVal pDisp As Object, url As Variant)
On Error Resume Next On Error Resume Next
If InStr(1, url, "operator=edit") Then Call getfp(web(index)) If InStr(1, url, "operator=edit") Then Call getfp(web(Index))
End Sub End Sub
Private Sub web_DownloadBegin(index As Integer) Private Sub web_DownloadBegin(Index As Integer)
web(index).Tag = False web(Index).Tag = False
urlT(index).Enabled = False urlT(Index).Enabled = False
Me.Caption = "Loading..." Me.Caption = "Loading..."
End Sub End Sub
@ -545,41 +548,41 @@ Private Sub loginadmin_Click()
End If End If
End Sub End Sub
Private Sub web_DownloadComplete(index As Integer) Private Sub web_DownloadComplete(Index As Integer)
'On Error Resume Next 'On Error Resume Next
Dim target, Title, Class Dim target, Title, Class
Dim itemurl As String Dim itemurl As String
Dim itemname As String Dim itemname As String
web(index).Silent = True web(Index).Silent = True
web(index).Tag = True web(Index).Tag = True
urlT(index).Enabled = True urlT(Index).Enabled = True
urlT(index).ForeColor = vbBlue urlT(Index).ForeColor = vbBlue
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
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
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)
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"
'商品列表批量获取信息 '商品列表批量获取信息
@ -600,7 +603,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
@ -613,7 +616,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
@ -623,11 +626,11 @@ Private Sub web_DownloadComplete(index As Integer)
Next Next
End Sub 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
@ -648,11 +651,11 @@ Public Function urlreset(ByVal url As String) As String
'Debug.Print url 'Debug.Print url
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
End Sub End Sub

16
首图导出工具.vbp
View File

@ -1,22 +1,22 @@
Type=Exe Type=Exe
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\Windows\SysWOW64\stdole2.tlb#OLE Automation Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\Windows\SysWOW64\stdole2.tlb#OLE Automation
Object={EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}#1.1#0; ieframe.dll Object={EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}#1.1#0; ieframe.dll
Reference=*\G{662901FC-6951-4854-9EB2-D9A2570F2B2E}#5.1#0#C:\Windows\system32\winhttp.dll#Microsoft WinHTTP Services, version 5.1 Reference=*\G{662901FC-6951-4854-9EB2-D9A2570F2B2E}#5.1#0#C:\WINDOWS\system32\winhttpcom.dll#Microsoft WinHTTP Services, version 5.1
Form=Frm_Main.frm Form=Frm_Main.frm
UserControl=..\VB用户控件\TzDownload.ctl UserControl=..\VBUserContorl\TzDownload.ctl
UserControl=..\VB用户控件\TzListBox.ctl UserControl=..\VBUserContorl\TzListBox.ctl
Form=Frm_Download.frm Form=Frm_Download.frm
UserControl=..\VB用户控件\TzProgressBar.ctl UserControl=..\VBUserContorl\TzProgressBar.ctl
Module=MainBas; MainBas.bas Module=MainBas; MainBas.bas
UserControl=..\VB用户控件\Frm_Tols.ctl UserControl=..\VBUserContorl\Frm_Tols.ctl
Form=Frm_Index.frm Form=Frm_Index.frm
UserControl=..\VB用户控件\XmlHttp.ctl UserControl=..\VBUserContorl\XmlHttp.ctl
Form=Frm_Err.frm Form=Frm_Err.frm
UserControl=..\VB用户控件\TzButton.ctl UserControl=..\VBUserContorl\TzButton.ctl
Startup="Frm_Main" Startup="Frm_Main"
HelpFile="" HelpFile=""
ExeName32="首图导出工具.exe" ExeName32="首图导出工具.exe"
Path32="C:\Users\Administrator\Desktop" Path32="C:\Users\½¯ÌìÝí\Desktop"
Command32="" Command32=""
Name="导出商品首图" Name="导出商品首图"
HelpContextID="0" HelpContextID="0"

22
首图导出工具.vbw
View File

@ -1,11 +1,11 @@
Frm_Main = 1, 6, 1532, 663, , 44, 44, 1405, 626, C Frm_Main = 1, 6, 1532, 663, , 44, 44, 1405, 626, CI
TzDownload = 220, 220, 1649, 725, , 0, 0, 984, 374, C TzDownload = 0, 0, 0, 0, C, 104, 104, 1434, 634, C
TzListBox = 44, 44, 1562, 489, , 22, 22, 1006, 396, C TzListBox = 0, 0, 0, 0, C, 130, 130, 1460, 660, C
Frm_Download = 171, 26, 1733, 683, , 72, 94, 933, 618, C Frm_Download = 0, 0, 0, 0, C, 156, 156, 1486, 686, C
TzProgressBar = 66, 66, 1518, 635, , 44, 44, 1028, 418, C TzProgressBar = 0, 0, 0, 0, C, 182, 182, 1512, 712, C
MainBas = 22, 22, 1363, 679, MainBas = 0, 0, 0, 0, C
Frm_Tols = 0, 0, 1341, 657, I, 132, 132, 1116, 506, C Frm_Tols = 0, 0, 0, 0, C, 208, 208, 1538, 738, C
Frm_Index = 154, 30, 1495, 687, , 106, 189, 1447, 846, C Frm_Index = 26, 26, 1356, 556, , 234, 234, 1564, 764, C
XmlHttp = 0, 0, 0, 0, C, 286, 286, 1627, 943, C XmlHttp = 0, 0, 0, 0, C, 260, 260, 1590, 790, C
Frm_Err = 198, 198, 1627, 703, C, 250, 205, 1679, 710, C Frm_Err = 0, 0, 0, 0, C, 0, 0, 1330, 530, C
TzButton = 0, 0, 0, 0, C, 220, 220, 1649, 725, C TzButton = 0, 0, 0, 0, C, 26, 26, 1356, 556, C