add multasks...

Signed-off-by: j502647092 <jtb1@163.com>

Frm_Main.frm

@@ -10,14 +10,37 @@ Begin VB.Form Frm_Main
    ScaleHeight     =   9390
    ScaleWidth      =   17160
    StartUpPosition =   3  '窗口缺省
-   Begin VB.TextBox urlT 
+   Begin VB.CommandButton alibaba 
-      Height          =   270
+      Caption         =   "1688"
-      Index           =   3
+      Height          =   300
-      Left            =   8760
+      Left            =   16530
-      TabIndex        =   13
+      TabIndex        =   19
-      Text            =   "Text1"
+      Top             =   420
-      Top             =   405
+      Width           =   600
-      Width           =   7710
+   End
+   Begin VB.CommandButton oa 
+      Caption         =   "OA"
+      Height          =   300
+      Left            =   16530
+      TabIndex        =   18
+      Top             =   75
+      Width           =   600
+   End
+   Begin VB.TextBox itempicurl 
+      Height          =   300
+      Index           =   2
+      Left            =   12810
+      TabIndex        =   15
+      Top             =   840
+      Width           =   4320
+   End
+   Begin VB.TextBox itemname 
+      Height          =   300
+      Index           =   2
+      Left            =   9570
+      TabIndex        =   14
+      Top             =   840
+      Width           =   2370
    End
    Begin VB.TextBox urlT 
       Height          =   270
@@ -48,33 +71,36 @@ Begin VB.Form Frm_Main
    End
    Begin 导出商品首图.TzDownload dl 
       Height          =   195
-      Index           =   0
+      Index           =   1
       Left            =   30
       Top             =   1185
       Width           =   17070
       _ExtentX        =   30110
       _ExtentY        =   344
+      ForeColor       =   33023
    End
    Begin VB.TextBox folder 
       Height          =   300
-      Left            =   13500
+      Left            =   9795
       TabIndex        =   6
-      Top             =   840
+      Top             =   420
-      Width           =   3495
+      Width           =   6675
    End
    Begin VB.TextBox itemname 
       Height          =   300
+      Index           =   1
       Left            =   945
       TabIndex        =   4
       Top             =   840
-      Width           =   3345
+      Width           =   2370
    End
    Begin VB.TextBox itempicurl 
       Height          =   300
-      Left            =   5190
+      Index           =   1
+      Left            =   4200
       TabIndex        =   2
       Top             =   840
-      Width           =   7230
+      Width           =   4440
    End
    Begin SHDocVwCtl.WebBrowser web 
       Height          =   7665
@@ -130,12 +156,57 @@ Begin VB.Form Frm_Main
    End
    Begin 导出商品首图.TzDownload dl 
       Height          =   195
-      Index           =   1
+      Index           =   2
       Left            =   30
       Top             =   1440
       Width           =   17070
       _ExtentX        =   30110
       _ExtentY        =   344
+      ForeColor       =   33023
+   End
+   Begin SHDocVwCtl.WebBrowser web 
+      Height          =   7665
+      Index           =   2
+      Left            =   8625
+      TabIndex        =   13
+      Top             =   1710
+      Width           =   8490
+      ExtentX         =   14975
+      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
+   Begin VB.Label Label7 
+      AutoSize        =   -1  'True
+      Caption         =   "首图链接:"
+      Height          =   180
+      Left            =   11985
+      TabIndex        =   17
+      Top             =   900
+      Width           =   810
+   End
+   Begin VB.Label Label6 
+      AutoSize        =   -1  'True
+      Caption         =   "商品名称:"
+      Height          =   180
+      Left            =   8760
+      TabIndex        =   16
+      Top             =   900
+      Width           =   810
    End
    Begin VB.Label Label5 
       AutoSize        =   -1  'True
@@ -150,9 +221,9 @@ Begin VB.Form Frm_Main
       AutoSize        =   -1  'True
       Caption         =   "文件夹名称:"
       Height          =   180
-      Left            =   12465
+      Left            =   8760
       TabIndex        =   7
-      Top             =   900
+      Top             =   450
       Width           =   990
    End
    Begin VB.Label Label2 
@@ -168,7 +239,7 @@ Begin VB.Form Frm_Main
       AutoSize        =   -1  'True
       Caption         =   "首图链接:"
       Height          =   180
-      Left            =   4365
+      Left            =   3375
       TabIndex        =   1
       Top             =   900
       Width           =   810
@@ -191,42 +262,67 @@ Attribute VB_Exposed = False
 Option Explicit
 Dim strUrl As String
 
+Private Sub alibaba_Click()
+    web(0).Navigate2 "http://work.1688.com/home/page/index.htm#nav/home"
+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()
- web(0).Navigate2 "http://192.168.0.8:83/"
+    web(0).Navigate2 "http://192.168.0.8:83/"
 End Sub
 
 Private Sub Form_Resize()
     On Error Resume Next
-    web(0).Width = Me.Width - 50
+
-    web(1).Width = Me.Width - 50
-    
     Dim lefthg
     lefthg = Me.Height - web(0).Top
     
-    web(0).Height = lefthg / 2 - 350
+    web(0).Width = Me.Width - 50
-    web(1).Height = lefthg / 2 - 350
+    web(0).Height = lefthg / 3 * 2 - 350
-    
     web(0).Top = 1700
-    web(1).Top = 1700 + web(0).Height + 20
-    
     web(0).Left = 10
+    
+    web(1).Width = Me.Width - 50
+    web(1).Top = 1700 + web(0).Height + 20
+    web(1).Height = lefthg / 3 - 350
     web(1).Left = 10
     
