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

update file...

Browse Source 
Signed-off-by: j502647092 <jtb1@163.com>
This commit is contained in:
j502647092 2015-06-15 19:02:59 +08:00
parent db5844eb2c
commit de9b9f28d5
5 changed files with 210 additions and 127 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
Frm_Download.frm
View File

@ -79,10 +79,8 @@ Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False Attribute VB_Exposed = False
Option Explicit Option Explicit
'=================================Sleep========================================
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Private Savetime As Double
Private sd As Boolean Private sd As Boolean
Private Savetime As Double
Private Sub clear_Click() Private Sub clear_Click()
SName.clear SName.clear
@ -94,12 +92,13 @@ Private Sub dl_OnFinished(ByVal Result As Boolean)
End Sub End Sub
Private Sub dlc_Click() Private Sub dlc_Click()
On Error Resume Next
Dim i Dim i
Dim folder As String Dim folder As String
Dim usetime As Double Dim UseTime As Double
If folder = "" Then folder = InputBox("请输入 日期-首图-公司名称-阿里账号-提单人名称!", , Format(Now, "m.d") & "-首图-公司名称-阿里账号-提单人名称") If folder = "" Then folder = InputBox("请输入 日期-首图-公司名称-阿里账号-提单人名称!", , Format(Now, "m.d") & "-首图-公司名称-阿里账号-提单人名称")
If folder = "" Then folder = Format(Now, "m.d") & "-首图-公司名称-阿里账号-提单人名称" If folder = "" Then folder = Format(Now, "m.d") & "-首图-公司名称-阿里账号-提单人名称"
usetime = timeGetTime UseTime = timeGetTime
For i = 0 To UName.ListCount - 1 For i = 0 To UName.ListCount - 1
red: red:
pb.Change i, "下载中 进度: " & i & "/" & pb.BarMax pb.Change i, "下载中 进度: " & i & "/" & pb.BarMax
@ -112,8 +111,8 @@ red:
If Not sd Then GoTo red If Not sd Then GoTo red
'Debug.Print Replace(Trim(SName.List(i)), " ", "") 'Debug.Print Replace(Trim(SName.List(i)), " ", "")
Next Next
usetime = Format((timeGetTime - usetime) / 1000, "0.00") UseTime = Format((timeGetTime - UseTime) / 1000, "0.00")
pb.Change pb.BarMax, "下载完成 共下载" & pb.BarMax & "件产品首图 耗时" & usetime & "秒!", &H80FF80 pb.Change pb.BarMax, "下载完成 共下载" & pb.BarMax & "件产品首图 耗时" & UseTime & "秒!", &H80FF80
End Sub End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
@ -124,33 +123,26 @@ End Sub
'itempicurl (ix), App.Path & "\" & folder.Text & "\" & itemname(ix).Text & ".jpg" 'itempicurl (ix), App.Path & "\" & folder.Text & "\" & itemname(ix).Text & ".jpg"
Private Sub Form_Resize() Private Sub Form_Resize()
On Error Resume Next On Error Resume Next
SName.Left = 5 SName.Left = 5
SName.Top = 600 SName.Top = 600
SName.Height = Me.Height - 600 SName.Height = Me.Height - 600
SName.Width = Me.Width / 2 - 10 SName.Width = Me.Width / 2 - 10
UName.Left = Me.Width / 2 + 10 UName.Left = Me.Width / 2 + 10
UName.Top = 600 UName.Top = 600
UName.Height = Me.Height - 600 UName.Height = Me.Height - 600
UName.Width = Me.Width / 2 - 10 UName.Width = Me.Width / 2 - 10
dl.Left = dlc.Left + dlc.Width + 10 dl.Left = dlc.Left + dlc.Width + 10
dl.Width = Me.Width - dl.Left - 20 dl.Width = Me.Width - dl.Left - 20
dl.Top = 25 dl.Top = 25
pb.Left = dlc.Left + dlc.Width + 10 pb.Left = dlc.Left + dlc.Width + 10
pb.Width = Me.Width - dl.Left - 20 pb.Width = Me.Width - dl.Left - 20
pb.Top = dl.Top + dl.Height + 50 pb.Top = dl.Top + dl.Height + 50
End Sub End Sub
Public Sub Sleep(n As Long)
Savetime = timeGetTime
While timeGetTime < Savetime + n
DoEvents
Wend
End Sub
Private Sub SName_dblClick() Private Sub SName_dblClick()
InputBox "您所选择的产品名称如下:", , SName.List(SName.ListIndex) InputBox "您所选择的产品名称如下:", , SName.List(SName.ListIndex)
End Sub End Sub

