502647092/LoadFirstPic
1
0
Fork 0
mirror of https://e.coding.net/circlecloud/LoadFirstPic.git synced 2025-11-24 21:36:15 +00:00
Code Releases Activity

update project...

Browse Source 
Signed-off-by: j502647092 <jtb1@163.com>
This commit is contained in:
j502647092
2015-06-10 20:35:29 +08:00
parent 9f08008b4c
commit ef86f828a9
4 changed files with 355 additions and 1231 deletions
Download Patch File Download Diff File Expand all files Collapse all files

496
Frm_Main.frm
View File

@@ -5,59 +5,159 @@ Begin VB.Form Frm_Main
ClientHeight = 9390 ClientHeight = 9390
ClientLeft = 120 ClientLeft = 120
ClientTop = 450 ClientTop = 450
ClientWidth = 17160 ClientWidth = 19035
LinkTopic = "Form1" LinkTopic = "Form1"
ScaleHeight = 9390 ScaleHeight = 9390
ScaleWidth = 17160 ScaleWidth = 19035
StartUpPosition = 3 '<27><><EFBFBD><EFBFBD>ȱʡ StartUpPosition = 3 '<27><><EFBFBD><EFBFBD>ȱʡ
Begin VB.CommandButton alibaba Begin <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ʒ<EFBFBD><EFBFBD>ͼ.TzListBox UName
Caption = "1688" Height = 1170
Height = 300 Left = 8835
Left = 16530 TabIndex = 28
TabIndex = 19 Top = 4440
Top = 420 Width = 3795
Width = 600 _ExtentX = 6694
_ExtentY = 2064
End
Begin <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ʒ<EFBFBD><C6B7>ͼ.TzListBox SName
Height = 1335
Left = 8835
TabIndex = 27
Top = 3135
Width = 3810
_ExtentX = 6720
_ExtentY = 2355
End
Begin SHDocVwCtl.WebBrowser web
Height = 915
Index = 1
Left = 8580
TabIndex = 8
Top = 1335
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
Index = 2
Left = 9750
TabIndex = 26
Top = 1350
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 End
Begin VB.CommandButton oa Begin VB.CommandButton oa
Caption = "OA" Caption = "OA"
Height = 300 Height = 300
Left = 16530 Left = 16425
TabIndex = 18 TabIndex = 23
Top = 75 Top = 60
Width = 600 Width = 600
End End
Begin VB.CommandButton alibaba
Caption = "1688"
Height = 300
Left = 16425
TabIndex = 22
Top = 360
Width = 600
End
Begin VB.CommandButton manager
Caption = "<22><>Ʒ"
Height = 300
Left = 16425
TabIndex = 21
Top = 660
Width = 600
End
Begin VB.CommandButton pic
Caption = "ͼƬ"
Height = 300
Left = 16425
TabIndex = 20
Top = 960
Width = 600
End
Begin VB.ListBox List1
Height = 7620
Left = 16830
TabIndex = 18
Top = 1695
Width = 1035
End
Begin VB.ListBox List2
Height = 780
Left = 45
TabIndex = 17
Top = 9315
Width = 17145
End
Begin VB.TextBox itempicurl Begin VB.TextBox itempicurl
Height = 300 Height = 300
Index = 2 Index = 2
Left = 12810 Left = 12810
TabIndex = 15 TabIndex = 14
Top = 840 Top = 960
Width = 4320 Width = 3600
End End
Begin VB.TextBox itemname Begin VB.TextBox itemname
Height = 300 Height = 300
Index = 2 Index = 2
Left = 9570 Left = 9570
TabIndex = 14 TabIndex = 13
Top = 840 Top = 960
Width = 2370 Width = 2370
End End
Begin VB.TextBox urlT Begin VB.TextBox urlT
Height = 270 Height = 270
Index = 2 Index = 2
Left = 945 Left = 8700
TabIndex = 12 TabIndex = 12
Text = "Text1" Text = "2"
Top = 405 Top = 420
Width = 7710 Width = 7710
End End
Begin VB.TextBox urlT Begin VB.TextBox urlT
Height = 270 Height = 270
Index = 1 Index = 1
Left = 8760 Left = 945
TabIndex = 10 TabIndex = 10
Text = "Text1" Text = "1"
Top = 105 Top = 420
Width = 7710 Width = 7710
End End
Begin VB.TextBox urlT Begin VB.TextBox urlT
@@ -72,42 +172,52 @@ Begin VB.Form Frm_Main
Begin <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ʒ<EFBFBD><C6B7>ͼ.TzDownload dl Begin <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ʒ<EFBFBD><C6B7>ͼ.TzDownload dl
Height = 195 Height = 195
Index = 1 Index = 1
Left = 30 Left = 930
Top = 1185 Top = 713
Width = 17070 Width = 7710
_ExtentX = 30110 _ExtentX = 13600
_ExtentY = 344 _ExtentY = 344
ForeColor = 33023 ForeColor = 33023
End End
Begin VB.TextBox folder Begin VB.TextBox folder
Height = 300 Height = 300
Left = 9795 Left = 9735
TabIndex = 6 TabIndex = 6
Top = 420 Top = 90
Width = 6675 Width = 6675
End End
Begin VB.TextBox itemname Begin VB.TextBox itemname
Height = 300 Height = 300
Index = 1 Index = 1
Left = 945 Left = 1815
TabIndex = 4 TabIndex = 4
Top = 840 Top = 960
Width = 2370 Width = 2370
End End
Begin VB.TextBox itempicurl Begin VB.TextBox itempicurl
Height = 300 Height = 300
Index = 1 Index = 1
Left = 4200 Left = 5070
TabIndex = 2 TabIndex = 2
Top = 840 Top = 960
Width = 4440 Width = 3600
End
Begin <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ʒ<EFBFBD><C6B7>ͼ.TzDownload dl
Height = 195
Index = 2
Left = 8700
Top = 713
Width = 7710
_ExtentX = 13600
_ExtentY = 344
ForeColor = 33023
End End
Begin SHDocVwCtl.WebBrowser web Begin SHDocVwCtl.WebBrowser web
Height = 7665 Height = 7665
Index = 0 Index = 0
Left = 45 Left = 45
TabIndex = 3 TabIndex = 3
Top = 1695 Top = 1335
Width = 8535 Width = 8535
ExtentX = 15055 ExtentX = 15055
ExtentY = 13520 ExtentY = 13520
@@ -128,75 +238,40 @@ Begin VB.Form Frm_Main
ViewID = "{0057D0E0-3573-11CF-AE69-08002B2E1262}" ViewID = "{0057D0E0-3573-11CF-AE69-08002B2E1262}"
Location = "http:///" Location = "http:///"
End End
Begin SHDocVwCtl.WebBrowser web Begin VB.Label Label9
Height = 7665 AutoSize = -1 'True
Index = 1 Caption = "<22><>ͼ<EFBFBD><CDBC>Ϣ:"
Left = 8625 Height = 180
TabIndex = 8 Left = 120
Top = 1695 TabIndex = 25
Width = 8490 Top = 1020
ExtentX = 14975 Width = 810
ExtentY = 13520
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 End
Begin <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ʒ<EFBFBD><EFBFBD>ͼ.TzDownload dl Begin VB.Label Label8
Height = 195 AutoSize = -1 'True
Index = 2 Caption = "<22><><EFBFBD><EFBFBD>״̬:"
Left = 30 Height = 180
Top = 1440 Left = 120
Width = 17070 TabIndex = 24
_ExtentX = 30110 Top = 720
_ExtentY = 344 Width = 810
ForeColor = 33023
End End
Begin SHDocVwCtl.WebBrowser web Begin VB.Label pages
Height = 7665 AutoSize = -1 'True
Index = 2 Caption = "ҳ<><D2B3>"
Left = 8625 Height = 180
TabIndex = 13 Left = 17310
Top = 1710 TabIndex = 19
Width = 8490 Top = 885
ExtentX = 14975 Width = 360
ExtentY = 13520
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 End
Begin VB.Label Label7 Begin VB.Label Label7
AutoSize = -1 'True AutoSize = -1 'True
Caption = "<22><>ͼ<EFBFBD><CDBC><EFBFBD><EFBFBD>:" Caption = "<22><>ͼ<EFBFBD><CDBC><EFBFBD><EFBFBD>:"
Height = 180 Height = 180
Left = 11985 Left = 11985
TabIndex = 17 TabIndex = 16
Top = 900 Top = 1020
Width = 810 Width = 810
End End
Begin VB.Label Label6 Begin VB.Label Label6
@@ -204,8 +279,8 @@ Begin VB.Form Frm_Main
Caption = "<22><>Ʒ<EFBFBD><C6B7><EFBFBD><EFBFBD>:" Caption = "<22><>Ʒ<EFBFBD><C6B7><EFBFBD><EFBFBD>:"
Height = 180 Height = 180
Left = 8760 Left = 8760
TabIndex = 16 TabIndex = 15
Top = 900 Top = 1020
Width = 810 Width = 810
End End
Begin VB.Label Label5 Begin VB.Label Label5
@@ -214,39 +289,39 @@ Begin VB.Form Frm_Main
Height = 180 Height = 180
Left = 120 Left = 120
TabIndex = 11 TabIndex = 11
Top = 450 Top = 465
Width = 810 Width = 810
End End
Begin VB.Label Label4 Begin VB.Label Label4
AutoSize = -1 'True AutoSize = -1 'True
Caption = "<22>ļ<EFBFBD><C4BC><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>:" Caption = "<22>ļ<EFBFBD><C4BC><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>:"
Height = 180 Height = 180
Left = 8760 Left = 8700
TabIndex = 7 TabIndex = 7
Top = 450 Top = 150
Width = 990 Width = 990
End End
Begin VB.Label Label2 Begin VB.Label Label2
AutoSize = -1 'True AutoSize = -1 'True
Caption = "<22><>Ʒ<EFBFBD><C6B7><EFBFBD><EFBFBD>:" Caption = "<22><>Ʒ<EFBFBD><C6B7><EFBFBD><EFBFBD>:"
Height = 180 Height = 180
Left = 120 Left = 990
TabIndex = 5 TabIndex = 5
Top = 900 Top = 1020
Width = 810 Width = 810
End End
Begin VB.Label Label3 Begin VB.Label Label3
AutoSize = -1 'True AutoSize = -1 'True
Caption = "<22><>ͼ<EFBFBD><CDBC><EFBFBD><EFBFBD>:" Caption = "<22><>ͼ<EFBFBD><CDBC><EFBFBD><EFBFBD>:"
Height = 180 Height = 180
Left = 3375 Left = 4245
TabIndex = 1 TabIndex = 1
Top = 900 Top = 1020
Width = 810 Width = 810
End End
Begin VB.Label Label1 Begin VB.Label Label1
AutoSize = -1 'True AutoSize = -1 'True
Caption = "<22><>ҳ<EFBFBD><D2B3><EFBFBD><EFBFBD>:" Caption = "<22><>ҳ<EFBFBD><D2B3><EFBFBD><EFBFBD>:"
Height = 180 Height = 180
Left = 120 Left = 120
TabIndex = 0 TabIndex = 0
@@ -266,14 +341,6 @@ 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 dl_OnFinished(index As Integer, ByVal Result As Boolean)
dl(index).Tag = True
End Sub
Private Sub dl_OnStart(index As Integer)
dl(index).Tag = False
End Sub
Private Sub Form_Load() Private Sub Form_Load()
web(0).Navigate2 "http://192.168.0.8:83/" web(0).Navigate2 "http://192.168.0.8:83/"
End Sub End Sub
@@ -282,75 +349,136 @@ Private Sub Form_Resize()
On Error Resume Next On Error Resume Next
Dim lefthg Dim lefthg
web(0).Top = 1300
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 / 3 * 2 - 350 web(0).Height = lefthg - 250
web(0).Top = 1700
web(0).Left = 10 web(0).Left = 10
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
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
web(1).Width = Me.Width - 50 SName.Width = web(0).Width / 2
web(1).Top = 1700 + web(0).Height + 20 SName.Top = web(0).Top + lefthg / 2
web(1).Height = lefthg / 3 - 350 SName.Height = lefthg / 3 * 2
web(1).Left = 10 SName.Left = 10
web(2).Width = Me.Width - 50 UName.Width = web(0).Width / 2
web(2).Top = 1700 + web(0).Height + 20 UName.Top = web(0).Top + lefthg / 2
web(2).Height = lefthg / 3 - 350 UName.Height = lefthg / 3 * 2
web(2).Left = 10 UName.Left = 10 + SName.Width
dl(1).Left = 10
dl(1).Width = Me.Width - 20
dl(2).Left = 10 List1.Left = Me.Width - List1.Width - 350
dl(2).Width = Me.Width - 20 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)
On Error Resume Next On Error Resume Next
Dim i, j, vDoc Dim i, J, vDoc
Dim ix As Long Dim ix As Long
ix = webb.index ix = webb.index
Set vDoc = webb.Document Set vDoc = webb.Document
itemname(ix) = resetfilename(vDoc.getelementsbytagname("input")("subject").Value) itemname(ix) = resetfilename(vDoc.getelementsbytagname("input")("subject").Value)
ERR.clear ERR.Clear
itempicurl(ix) = vDoc.getelementsbytagname("input")("pictureUrl").Value itempicurl(ix) = vDoc.getelementsbytagname("input")("pictureUrl").Value
If ERR <> 0 Then If ERR <> 0 Then
itempicurl(ix) = vDoc.getelementsbytagname("input")("pictureUrl")(0).Value itempicurl(ix) = vDoc.getelementsbytagname("input")("pictureUrl")(0).Value
End If End If
If folder = "" Then folder = InputBox("<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>-<2D><>ͼ-<2D><>˾<EFBFBD><CBBE><EFBFBD><EFBFBD>-<2D>ᵥ<EFBFBD><E1B5A5><EFBFBD><EFBFBD><EFBFBD><EFBFBD>!", , Format(Now, "m.d") & "-<2D><>ͼ-<2D><>˾<EFBFBD><CBBE><EFBFBD><EFBFBD>-<2D>ᵥ<EFBFBD><E1B5A5><EFBFBD><EFBFBD><EFBFBD><EFBFBD>") If folder = "" Then folder = InputBox("<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>-<2D><>ͼ-<2D><>˾<EFBFBD><CBBE><EFBFBD><EFBFBD>-<2D><EFBFBD><EFBFBD><EFBFBD><EFBFBD>˺<EFBFBD>-<2D>ᵥ<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>!", , Format(Now, "m.d") & "-<2D><>ͼ-<2D><>˾<EFBFBD><CBBE><EFBFBD><EFBFBD>-<2D><EFBFBD><EFBFBD><EFBFBD><EFBFBD>˺<EFBFBD>-<2D>ᵥ<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>")
If folder = "" Then folder = Format(Now, "m.d") & "-<2D><>ͼ-<2D><>˾<EFBFBD><CBBE><EFBFBD><EFBFBD>-<2D><><EFBFBD><EFBFBD><EFBFBD>˺<EFBFBD>-<2D>ᵥ<EFBFBD><E1B5A5><EFBFBD><EFBFBD><EFBFBD><EFBFBD>"
If Len(itemname(ix)) = 0 And Len(itempicurl(ix)) = 0 Then Exit Sub
For i = dl.LBound To dl.UBound For i = dl.LBound To dl.UBound
If dl(i).Tag Then dl(i).FileDownload itempicurl(ix), App.Path & "\" & folder.Text & "\" & itemname(ix).Text & ".jpg": dl(i).Tag = False: Exit For If dl(i).IsFree Then dl(i).FileDownload itempicurl(ix), App.Path & "\" & folder.Text & "\" & itemname(ix).Text & ".jpg": dl(i).Tag = False: Exit For
Next Next
itemname(ix) = ""
itempicurl(ix) = ""
End Sub End Sub
Private Function resetfilename(ByVal name As String) As String Private Function resetfilename(ByVal name As String) As String
name = clear(name, "/") name = Clear(name, "/")
name = clear(name, "\") name = Clear(name, "\")
name = clear(name, "*") name = Clear(name, "*")
name = clear(name, "?") name = Clear(name, "?")
name = clear(name, "<") name = Clear(name, "<")
name = clear(name, ">") name = Clear(name, ">")
resetfilename = name resetfilename = name
End Function End Function
Private Function clear(name As String, p As String) As String Private Function Clear(name As String, p As String) As String
clear = Replace(name, p, "") Clear = Replace(name, p, "")
End Function End Function
Private Sub Label1_Click() Private Sub Label1_Click()
Dim i web(0).Visible = Not web(0).Visible
For i = web.LBound To web.UBound showweb (0)
web(i).Stop End Sub
Private Sub Label2_Click()
'A A A DIV DIV
Dim vDoc, vTag_2, vTag_1, vTag, vTag1, vTag2, vTXT
Dim i As Integer
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)
Set vTag1 = vDoc.All(i + 1)
Set vTag2 = vDoc.All(i + 2)
Select Case UCase(vDoc.All(i).TagName)
Case "A"
If UCase(vTag_2.TagName) = "A" And _
UCase(vTag_1.TagName) = "A" And _
UCase(vTag1.TagName) = "DIV" And _
UCase(vTag2.TagName) = "DIV" Then
If vTag.class = "next" Then vTag.Click
End If
End Select
Next Next
End Sub End Sub
Private Sub Label5_Click()
On Error Resume Next
Dim i As Long
For i = web.LBound To web.UBound
web(i).Stop
web(i).Tag = True
Next
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
'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
Private Sub oa_Click() Private Sub oa_Click()
web(0).Navigate2 "http://192.168.0.8:83/" web(0).Navigate2 "http://192.168.0.8:83/"
End Sub End Sub
Private Sub urlT_Click(index As Integer) Private Sub pic_Click()
web(0).Navigate2 "http://picman.1688.com/album/album_list.htm?tracelog=work_1_m_albumManage"
End Sub
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
@@ -361,14 +489,18 @@ 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
'List3.AddItem url
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
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
Me.Caption = "Loading..."
End Sub End Sub
'Private Sub web_DownloadBegin(index As Integer) 'Private Sub web_DownloadBegin(index As Integer)
@@ -376,22 +508,96 @@ End Sub
'End Sub 'End Sub
Private Sub web_DownloadComplete(index As Integer) Private Sub web_DownloadComplete(index As Integer)
Dim target, title, class
web(index).Silent = True web(index).Silent = True
web(index).Tag = True web(index).Tag = True
urlT(index).Enabled = True
urlT(index).ForeColor = vbBlue
Me.Caption = "Load Complete"
showweb (index) 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
On Error Resume Next
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)
Case "TD"
Case "A"
Dim st
Dim en
If UCase(vTag_2.TagName) = "INPUT" And _
UCase(vTag_1.TagName) = "TD" And _
UCase(vTag1.TagName) = "IMG" And _
UCase(vTag2.TagName) = "TD" Then
If vTag.target = "_blank" Then
If SName.AddItemNotSame(vTag.title) Then
st = InStr(1, vTag.innerhtml, "data-lazyload-src=""") + Len("data-lazyload-src=""")
en = InStr(st, vTag.innerhtml, """")
UName.AddItemNotSame Replace(Mid(vTag.innerhtml, st, en - st), ".64x64", "")
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 = "<22>޸<EFBFBD>" Then List2.AddItem vTag.href
' End If
Case "B"
'A SPAN<41><4E>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 = "<22><>ǰ<EFBFBD><C7B0><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>" & vTag.innerhtml & "<22><>!"
' 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 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)
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): Exit For If web(i).Tag Then Set ppDisp = web(i).Object: showweb (i): pages = "<22>Ѽ<EFBFBD><D1BC><EFBFBD>...": Exit Sub
Next Next
pages = "δ<><CEB4><EFBFBD><EFBFBD>..."
Cancel = True
End Sub End Sub
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
Next Next
web(index).Visible = True web(index).Visible = True
End Sub End Sub

1084
fp.html
View File

File diff suppressed because one or more lines are too long

1
首图导出工具.vbp
View File

@@ -4,6 +4,7 @@ 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\winhttp.dll#Microsoft WinHTTP Services, version 5.1
Form=Frm_Main.frm Form=Frm_Main.frm
UserControl=..\VB<56>û<EFBFBD><C3BB>ؼ<EFBFBD>\TzDownload.ctl UserControl=..\VB<56>û<EFBFBD><C3BB>ؼ<EFBFBD>\TzDownload.ctl
UserControl=..\VB<56>û<EFBFBD><C3BB>ؼ<EFBFBD>\TzListBox.ctl
Startup="Frm_Main" Startup="Frm_Main"
HelpFile="" HelpFile=""
ExeName32="<22><>ͼ<EFBFBD><CDBC><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>.exe" ExeName32="<22><>ͼ<EFBFBD><CDBC><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>.exe"

5
首图导出工具.vbw
View File

@@ -1,2 +1,3 @@
Frm_Main = 30, 95, 916, 544, , 50, 50, 1161, 739, C Frm_Main = 22, 22, 940, 557, , 0, 0, 918, 535, C
TzDownload = 25, 25, 911, 474, , 75, 75, 961, 524, C TzDownload = 22, 22, 1073, 396, C, 75, 75, 961, 524, C
TzListBox = 107, 171, 1025, 706, C, 22, 22, 940, 557, C