2015-06-06 08:33:57 +00:00
VERSION 5.00
Object = "{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}#1.1#0"; "ieframe.dll"
Begin VB.Form Frm_Main
Caption = "<22> <> <EFBFBD> <EFBFBD> <EFBFBD> <EFBFBD> ͼ"
ClientHeight = 9390
ClientLeft = 120
ClientTop = 450
2015-06-10 12:35:29 +00:00
ClientWidth = 19035
2015-06-06 08:33:57 +00:00
LinkTopic = "Form1"
ScaleHeight = 9390
2015-06-10 12:35:29 +00:00
ScaleWidth = 19035
2015-07-01 07:31:22 +00:00
StartUpPosition = 2 '<27> <> Ļ<EFBFBD> <C4BB> <EFBFBD> <EFBFBD>
2015-07-13 01:49:33 +00:00
Begin <20> <> <EFBFBD> <EFBFBD> <EFBFBD> <EFBFBD> Ʒ <EFBFBD> <C6B7> ͼ.TzButton getindex
2015-07-01 07:31:22 +00:00
Height = 300
2015-07-13 07:07:56 +00:00
Left = 12360
2015-07-01 07:31:22 +00:00
Top = 90
2015-07-13 01:49:33 +00:00
Width = 1305
_ExtentX = 2302
_ExtentY = 529
Caption = "<22> <> <EFBFBD> <EFBFBD> <EFBFBD> <EFBFBD> ҳ<EFBFBD> <D2B3> Ʒ "
BackColor = 16776960
StartColor = 16776960
FinshColor = 16777088
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "<22> <> <EFBFBD> <EFBFBD> "
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
2015-07-01 07:31:22 +00:00
End
2015-07-13 01:49:33 +00:00
Begin <20> <> <EFBFBD> <EFBFBD> <EFBFBD> <EFBFBD> Ʒ <EFBFBD> <C6B7> ͼ.TzButton lookitem
Height = 300
2015-07-13 07:07:56 +00:00
Left = 11130
2015-07-13 01:49:33 +00:00
Top = 90
2015-07-13 07:07:56 +00:00
Width = 1215
_ExtentX = 2143
2015-07-13 01:49:33 +00:00
_ExtentY = 529
2015-07-13 07:07:56 +00:00
Caption = "<22> <> <EFBFBD> <EFBFBD> <EFBFBD> <EFBFBD> Ʒ <EFBFBD> <C6B7> ͼ"
2015-07-13 01:49:33 +00:00
BackColor = 65280
StartColor = 65280
FinshColor = 8454016
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "<22> <> <EFBFBD> <EFBFBD> "
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
2015-06-15 11:02:59 +00:00
End
2015-06-11 12:23:20 +00:00
Begin VB.CommandButton pic
Caption = "ͼƬ"
Height = 300
2015-07-13 01:49:33 +00:00
Left = 10455
TabIndex = 13
2015-06-11 12:23:20 +00:00
Top = 90
Width = 600
2015-06-10 12:35:29 +00:00
End
2015-06-11 12:23:20 +00:00
Begin VB.CommandButton manager
Caption = "<22> <> Ʒ "
Height = 300
2015-07-13 01:49:33 +00:00
Left = 9870
TabIndex = 12
2015-06-11 12:23:20 +00:00
Top = 90
Width = 600
End
Begin VB.CommandButton alibaba
Caption = "1688"
Height = 300
2015-07-13 01:49:33 +00:00
Left = 9285
TabIndex = 11
2015-06-11 12:23:20 +00:00
Top = 90
Width = 600
End
2015-07-13 01:49:33 +00:00
Begin VB.CommandButton putpwd
Caption = "<22> <> д<EFBFBD> <D0B4> <EFBFBD> <EFBFBD> "
2015-06-11 12:23:20 +00:00
Height = 300
2015-07-13 07:07:56 +00:00
Left = 14745
2015-07-13 01:49:33 +00:00
TabIndex = 16
2015-06-11 12:23:20 +00:00
Top = 90
2015-07-13 01:49:33 +00:00
Width = 1000
2015-06-11 12:23:20 +00:00
End
2015-07-13 01:49:33 +00:00
Begin VB.CommandButton loginadmin
Caption = "<22> <> ¼<EFBFBD> <C2BC> ̨"
2015-06-11 12:23:20 +00:00
Height = 300
2015-07-13 07:07:56 +00:00
Left = 13755
2015-07-13 01:49:33 +00:00
TabIndex = 15
Top = 90
Width = 1000
End
Begin <20> <> <EFBFBD> <EFBFBD> <EFBFBD> <EFBFBD> Ʒ <EFBFBD> <C6B7> ͼ.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
2015-06-15 11:02:59 +00:00
TabIndex = 10
2015-06-11 12:23:20 +00:00
Top = 90
2015-07-13 01:49:33 +00:00
Width = 600
2015-06-10 12:35:29 +00:00
End
Begin SHDocVwCtl.WebBrowser web
Height = 915
2015-06-11 12:23:20 +00:00
Index = 2
Left = 9750
2015-06-15 11:02:59 +00:00
TabIndex = 9
2015-06-11 12:23:20 +00:00
Top = 1350
2015-06-10 12:35:29 +00:00
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
2015-06-11 12:23:20 +00:00
Index = 1
Left = 8580
TabIndex = 2
Top = 1335
2015-06-10 12:35:29 +00:00
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
2015-06-11 12:23:20 +00:00
TabIndex = 7
2015-06-10 12:35:29 +00:00
Top = 9315
Width = 17145
End
2015-06-08 12:06:30 +00:00
Begin VB.TextBox urlT
Height = 270
Index = 2
2015-06-10 12:35:29 +00:00
Left = 8700
2015-06-11 12:23:20 +00:00
TabIndex = 6
2015-06-10 12:35:29 +00:00
Text = "2"
2015-06-11 12:23:20 +00:00
Top = 480
2015-06-08 12:06:30 +00:00
Width = 7710
2015-06-06 08:33:57 +00:00
End
2015-06-08 12:06:30 +00:00
Begin VB.TextBox urlT
Height = 270
Index = 1
2015-06-10 12:35:29 +00:00
Left = 945
2015-06-11 12:23:20 +00:00
TabIndex = 4
2015-06-10 12:35:29 +00:00
Text = "1"
2015-06-11 12:23:20 +00:00
Top = 480
2015-06-08 12:06:30 +00:00
Width = 7710
2015-06-06 08:33:57 +00:00
End
2015-06-08 12:06:30 +00:00
Begin VB.TextBox urlT
Height = 270
Index = 0
Left = 945
2015-06-11 12:23:20 +00:00
TabIndex = 3
2015-06-08 12:06:30 +00:00
Text = "Text1"
Top = 105
Width = 7710
End
Begin SHDocVwCtl.WebBrowser web
Height = 7665
Index = 0
Left = 45
2015-06-11 12:23:20 +00:00
TabIndex = 1
2015-06-10 12:35:29 +00:00
Top = 1335
2015-06-08 12:06:30 +00:00
Width = 8535
ExtentX = 15055
ExtentY = 13520
2015-06-06 08:33:57 +00:00
ViewMode = 0
Offline = 0
Silent = 0
2015-06-08 12:06:30 +00:00
RegisterAsBrowser= 1
2015-06-06 08:33:57 +00:00
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
2015-07-13 01:49:33 +00:00
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
2015-06-10 12:35:29 +00:00
Begin VB.Label pages
AutoSize = -1 'True
Caption = "ҳ<> <D2B3> "
Height = 180
2015-07-13 07:07:56 +00:00
Left = 15855
2015-06-15 11:02:59 +00:00
TabIndex = 8
2015-06-11 12:23:20 +00:00
Top = 150
2015-06-10 12:35:29 +00:00
Width = 360
2015-06-09 10:30:04 +00:00
End
2015-06-08 12:06:30 +00:00
Begin VB.Label Label5
AutoSize = -1 'True
Caption = "<22> <> ҳ<EFBFBD> <D2B3> <EFBFBD> <EFBFBD> :"
Height = 180
Left = 120
TabIndex = 5
2015-06-11 12:23:20 +00:00
Top = 525
2015-06-06 08:33:57 +00:00
Width = 810
End
Begin VB.Label Label1
AutoSize = -1 'True
2015-06-10 12:35:29 +00:00
Caption = "<22> <> ҳ<EFBFBD> <D2B3> <EFBFBD> <EFBFBD> :"
2015-06-06 08:33:57 +00:00
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
2015-06-15 11:02:59 +00:00
Private Savetime As Double
2015-07-01 07:31:22 +00:00
Dim strURL As String
2015-06-15 11:02:59 +00:00
Dim uid As String
Dim username As String
Dim password As String
Dim showmsg As Boolean
Dim gsmc As String
2015-06-06 08:33:57 +00:00
2015-06-15 11:02:59 +00:00
Dim assistpid As Long
Dim assisthWnd As Long
2015-06-09 10:30:04 +00:00
2015-06-12 03:02:43 +00:00
Private Sub alibaba_Click()
web(0).Navigate2 "http://work.1688.com/home/page/index.htm#nav/home"
2015-06-06 08:33:57 +00:00
End Sub
2015-06-15 11:02:59 +00:00
2015-06-12 03:02:43 +00:00
'
2015-06-15 11:02:59 +00:00
Private Sub Form_Load()
web(0).Navigate "http://192.168.0.8:83/"
End Sub
2015-06-06 08:33:57 +00:00
Private Sub Form_Resize()
On Error Resume Next
Dim lefthg
2015-06-11 12:23:20 +00:00
web(0).Top = 900
2015-06-08 12:06:30 +00:00
lefthg = Me.Height - web(0).Top
2015-06-15 11:02:59 +00:00
2015-06-09 10:30:04 +00:00
web(0).Width = Me.Width - 50
2015-06-10 12:35:29 +00:00
web(0).Height = lefthg - 250
2015-06-08 12:06:30 +00:00
web(0).Left = 10
2015-12-25 09:16:31 +00:00
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
2015-06-10 12:35:29 +00:00
Next
2015-06-06 08:33:57 +00:00
End Sub
2015-06-08 12:06:30 +00:00
Private Sub getfp(webb As WebBrowser)
2015-06-06 08:33:57 +00:00
On Error Resume Next
2015-12-25 09:16:31 +00:00
Dim i, J, vDoc
2015-06-09 10:30:04 +00:00
Dim ix As Long
2015-06-11 12:23:20 +00:00
Dim itemname, itemurl
2015-12-25 09:16:31 +00:00
ix = webb.Index
2015-06-08 12:06:30 +00:00
Set vDoc = webb.Document
2015-06-11 12:23:20 +00:00
itemname = resetfilename(vDoc.getelementsbytagname("input")("subject").Value)
ERR.clear
itemurl = vDoc.getelementsbytagname("input")("pictureUrl").Value
2015-06-09 10:30:04 +00:00
If ERR <> 0 Then
2015-06-15 11:02:59 +00:00
itemurl = vDoc.getelementsbytagname("input")("pictureUrl")(0).Value
2015-06-09 10:30:04 +00:00
End If
2015-06-15 11:02:59 +00:00
2015-06-11 12:23:20 +00:00
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
2015-12-25 09:16:31 +00:00
Frm_Download.SName.AddItemNotSame resetfilename((Trim(itemname) & i) & ".jpg")
2015-06-11 12:23:20 +00:00
End If
End If
End If
2015-06-06 08:33:57 +00:00
End Sub
Private Function resetfilename(ByVal name As String) As String
2015-06-15 11:02:59 +00:00
On Error Resume Next
2015-06-15 12:26:09 +00:00
name = pclear(name, "/")
name = pclear(name, "\")
name = pclear(name, "*")
name = pclear(name, "?")
name = pclear(name, "<")
name = pclear(name, ">")
name = pclear(name, ":")
2015-06-06 08:33:57 +00:00
resetfilename = name
End Function
2015-06-15 12:26:09 +00:00
Private Function pclear(name As String, P As String) As String
pclear = Replace(name, P, "")
2015-06-06 08:33:57 +00:00
End Function
2015-06-11 12:23:20 +00:00
Private Sub Form_Unload(Cancel As Integer)
Unload Frm_Download
2015-06-12 02:47:30 +00:00
End
2015-06-11 12:23:20 +00:00
End Sub
2015-07-01 07:31:22 +00:00
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
2015-12-25 09:16:31 +00:00
Dim i As Integer
2015-07-01 07:31:22 +00:00
Set vDoc = web(0).Document
On Error Resume Next
Dim alll As Long
alll = vDoc.All.Length
On Error GoTo 0
2015-12-25 09:16:31 +00:00
For i = 2 To alll - 1
2015-07-01 07:31:22 +00:00
On Error Resume Next
2015-12-25 09:16:31 +00:00
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)
2015-07-01 07:31:22 +00:00
Case "TD"
Case "A"
'<27> <> Ʒ <EFBFBD> б <EFBFBD> <D0B1> <EFBFBD> <EFBFBD> <EFBFBD> <EFBFBD> <EFBFBD> ȡ<EFBFBD> <C8A1> Ϣ
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
2015-06-09 10:30:04 +00:00
Private Sub Label1_Click()
2015-06-10 12:35:29 +00:00
web(0).Visible = Not web(0).Visible
showweb (0)
End Sub
Private Sub Label5_Click()
On Error Resume Next
2015-12-25 09:16:31 +00:00
Dim i As Long
For i = web.LBound To web.UBound
web(i).Stop
web(i).Tag = True
2015-06-09 10:30:04 +00:00
Next
End Sub
2015-06-11 12:23:20 +00:00
Private Sub lookitem_Click()
Frm_Download.Show
End Sub
2015-06-10 12:35:29 +00:00
Private Sub manager_Click()
web(0).Navigate2 "http://offer.1688.com/offer/manage.htm?show_type=valid&tracelog=work_1_m_orderManage"
End Sub
2015-06-15 11:02:59 +00:00
2015-06-10 12:35:29 +00:00
'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
2015-06-09 10:30:04 +00:00
Private Sub oa_Click()
web(0).Navigate2 "http://192.168.0.8:83/"
End Sub
2015-06-10 12:35:29 +00:00
Private Sub pic_Click()
web(0).Navigate2 "http://picman.1688.com/album/album_list.htm?tracelog=work_1_m_albumManage"
End Sub
2015-07-13 01:49:33 +00:00
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
2015-07-13 07:07:56 +00:00
Exit Sub
2015-12-25 09:16:31 +00:00
Else
MsgBox "<22> <> <EFBFBD> Ȼ<EFBFBD> ȡ<EFBFBD> ʺŵ<CABA> ¼<EFBFBD> <C2BC> Ϣ!"
Exit Sub
2015-07-13 01:49:33 +00:00
End If
tip:
2015-12-25 09:16:31 +00:00
MsgBox "<22> <> <EFBFBD> ڰ<EFBFBD> <DAB0> <EFBFBD> <EFBFBD> <EFBFBD> ¼ҳ<C2BC> <D2B3> ִ<EFBFBD> д˲<D0B4> <CBB2> <EFBFBD> ...<2E> <> <EFBFBD> <EFBFBD> <EFBFBD> <EFBFBD> <EFBFBD> <EFBFBD> : " & ERR.Number & " <20> <> <EFBFBD> <EFBFBD> <EFBFBD> <EFBFBD> <EFBFBD> <EFBFBD> : " & ERR.Description
2015-07-13 01:49:33 +00:00
End Sub
2015-12-25 09:16:31 +00:00
Private Sub urlT_DblClick(Index As Integer)
urlT(Index).SelStart = 0
urlT(Index).SelLength = Len(urlT(Index).Text)
2015-06-09 10:30:04 +00:00
End Sub
2015-12-25 09:16:31 +00:00
Private Sub urlT_KeyPress(Index As Integer, KeyAscii As Integer)
If KeyAscii = 13 Then web(Index).Navigate2 urlT(Index).Text
2015-06-08 12:06:30 +00:00
End Sub
2015-12-25 09:16:31 +00:00
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
2015-07-13 01:49:33 +00:00
If InStr(1, url, "com/my") Then web(0).Navigate2 "http://work.1688.com/home/page/index.htm#nav/home"
2015-06-08 12:06:30 +00:00
End Sub
2015-12-25 09:16:31 +00:00
Private Sub web_DocumentComplete(Index As Integer, ByVal pDisp As Object, url As Variant)
2015-06-10 12:35:29 +00:00
On Error Resume Next
2015-12-25 09:16:31 +00:00
If InStr(1, url, "operator=edit") Then Call getfp(web(Index))
2015-06-08 12:06:30 +00:00
End Sub
2015-12-25 09:16:31 +00:00
Private Sub web_DownloadBegin(Index As Integer)
web(Index).Tag = False
urlT(Index).Enabled = False
2015-06-10 12:35:29 +00:00
Me.Caption = "Loading..."
2015-06-08 12:06:30 +00:00
End Sub
2015-06-09 10:30:04 +00:00
'Private Sub web_DownloadBegin(index As Integer)
' web(index).Silent = True
'End Sub
2015-07-13 01:49:33 +00:00
Private Sub loginadmin_Click()
'On Error Resume Next
2015-07-13 07:07:56 +00:00
Dim isuse
isuse = MsgBox("<22> <> ǰ<EFBFBD> <C7B0> <EFBFBD> ܲ<EFBFBD> <DCB2> ȶ<EFBFBD> " & vbCrLf & "<22> <> <EFBFBD> <EFBFBD> <EFBFBD> <EFBFBD> <DEB7> ð<EFBFBD> <C3B0> <EFBFBD> <EFBFBD> <EFBFBD> <EFBFBD> ֵ<EFBFBD> ¼ʱʹ <CAB1> <CAB9> !" & vbCrLf & "<22> Ƿ<EFBFBD> <C7B7> <EFBFBD> <EFBFBD> <EFBFBD> ?", vbExclamation + vbYesNo)
If isuse = vbNo Then Exit Sub
2015-07-13 01:49:33 +00:00
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 = "<22> <> ȡ<EFBFBD> <C8A1> <EFBFBD> <EFBFBD> <EFBFBD> <EFBFBD> ..."
jj = MsgBox("<22> <> ˾<EFBFBD> <CBBE> <EFBFBD> <EFBFBD> : " & gsmc & vbCrLf & vbCrLf & "<22> <> ǰ<EFBFBD> û<EFBFBD> UID: " & uid & vbCrLf & "<22> <> ǰ<EFBFBD> û<EFBFBD> <C3BB> <EFBFBD> <EFBFBD> <EFBFBD> : " & username & vbCrLf _
& "<22> <> ǰ<EFBFBD> û<EFBFBD> <C3BB> <EFBFBD> <EFBFBD> <EFBFBD> : <20> Ժ<EFBFBD> <D4BA> <EFBFBD> ȡ..." & vbCrLf & vbCrLf & "<22> Ƿ<EFBFBD> <C7B7> <EFBFBD> <EFBFBD> <EFBFBD> <EFBFBD> <EFBFBD> ¼?", 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, "<22> <> <EFBFBD> <EFBFBD> ") Then
MsgBox "<22> <> <EFBFBD> <EFBFBD> <EFBFBD> <EFBFBD> <EFBFBD> <EFBFBD> ֤<EFBFBD> <D6A4> !"
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 = "<22> <> ¼<EFBFBD> ɹ<EFBFBD> ..."
Else
pages.Caption = "<22> <> ȡ<EFBFBD> <C8A1> <EFBFBD> <EFBFBD> ʧ<EFBFBD> <CAA7> ,<2C> <> ʹ <EFBFBD> ð<EFBFBD> <C3B0> <EFBFBD> <EFBFBD> <EFBFBD> <EFBFBD> ֵ<EFBFBD> ½..."
End If
End If
Else
MsgBox "<22> <> <EFBFBD> ȴ<EFBFBD> <C8B4> <EFBFBD> һ <EFBFBD> ΰ<EFBFBD> <CEB0> <EFBFBD> <EFBFBD> <EFBFBD> <EFBFBD> <EFBFBD> !"
End If
End Sub
2015-12-25 09:16:31 +00:00
Private Sub web_DownloadComplete(Index As Integer)
2015-06-15 12:26:09 +00:00
'On Error Resume Next
2015-06-11 12:23:20 +00:00
Dim target, Title, Class
Dim itemurl As String
Dim itemname As String
2015-12-25 09:16:31 +00:00
web(Index).Silent = True
web(Index).Tag = True
urlT(Index).Enabled = True
urlT(Index).ForeColor = vbBlue
2015-06-10 12:35:29 +00:00
Me.Caption = "Load Complete"
2015-12-25 09:16:31 +00:00
showweb (Index)
2015-06-10 12:35:29 +00:00
Dim vDoc, vTag_2, vTag_1, vTag, vTag1, vTag2, vTXT
2015-12-25 09:16:31 +00:00
Dim i As Integer
Set vDoc = web(Index).Document
2015-07-13 01:49:33 +00:00
On Error Resume Next
2015-12-25 09:16:31 +00:00
If InStr(1, web(Index).LocationURL, "alilogin.aspx") Then
uid = Mid(web(Index).LocationURL, InStr(1, web(Index).LocationURL, "?id=") + 4)
2015-06-15 11:02:59 +00:00
username = vDoc.getelementsbytagname("input")("TPL_username").Value
End If
2015-06-15 12:26:09 +00:00
On Error Resume Next
Dim alll As Long
2015-07-01 07:31:22 +00:00
alll = vDoc.All.Length
2015-06-15 12:26:09 +00:00
On Error GoTo 0
2015-12-25 09:16:31 +00:00
For i = 2 To alll - 1
2015-06-10 12:35:29 +00:00
On Error Resume Next
2015-12-25 09:16:31 +00:00
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)
2015-07-13 01:49:33 +00:00
username = vDoc.getelementsbytagname("input")("TPL_username").Value
End If
2015-12-25 09:16:31 +00:00
Select Case UCase(vDoc.All(i).TagName)
2015-06-10 12:35:29 +00:00
Case "TD"
Case "A"
2015-06-15 11:02:59 +00:00
'<27> <> Ʒ <EFBFBD> б <EFBFBD> <D0B1> <EFBFBD> <EFBFBD> <EFBFBD> <EFBFBD> <EFBFBD> ȡ<EFBFBD> <C8A1> Ϣ
If vTag.Title = "<22> 鿴<EFBFBD> <E9BFB4> ˾<EFBFBD> <CBBE> ϸ<EFBFBD> <CFB8> Ϣ" Then gsmc = vTag1.innerhtml
2015-06-11 12:23:20 +00:00
Dim st As Long
Dim en As Long
2015-06-10 12:35:29 +00:00
If UCase(vTag_2.TagName) = "INPUT" And _
UCase(vTag_1.TagName) = "TD" And _
UCase(vTag1.TagName) = "IMG" And _
UCase(vTag2.TagName) = "TD" Then
2015-06-11 12:23:20 +00:00
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)
2015-06-15 11:02:59 +00:00
Debug.Print itemurl
2015-06-11 12:23:20 +00:00
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
2015-07-13 01:49:33 +00:00
pages.Caption = "<22> <> ɨ<EFBFBD> 赽 " & Frm_Download.UName.ListCount & " <20> <> <EFBFBD> <EFBFBD> Ʒ !"
2015-06-11 12:23:20 +00:00
If Not (Frm_Download.SName.AddItemNotSame(resetfilename(Trim(vTag.Title) & ".jpg"))) Then
2015-12-25 09:16:31 +00:00
Frm_Download.SName.AddItemNotSame resetfilename((Trim(vTag.Title) & i) & ".jpg")
2015-06-11 12:23:20 +00:00
End If
2015-06-10 12:35:29 +00:00
End If
End If
End If
2015-06-11 12:23:20 +00:00
Case "META"
2015-06-15 11:02:59 +00:00
'<27> <> Ʒ չʾ <D5B9> <CABE> <EFBFBD> <EFBFBD> ֱ<EFBFBD> ӻ<EFBFBD> ȡ<EFBFBD> <C8A1> ͼ<EFBFBD> <CDBC> Ϣ
2015-06-12 02:47:30 +00:00
If vTag.Property = "og:image" And vTag1.Property = "og:title" Then
2015-06-11 12:23:20 +00:00
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
2015-12-25 09:16:31 +00:00
Frm_Download.SName.AddItemNotSame resetfilename((Trim(itemname) & i) & ".jpg")
2015-07-13 01:49:33 +00:00
pages.Caption = "<22> <> ɨ<EFBFBD> 赽 " & Frm_Download.UName.ListCount & " <20> <> <EFBFBD> <EFBFBD> Ʒ !"
2015-06-11 12:23:20 +00:00
End If
End If
End If
2015-06-10 12:35:29 +00:00
End If
End Select
Next
2015-06-08 12:06:30 +00:00
End Sub
2015-12-25 09:16:31 +00:00
Private Sub web_NewWindow2(Index As Integer, ppDisp As Object, Cancel As Boolean)
2015-06-11 12:23:20 +00:00
On Error Resume Next
2015-12-25 09:16:31 +00:00
Dim i
For i = 1 To web.UBound
If web(i).Tag Then Set ppDisp = web(i).object: showweb (i): pages = "<22> Ѽ<EFBFBD> <D1BC> <EFBFBD> ...": Exit Sub
2015-06-09 10:30:04 +00:00
Next
2015-06-10 12:35:29 +00:00
pages = "δ<> <CEB4> <EFBFBD> <EFBFBD> ..."
Cancel = True
2015-06-09 10:30:04 +00:00
End Sub
2015-06-11 12:23:20 +00:00
Public Function urlreset(ByVal url As String) As String
2015-06-15 11:02:59 +00:00
Dim st, en
2015-06-11 12:23:20 +00:00
'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
2015-07-13 01:49:33 +00:00
If url = "http://i01.c.aliimg.com/" Then url = ""
2015-06-11 12:23:20 +00:00
urlreset = url
'Debug.Print url
End Function
2015-12-25 09:16:31 +00:00
Private Sub showweb(Index As Long)
Dim i As Long
For i = 1 To web.UBound
web(i).Visible = False
2015-06-10 12:35:29 +00:00
List2.Visible = False
2015-06-08 12:06:30 +00:00
Next
2015-12-25 09:16:31 +00:00
web(Index).Visible = True
2015-06-08 12:06:30 +00:00
End Sub