280
Frm_Main.frm
View File

@ -10,34 +10,90 @@ Begin VB.Form Frm_Main
ScaleHeight = 9390 ScaleHeight = 9390
ScaleWidth = 19035 ScaleWidth = 19035
StartUpPosition = 3 '窗口缺省 StartUpPosition = 3 '窗口缺省
Begin VB.ListBox lurl Begin VB.CommandButton lg
Height = 5100 Caption = "login"
Left = 45 Height = 270
Left = 12660
TabIndex = 17
Top = 105
Width = 735
End
Begin VB.Timer getcb
Enabled = 0 'False
Interval = 100
Left = 8910
Top = 4455
End
Begin SHDocVwCtl.WebBrowser mm
Height = 720
Left = 10920
TabIndex = 16 TabIndex = 16
Top = 1350 Top = 1335
Width = 11670 Visible = 0 'False
Width = 4530
ExtentX = 7990
ExtentY = 1270
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.Timer getass
Enabled = 0 'False
Interval = 1000
Left = 8910
Top = 4455
End
Begin 导出商品首图.Frm_Tols Frm
Height = 240
Left = 9390
Top = 4575
Visible = 0 'False
Width = 240
_ExtentX = 423
_ExtentY = 423
End
Begin VB.CommandButton loginassist
Caption = "商机助理"
Height = 300
Left = 13455
TabIndex = 15
Top = 90
Width = 930
End End
Begin VB.CommandButton pic Begin VB.CommandButton pic
Caption = "图片" Caption = "图片"
Height = 300 Height = 300
Left = 11400 Left = 10905
TabIndex = 15 TabIndex = 14
Top = 90 Top = 90
Width = 600 Width = 600
End End
Begin VB.CommandButton manager Begin VB.CommandButton manager
Caption = "商品" Caption = "商品"
Height = 300 Height = 300
Left = 10500 Left = 10170
TabIndex = 14 TabIndex = 13
Top = 90 Top = 90
Width = 600 Width = 600
End End
Begin VB.CommandButton alibaba Begin VB.CommandButton alibaba
Caption = "1688" Caption = "1688"
Height = 300 Height = 300
Left = 9600 Left = 9435
TabIndex = 13 TabIndex = 12
Top = 90 Top = 90
Width = 600 Width = 600
End End
@ -45,15 +101,15 @@ Begin VB.Form Frm_Main
Caption = "OA" Caption = "OA"
Height = 300 Height = 300
Left = 8700 Left = 8700
TabIndex = 12 TabIndex = 11
Top = 90 Top = 90
Width = 600 Width = 600
End End
Begin VB.CommandButton lookitem Begin VB.CommandButton lookitem
Caption = "查看商品" Caption = "查看商品"
Height = 300 Height = 300
Left = 12300 Left = 11640
TabIndex = 11 TabIndex = 10
Top = 90 Top = 90
Width = 945 Width = 945
End End
@ -61,7 +117,7 @@ Begin VB.Form Frm_Main
Height = 915 Height = 915
Index = 2 Index = 2
Left = 9750 Left = 9750
TabIndex = 10 TabIndex = 9
Top = 1350 Top = 1350
Width = 1155 Width = 1155
ExtentX = 2037 ExtentX = 2037
@ -109,13 +165,6 @@ Begin VB.Form Frm_Main
ViewID = "{0057D0E0-3573-11CF-AE69-08002B2E1262}" ViewID = "{0057D0E0-3573-11CF-AE69-08002B2E1262}"
Location = "http:///" Location = "http:///"
End End
Begin VB.ListBox List1
Height = 7620
Left = 16830
TabIndex = 8
Top = 1695
Width = 1035
End
Begin VB.ListBox List2 Begin VB.ListBox List2
Height = 780 Height = 780
Left = 45 Left = 45
@ -180,8 +229,8 @@ Begin VB.Form Frm_Main
AutoSize = -1 'True AutoSize = -1 'True
Caption = "页数" Caption = "页数"
Height = 180 Height = 180
Left = 13410 Left = 14550
TabIndex = 9 TabIndex = 8
Top = 150 Top = 150
Width = 360 Width = 360
End End
@ -210,36 +259,32 @@ Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False Attribute VB_Exposed = False
Option Explicit Option Explicit
Private Savetime As Double
Dim strUrl As String Dim strUrl As String
Dim dWinFolder As New ShellWindows Dim uid As String
Dim WithEvents eventIE As WebBrowser_V1 Dim username As String
Attribute eventIE.VB_VarHelpID = -1 Dim password As String
Dim showmsg As Boolean
Dim gsmc As String
Private Sub Form_Load() Dim assistpid As Long
Dim objIE As Object Dim assisthWnd As Long
For Each objIE In dWinFolder
lurl.AddItem objIE.FullName
If InStr(1, objIE.FullName, "iexplore.exe") <> 0 Then
lurl.AddItem objIE.LocationURL
End If
Next
End Sub
Private Sub alibaba_Click() Private Sub alibaba_Click()
web(0).Navigate2 "http://work.1688.com/home/page/index.htm#nav/home" web(0).Navigate2 "http://work.1688.com/home/page/index.htm#nav/home"
End Sub End Sub
' '
'Private Sub Form_Load() Private Sub Form_Load()
' web(0).Navigate2 "http://192.168.0.8:83/" web(0).Navigate "http://192.168.0.8:83/"
'End Sub End Sub
Private Sub Form_Resize() Private Sub Form_Resize()
On Error Resume Next On Error Resume Next
Dim lefthg Dim lefthg
web(0).Top = 900 web(0).Top = 900
lefthg = Me.Height - web(0).Top lefthg = Me.Height - web(0).Top
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
@ -250,19 +295,6 @@ Private Sub Form_Resize()
web(i).Height = lefthg / 2 web(i).Height = lefthg / 2
web(i).Left = 10 web(i).Left = 10
Next Next
' web(1).Width = Me.Width / 3 * 2 - 50
' web(1).Top = web(0).Top + lefthg / 2
' web(1).Height = lefthg / 2
' web(1).Left = 10
'
' web(2).Width = Me.Width / 3 * 2 - 50
' web(2).Top = web(0).Top + lefthg / 2
' web(2).Height = lefthg / 2
' web(2).Left = 10
List1.Left = Me.Width - List1.Width - 350
List1.Height = lefthg - 350
List1.Top = web(0).Top
End Sub End Sub
Private Sub getfp(webb As WebBrowser) Private Sub getfp(webb As WebBrowser)
@ -276,9 +308,9 @@ Private Sub getfp(webb As WebBrowser)
ERR.clear ERR.clear
itemurl = vDoc.getelementsbytagname("input")("pictureUrl").Value itemurl = vDoc.getelementsbytagname("input")("pictureUrl").Value
If ERR <> 0 Then If ERR <> 0 Then
itempicurl = vDoc.getelementsbytagname("input")("pictureUrl")(0).Value itemurl = vDoc.getelementsbytagname("input")("pictureUrl")(0).Value
End If End If
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
@ -290,6 +322,7 @@ Private Sub getfp(webb As WebBrowser)
End Sub End Sub
Private Function resetfilename(ByVal name As String) As String Private Function resetfilename(ByVal name As String) As String
On Error Resume Next
name = clear(name, "/") name = clear(name, "/")
name = clear(name, "\") name = clear(name, "\")
name = clear(name, "*") name = clear(name, "*")
@ -309,6 +342,42 @@ Private Sub Form_Unload(Cancel As Integer)
End End
End Sub End Sub
Private Sub getass_Timer()
On Error Resume Next
Dim Cname As String
assisthWnd = Frm.GethWndByClass("#32770")
'"阿里巴巴商机助理登录"
If assisthWnd <> 0 Then
Debug.Print hWnd
Cname = Frm.GetTitle(assisthWnd)
Debug.Print Cname
Frm.SetFedWnd assisthWnd
assistpid = Frm.GetPidByhWnd(assisthWnd)
getass.Enabled = False
getcb.Enabled = True
End If
End Sub
Private Sub getcb_Timer()
On Error Resume Next
Dim hWnd As Long
Dim mcname As String
hWnd = Frm.GetMouseWindowhWnd
If Frm.GetPidByhWnd(hWnd) = assistpid Then
mcname = Frm.GetClassName(hWnd)
If mcname = "ComboBox" Then
Frm.SetFedWnd hWnd
Debug.Print "已获取到句柄" & hWnd
Frm.hWndKeyPress hWnd, vbKeyLButton, System
Frm.hWndKeyPress assisthWnd, vbKeyTab, System
SendKeys "123"
Frm.hWndKeyPress assisthWnd, vbKeyTab, System
SendKeys "123"
getcb.Enabled = False
End If
End If
End Sub
Private Sub Label1_Click() Private Sub Label1_Click()
web(0).Visible = Not web(0).Visible web(0).Visible = Not web(0).Visible
showweb (0) showweb (0)
@ -321,7 +390,6 @@ Private Sub Label2_Click()
Set vDoc = web(0).Document Set vDoc = web(0).Document
On Error Resume Next On Error Resume Next
For i = 0 To vDoc.All.length - 1 For i = 0 To vDoc.All.length - 1
List1.AddItem vDoc.All(i).TagName
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)
@ -348,6 +416,32 @@ Private Sub Label5_Click()
Next Next
End Sub End Sub
Private Sub lg_Click()
getass.Enabled = True
End Sub
Private Sub loginassist_Click()
On Error Resume Next
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')"
Dim password
showmsg = True
End If
Else
MsgBox "请先打开一次阿里助手!"
End If
End Sub
Private Sub lookitem_Click() Private Sub lookitem_Click()
Frm_Download.Show Frm_Download.Show
End Sub End Sub
@ -355,6 +449,19 @@ End Sub
Private Sub manager_Click() Private Sub manager_Click()
web(0).Navigate2 "http://offer.1688.com/offer/manage.htm?show_type=valid&tracelog=work_1_m_orderManage" web(0).Navigate2 "http://offer.1688.com/offer/manage.htm?show_type=valid&tracelog=work_1_m_orderManage"
End Sub End Sub
Private Sub mm_DocumentComplete(ByVal pDisp As Object, url As Variant)
On Error Resume Next
If showmsg Then
password = mm.Document.body.innerhtml
Clipboard.clear
Clipboard.SetText password
MsgBox "密码获取成功,请在1分钟打开商机助理,将会自动登录!", vbInformation, "商机助理登录"
getass.Enabled = True
End If
showmsg = False
End Sub
'http://picman.1688.com/album/album_list.htm?tracelog=work_1_m_albumManage '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://offer.1688.com/offer/manage.htm?show_type=valid&tracelog=work_1_m_orderManage
'http://login.1688.com/member/signout.htm 'http://login.1688.com/member/signout.htm
@ -396,6 +503,7 @@ End Sub
'End Sub 'End Sub
Private Sub web_DownloadComplete(index As Integer) Private Sub web_DownloadComplete(index As Integer)
'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
@ -405,14 +513,15 @@ Private Sub web_DownloadComplete(index As Integer)
urlT(index).ForeColor = vbBlue urlT(index).ForeColor = vbBlue
Me.Caption = "Load Complete" Me.Caption = "Load Complete"
showweb (index) showweb (index)
List1.clear
List2.clear
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
For i = 0 To vDoc.All.length - 1 If InStr(1, web(index).LocationURL, "alilogin.aspx") Then
List1.AddItem vDoc.All(i).TagName uid = Mid(web(index).LocationURL, InStr(1, web(index).LocationURL, "?id=") + 4)
username = vDoc.getelementsbytagname("input")("TPL_username").Value
End If
For i = 2 To vDoc.All.length - 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)
@ -422,7 +531,8 @@ Private Sub web_DownloadComplete(index As Integer)
Select Case UCase(vDoc.All(i).TagName) Select Case UCase(vDoc.All(i).TagName)
Case "TD" Case "TD"
Case "A" Case "A"
'商品列表批量获取信息 '商品列表批量获取信息
If vTag.Title = "查看公司详细信息" Then gsmc = vTag1.innerhtml
Dim st As Long Dim st As Long
Dim en As Long Dim en As Long
If UCase(vTag_2.TagName) = "INPUT" And _ If UCase(vTag_2.TagName) = "INPUT" And _
@ -434,7 +544,7 @@ Private Sub web_DownloadComplete(index As Integer)
en = InStr(st, vTag.innerhtml, "jpg") + 3 en = InStr(st, vTag.innerhtml, "jpg") + 3
itemurl = Mid(vTag.innerhtml, st, en - st) itemurl = Mid(vTag.innerhtml, st, en - st)
itemurl = urlreset(itemurl) itemurl = urlreset(itemurl)
'Debug.Print itemurl Debug.Print itemurl
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(vTag.Title) & ".jpg"))) Then If Not (Frm_Download.SName.AddItemNotSame(resetfilename(Trim(vTag.Title) & ".jpg"))) Then
@ -444,7 +554,7 @@ Private Sub web_DownloadComplete(index As Integer)
End If End If
End If End If
Case "META" Case "META"
'商品展示部分直接获取首图信息 '商品展示部分直接获取首图信息
If vTag.Property = "og:image" And vTag1.Property = "og:title" Then If vTag.Property = "og:image" And vTag1.Property = "og:title" Then
itemurl = urlreset(vTag.content) itemurl = urlreset(vTag.content)
itemname = vTag1.content itemname = vTag1.content
@ -456,44 +566,6 @@ Private Sub web_DownloadComplete(index As Integer)
End If End If
End If End If
End If End If
' <meta property="og:image" content="http://i00.c.aliimg.com/img/ibank/2015/897/991/2210199798_196219354.310x310.jpg"/>
'<meta property="og:title" content="12支铅笔塑料盒 20*22CM环保吸塑包装 多规格pvc吸塑泡壳加工"/>
' ' If UCase(vTag_2.TagName) = "DIV" And _
' ' UCase(vTag_1.TagName) = "DIV" And _
' ' UCase(vTag1.TagName) = "SPAN" And _
' ' UCase(vTag2.TagName) = "UL" Then
' ' If vTag.class = "btn-edit" And vTag.target = "_blank" And vTag.title = "修改" Then List2.AddItem vTag.href
' ' End If
' Case "B"
' 'A SPAN　B B B
'
' ' If UCase(vTag_2.TagName) = "A" And _
' ' UCase(vTag_1.TagName) = "SPAN" And _
' ' UCase(vTag1.TagName) = "B" And _
' ' UCase(vTag2.TagName) = "B" Then
' ' Me.Caption = "当前的任务有" & vTag.innerhtml & "个!"
' ' End If
'
' 'http://192.168.0.8:83/app1/TaskLadingCn/List.aspx?k=&RearchType=0&UId=0&KfId=4986&MgId=0&mgbm=0&bumen=0&followup=&FState=0&tdtype=-1&FSpeed=0&FMgSpeed=0&FKfSpeed=1&attr=0&AttrBus=0&selDate=0&strDate=&endDate=
' 'TD A IMG TD P
' Case "IMG"
' If UCase(vTag_2.TagName) = "TD" And _
' UCase(vTag_1.TagName) = "A" And _
' UCase(vTag1.TagName) = "TD" And _
' UCase(vTag2.TagName) = "p" Then
' 'List2.AddItem vTag_1.innerhtml
' Debug.Print vTag_1.innerhtml
' Debug.Print vTag.src
' End If
' Case "EM"
' If UCase(vTag_2.TagName) = "A" And _
' UCase(vTag_1.TagName) = "LI" And _
' UCase(vTag1.TagName) = "INPUT" And _
' UCase(vTag2.TagName) = "LI" Then
' pages = vTag.innerhtml
' End If
End Select End Select
Next Next
End Sub End Sub
@ -502,14 +574,14 @@ 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
End Sub End Sub
Public Function urlreset(ByVal url As String) As String Public Function urlreset(ByVal url As String) As String
Dim st, en Dim st, en
'Debug.Print url 'Debug.Print url
st = InStr(1, url, "http://") + Len("http://") st = InStr(1, url, "http://") + Len("http://")
st = InStr(st + 1, url, "/") + Len("/") st = InStr(st + 1, url, "/") + Len("/")

