add multasks...

Signed-off-by: j502647092 <jtb1@163.com>
2024-12-28 08:08:50 +00:00 · 2015-06-09 18:30:04 +08:00 · 2015-06-09 18:30:04 +08:00 · 9f08008b4c
commit 9f08008b4c
parent 2d4e4ada03
4 changed files with 168 additions and 86 deletions
--- a/Frm_Main.frm
+++ b/Frm_Main.frm
@ -10,14 +10,37 @@ Begin VB.Form Frm_Main
   ScaleHeight     =   9390
   ScaleWidth      =   17160
   StartUpPosition =   3  '窗口缺省
-   Begin VB.TextBox urlT 
-      Height          =   270
-      Index           =   3
-      Left            =   8760
-      TabIndex        =   13
-      Text            =   "Text1"
-      Top             =   405
-      Width           =   7710
+   Begin VB.CommandButton alibaba 
+      Caption         =   "1688"
+      Height          =   300
+      Left            =   16530
+      TabIndex        =   19
+      Top             =   420
+      Width           =   600
+   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
-      Width           =   3495
+      Top             =   420
+      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(1).Height = lefthg / 2 - 350
-    
+    web(0).Width = Me.Width - 50
+    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
-    dl(0).Width = Me.Width - 20
+    web(2).Width = Me.Width - 50
+    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)
-    itempicurl = vDoc.getelementsbytagname("input")("pictureUrl")(0).Value
-    If folder = "" Then folder = InputBox("请输入 日期-首图-公司名称-提单人名称!", , "日期-首图-公司名称-提单人名称")
-    dl.FileDownload itempicurl, App.Path & "\" & folder & "\" & itemname & ".jpg"
+    itemname(ix) = resetfilename(vDoc.getelementsbytagname("input")("subject").Value)
+    ERR.clear
+    itempicurl(ix) = vDoc.getelementsbytagname("input")("pictureUrl").Value
+    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)
-    If URL <> "http:///" And URL <> "" And URL <> "about:blank" Then urlT(index) = URL
+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
 End Sub

-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))
+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))
 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
--- a/README.md
+++ b/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
--- a/首图导出工具.exe
+++ b/首图导出工具.exe
--- a/首图导出工具.vbw
+++ b/首图导出工具.vbw
@ -1,2 +1,2 @@
-Frm_Main = 11, 158, 897, 607, Z, 50, 50, 1161, 739, C
-TzDownload = 25, 25, 911, 474, C, 75, 75, 961, 524, C
+Frm_Main = 30, 95, 916, 544, , 50, 50, 1161, 739, C
+TzDownload = 25, 25, 911, 474, , 75, 75, 961, 524, C