-    dl(0).Left = 10
+    web(2).Width = Me.Width - 50
-    dl(0).Width = Me.Width - 20
+    web(2).Top = 1700 + web(0).Height + 20
+    web(2).Height = lefthg / 3 - 350
+    web(2).Left = 10
     
     dl(1).Left = 10
     dl(1).Width = Me.Width - 20
+    
+    dl(2).Left = 10
+    dl(2).Width = Me.Width - 20
 End Sub
 
 Private Sub getfp(webb As WebBrowser)
     On Error Resume Next
     Dim i, j, vDoc
+    Dim ix As Long
+    ix = webb.index
     Set vDoc = webb.Document
-    itemname = resetfilename(vDoc.getelementsbytagname("input")("subject").Value)
+    itemname(ix) = resetfilename(vDoc.getelementsbytagname("input")("subject").Value)
-    itempicurl = vDoc.getelementsbytagname("input")("pictureUrl")(0).Value
+    ERR.clear
-    If folder = "" Then folder = InputBox("请输入 日期-首图-公司名称-提单人名称!", , "日期-首图-公司名称-提单人名称")
+    itempicurl(ix) = vDoc.getelementsbytagname("input")("pictureUrl").Value
-    dl.FileDownload itempicurl, App.Path & "\" & folder & "\" & itemname & ".jpg"
+    If ERR <> 0 Then
+        itempicurl(ix) = vDoc.getelementsbytagname("input")("pictureUrl")(0).Value
+    End If
+    
+    If folder = "" Then folder = InputBox("请输入 日期-首图-公司名称-提单人名称!", , Format(Now, "m.d") & "-首图-公司名称-提单人名称")
+    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
+    Next
 End Sub
 
 Private Function resetfilename(ByVal name As String) As String
@@ -243,29 +339,59 @@ Private Function clear(name As String, p As String) As String
     clear = Replace(name, p, "")
 End Function
 
+Private Sub Label1_Click()
+    Dim i
+    For i = web.LBound To web.UBound
+        web(i).Stop
+    Next
+End Sub
+
+Private Sub oa_Click()
+    web(0).Navigate2 "http://192.168.0.8:83/"
+End Sub
+
+Private Sub urlT_Click(index As Integer)
+    urlT(index).SelStart = 0
+    urlT(index).SelLength = Len(urlT(index).Text)
+End Sub
+
 Private Sub urlT_KeyPress(index As Integer, KeyAscii As Integer)
     If KeyAscii = 13 Then web(index).Navigate2 urlT(index).Text
 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
 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)
-    If InStr(1, URL, "operator=edit") Then Call getfp(web(index))
+    If InStr(1, url, "operator=edit") Then Call getfp(web(index))
 End Sub
 
 Private Sub web_DownloadBegin(index As Integer)
-    web(index).Silent = True
+    web(index).Tag = False
 End Sub
 
+'Private Sub web_DownloadBegin(index As Integer)
+'    web(index).Silent = True
+'End Sub
+
 Private Sub web_DownloadComplete(index As Integer)
     web(index).Silent = True
+    web(index).Tag = True
+    showweb (index)
 End Sub
 
 Private Sub web_NewWindow2(index As Integer, ppDisp As Object, Cancel As Boolean)
     Dim i
     For i = 1 To web.UBound
-        If Not web(index).Busy Then Set ppDisp = web(1): Cancel = True
+        If web(i).Tag Then Set ppDisp = web(i).Object: showweb (i): Exit For
     Next
 End Sub
+
+Private Sub showweb(index As Long)
+    Dim i As Long
+    For i = 1 To web.UBound
+        web(i).Visible = False
+    Next
+    web(index).Visible = True
+End Sub

README.md

@@ -1,44 +0,0 @@
-#LoadFirstPic
-代码1：
-
-Private Sub WebBrowser1_NewWindow2(ppDisp As Object, Cancel As Boolean)
-Dim frm As Form1
-Set frm = New Form1
-frm.Visible = True
-Set ppDisp = frm.WebBrowser1.object
-End Sub
-
-代码2：
-
-Private Sub WebBrowser1_NewWindow2(ppDisp As Object, Cancel As Boolean)
-Cancel = True
-WebBrowser1.Navigate2 WebBrowser1.Document.activeElement.href
-End Sub
-
-代码3：
-
-Private Sub WebBrowser1_NewWindow2(ppDisp As Object, Cancel As Boolean)
-On Error Resume Next
-Dim frmWB As Form1
-Set frmWB = New Form1
-frmWB.WebBrowser1.RegisterAsBrowser = True
-Set ppDisp = frmWB.WebBrowser1.object
-frmWB.Visible = True
-frmWB.Top = Form1.Top
-frmWB.Left = Form1.Left
-frmWB.Width = Form1.Width
-frmWB.Height = Form1.Height
-End Sub
-
-代码4：这个最好用了
-
-Dim WithEvents Web_V1 As SHDocVwCtl.WebBrowser_V1
-
-PrivateSub Form_Load()
-    Set Web_V1 = WebBrowser1.Object
-End Sub
-    
-PrivateSub Web_V1_NewWindow(ByVal URL AsString, ByVal Flags AsLong, ByVal TargetFrameName AsString, PostData As Variant, ByVal Headers AsString, Processed AsBoolean)
-    Processed =True
-    WebBrowser1.Navigate URL
-End Sub

首图导出工具.vbw

@@ -1,2 +1,2 @@
-Frm_Main = 11, 158, 897, 607, Z, 50, 50, 1161, 739, C
+Frm_Main = 30, 95, 916, 544, , 50, 50, 1161, 739, C
-TzDownload = 25, 25, 911, 474, C, 75, 75, 961, 524, C
+TzDownload = 25, 25, 911, 474, , 75, 75, 961, 524, C