13
MainBas.bas Normal file
View File

@ -0,0 +1,13 @@
Attribute VB_Name = "MainBas"
Option Explicit
'=================================Sleep========================================
Public Declare Function timeGetTime Lib "winmm.dll" () As Long
Private Savetime As Double
Public Sub Sleep(n As Long)
Savetime = timeGetTime
While timeGetTime < Savetime + n
DoEvents
Wend
End Sub

3
首图导出工具.vbp
View File

@ -7,9 +7,12 @@ UserControl=..\VB
UserControl=..\VB用户控件\TzListBox.ctl UserControl=..\VB用户控件\TzListBox.ctl
Form=Frm_Download.frm Form=Frm_Download.frm
UserControl=..\VB用户控件\TzProgressBar.ctl UserControl=..\VB用户控件\TzProgressBar.ctl
Module=MainBas; MainBas.bas
UserControl=..\VB用户控件\Frm_Tols.ctl
Startup="Frm_Main" Startup="Frm_Main"
HelpFile="" HelpFile=""
ExeName32="首图导出工具.exe" ExeName32="首图导出工具.exe"
Path32="C:\Users\Administrator\Desktop"
Command32="" Command32=""
Name="导出商品首图" Name="导出商品首图"
HelpContextID="0" HelpContextID="0"

13
首图导出工具.vbw
View File

@ -1,5 +1,8 @@
Frm_Main = 0, 0, 984, 374, , 0, 0, 1070, 535, C Frm_Main = 22, 22, 1006, 396, Z, 44, 44, 1028, 418, C
TzDownload = 0, 0, 0, 0, C, 0, 0, 0, 0, C TzDownload = 0, 0, 0, 0, C, 0, 0, 984, 374, C
TzListBox = 0, 0, 0, 0, C, 0, 0, 0, 0, C TzListBox = 0, 0, 0, 0, C, 22, 22, 1006, 396, C
Frm_Download = 44, 44, 1095, 418, , 110, 110, 1094, 484, C Frm_Download = 0, 0, 984, 374, , 110, 110, 1094, 484, C
TzProgressBar = 0, 0, 0, 0, C, 0, 0, 0, 0, C TzProgressBar = 0, 0, 0, 0, C, 44, 44, 1028, 418, C
Frm_WebList = 176, 176, 1160, 550, , 154, 154, 1138, 528, C
MainBas = 88, 88, 1139, 462,
Frm_Tols = 66, 66, 1050, 440, , 132, 132, 1116, 506, C