diff --git a/Frm_Download.frm b/Frm_Download.frm
index 3d03804..e13feb8 100644
--- a/Frm_Download.frm
+++ b/Frm_Download.frm
@@ -79,10 +79,8 @@ Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
-'=================================Sleep========================================
-Private Declare Function timeGetTime Lib "winmm.dll" () As Long
-Private Savetime As Double
Private sd As Boolean
+Private Savetime As Double
Private Sub clear_Click()
SName.clear
@@ -94,12 +92,13 @@ Private Sub dl_OnFinished(ByVal Result As Boolean)
End Sub
Private Sub dlc_Click()
+ On Error Resume Next
Dim i
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 = Format(Now, "m.d") & "-首图-公司名称-阿里账号-提单人名称"
- usetime = timeGetTime
+ UseTime = timeGetTime
For i = 0 To UName.ListCount - 1
red:
pb.Change i, "下载中 进度: " & i & "/" & pb.BarMax
@@ -112,8 +111,8 @@ red:
If Not sd Then GoTo red
'Debug.Print Replace(Trim(SName.List(i)), " ", "")
Next
- usetime = Format((timeGetTime - usetime) / 1000, "0.00")
- pb.Change pb.BarMax, "下载完成 共下载" & pb.BarMax & "件产品首图 耗时" & usetime & "秒!", &H80FF80
+ UseTime = Format((timeGetTime - UseTime) / 1000, "0.00")
+ pb.Change pb.BarMax, "下载完成 共下载" & pb.BarMax & "件产品首图 耗时" & UseTime & "秒!", &H80FF80
End Sub
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"
Private Sub Form_Resize()
On Error Resume Next
-
+
SName.Left = 5
SName.Top = 600
SName.Height = Me.Height - 600
SName.Width = Me.Width / 2 - 10
-
+
UName.Left = Me.Width / 2 + 10
UName.Top = 600
UName.Height = Me.Height - 600
UName.Width = Me.Width / 2 - 10
-
+
dl.Left = dlc.Left + dlc.Width + 10
dl.Width = Me.Width - dl.Left - 20
dl.Top = 25
-
+
pb.Left = dlc.Left + dlc.Width + 10
pb.Width = Me.Width - dl.Left - 20
pb.Top = dl.Top + dl.Height + 50
End Sub
-Public Sub Sleep(n As Long)
- Savetime = timeGetTime
- While timeGetTime < Savetime + n
- DoEvents
- Wend
-End Sub
-
Private Sub SName_dblClick()
InputBox "您所选择的产品名称如下:", , SName.List(SName.ListIndex)
End Sub
diff --git a/Frm_Main.frm b/Frm_Main.frm
index 25c0baf..e448bd4 100644
--- a/Frm_Main.frm
+++ b/Frm_Main.frm
@@ -10,34 +10,90 @@ Begin VB.Form Frm_Main
ScaleHeight = 9390
ScaleWidth = 19035
StartUpPosition = 3 '窗口缺省
- Begin VB.ListBox lurl
- Height = 5100
- Left = 45
+ Begin VB.CommandButton lg
+ Caption = "login"
+ 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
- Top = 1350
- Width = 11670
+ Top = 1335
+ 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
Begin VB.CommandButton pic
Caption = "图片"
Height = 300
- Left = 11400
- TabIndex = 15
+ Left = 10905
+ TabIndex = 14
Top = 90
Width = 600
End
Begin VB.CommandButton manager
Caption = "商品"
Height = 300
- Left = 10500
- TabIndex = 14
+ Left = 10170
+ TabIndex = 13
Top = 90
Width = 600
End
Begin VB.CommandButton alibaba
Caption = "1688"
Height = 300
- Left = 9600
- TabIndex = 13
+ Left = 9435
+ TabIndex = 12
Top = 90
Width = 600
End
@@ -45,15 +101,15 @@ Begin VB.Form Frm_Main
Caption = "OA"
Height = 300
Left = 8700
- TabIndex = 12
+ TabIndex = 11
Top = 90
Width = 600
End
Begin VB.CommandButton lookitem
Caption = "查看商品"
Height = 300
- Left = 12300
- TabIndex = 11
+ Left = 11640
+ TabIndex = 10
Top = 90
Width = 945
End
@@ -61,7 +117,7 @@ Begin VB.Form Frm_Main
Height = 915
Index = 2
Left = 9750
- TabIndex = 10
+ TabIndex = 9
Top = 1350
Width = 1155
ExtentX = 2037
@@ -109,13 +165,6 @@ Begin VB.Form Frm_Main
ViewID = "{0057D0E0-3573-11CF-AE69-08002B2E1262}"
Location = "http:///"
End
- Begin VB.ListBox List1
- Height = 7620
- Left = 16830
- TabIndex = 8
- Top = 1695
- Width = 1035
- End
Begin VB.ListBox List2
Height = 780
Left = 45
@@ -180,8 +229,8 @@ Begin VB.Form Frm_Main
AutoSize = -1 'True
Caption = "页数"
Height = 180
- Left = 13410
- TabIndex = 9
+ Left = 14550
+ TabIndex = 8
Top = 150
Width = 360
End
@@ -210,36 +259,32 @@ Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
+Private Savetime As Double
Dim strUrl As String
-Dim dWinFolder As New ShellWindows
-Dim WithEvents eventIE As WebBrowser_V1
-Attribute eventIE.VB_VarHelpID = -1
+Dim uid As String
+Dim username As String
+Dim password As String
+Dim showmsg As Boolean
+Dim gsmc As String
-Private Sub Form_Load()
- Dim objIE As Object
- 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
+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).Navigate2 "http://192.168.0.8:83/"
-'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
@@ -250,19 +295,6 @@ Private Sub Form_Resize()
web(i).Height = lefthg / 2
web(i).Left = 10
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
Private Sub getfp(webb As WebBrowser)
@@ -276,9 +308,9 @@ Private Sub getfp(webb As WebBrowser)
ERR.clear
itemurl = vDoc.getelementsbytagname("input")("pictureUrl").Value
If ERR <> 0 Then
- itempicurl = vDoc.getelementsbytagname("input")("pictureUrl")(0).Value
+ 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
@@ -290,6 +322,7 @@ Private Sub getfp(webb As WebBrowser)
End Sub
Private Function resetfilename(ByVal name As String) As String
+ On Error Resume Next
name = clear(name, "/")
name = clear(name, "\")
name = clear(name, "*")
@@ -309,6 +342,42 @@ Private Sub Form_Unload(Cancel As Integer)
End
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()
web(0).Visible = Not web(0).Visible
showweb (0)
@@ -321,7 +390,6 @@ Private Sub Label2_Click()
Set vDoc = web(0).Document
On Error Resume Next
For i = 0 To vDoc.All.length - 1
- List1.AddItem vDoc.All(i).TagName
Set vTag_2 = vDoc.All(i - 2)
Set vTag_1 = vDoc.All(i - 1)
Set vTag = vDoc.All(i)
@@ -348,6 +416,32 @@ Private Sub Label5_Click()
Next
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()
Frm_Download.Show
End Sub
@@ -355,6 +449,19 @@ 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
+
+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://offer.1688.com/offer/manage.htm?show_type=valid&tracelog=work_1_m_orderManage
'http://login.1688.com/member/signout.htm
@@ -396,6 +503,7 @@ End Sub
'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
@@ -405,14 +513,15 @@ Private Sub web_DownloadComplete(index As Integer)
urlT(index).ForeColor = vbBlue
Me.Caption = "Load Complete"
showweb (index)
- List1.clear
- List2.clear
Dim vDoc, vTag_2, vTag_1, vTag, vTag1, vTag2, vTXT
Dim i As Integer
Set vDoc = web(index).Document
'On Error Resume Next
- For i = 0 To vDoc.All.length - 1
- List1.AddItem vDoc.All(i).TagName
+ 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
+ For i = 2 To vDoc.All.length - 1
On Error Resume Next
Set vTag_2 = vDoc.All(i - 2)
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)
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 _
@@ -434,7 +544,7 @@ Private Sub web_DownloadComplete(index As Integer)
en = InStr(st, vTag.innerhtml, "jpg") + 3
itemurl = Mid(vTag.innerhtml, st, en - st)
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 Frm_Download.UName.AddItemNotSame(itemurl) 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
Case "META"
- '商品展示部分直接获取首图信息
+ '商品展示部分直接获取首图信息
If vTag.Property = "og:image" And vTag1.Property = "og:title" Then
itemurl = urlreset(vTag.content)
itemname = vTag1.content
@@ -456,44 +566,6 @@ Private Sub web_DownloadComplete(index As Integer)
End If
End If
End If
-
- '
- '
-
- ' ' 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
Next
End Sub
@@ -502,14 +574,14 @@ 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
+ 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
+ Dim st, en
'Debug.Print url
st = InStr(1, url, "http://") + Len("http://")
st = InStr(st + 1, url, "/") + Len("/")
diff --git a/MainBas.bas b/MainBas.bas
new file mode 100644
index 0000000..f84c0a9
--- /dev/null
+++ b/MainBas.bas
@@ -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
diff --git a/棣栧浘瀵煎嚭宸ュ叿.vbp b/棣栧浘瀵煎嚭宸ュ叿.vbp
index 737072b..065cd11 100644
--- a/棣栧浘瀵煎嚭宸ュ叿.vbp
+++ b/棣栧浘瀵煎嚭宸ュ叿.vbp
@@ -7,9 +7,12 @@ UserControl=..\VB
UserControl=..\VB用户控件\TzListBox.ctl
Form=Frm_Download.frm
UserControl=..\VB用户控件\TzProgressBar.ctl
+Module=MainBas; MainBas.bas
+UserControl=..\VB用户控件\Frm_Tols.ctl
Startup="Frm_Main"
HelpFile=""
ExeName32="首图导出工具.exe"
+Path32="C:\Users\Administrator\Desktop"
Command32=""
Name="导出商品首图"
HelpContextID="0"
diff --git a/棣栧浘瀵煎嚭宸ュ叿.vbw b/棣栧浘瀵煎嚭宸ュ叿.vbw
index 850b36a..cf700a2 100644
--- a/棣栧浘瀵煎嚭宸ュ叿.vbw
+++ b/棣栧浘瀵煎嚭宸ュ叿.vbw
@@ -1,5 +1,8 @@
-Frm_Main = 0, 0, 984, 374, , 0, 0, 1070, 535, C
-TzDownload = 0, 0, 0, 0, C, 0, 0, 0, 0, C
-TzListBox = 0, 0, 0, 0, C, 0, 0, 0, 0, C
-Frm_Download = 44, 44, 1095, 418, , 110, 110, 1094, 484, C
-TzProgressBar = 0, 0, 0, 0, C, 0, 0, 0, 0, C
+Frm_Main = 22, 22, 1006, 396, Z, 44, 44, 1028, 418, C
+TzDownload = 0, 0, 0, 0, C, 0, 0, 984, 374, C
+TzListBox = 0, 0, 0, 0, C, 22, 22, 1006, 396, C
+Frm_Download = 0, 0, 984, 374, , 110, 110, 1094, 484, 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