diff --git a/Frm_Main.frm b/Frm_Main.frm index 9ddd37e..2665fc0 100644 --- 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 diff --git a/README.md b/README.md deleted file mode 100644 index fb18c95..0000000 --- a/README.md +++ /dev/null @@ -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 \ No newline at end of file diff --git a/棣栧浘瀵煎嚭宸ュ叿.exe b/棣栧浘瀵煎嚭宸ュ叿.exe deleted file mode 100644 index f4bc8b8..0000000 Binary files a/棣栧浘瀵煎嚭宸ュ叿.exe and /dev/null differ diff --git a/棣栧浘瀵煎嚭宸ュ叿.vbw b/棣栧浘瀵煎嚭宸ュ叿.vbw index cb5579f..f268658 100644 --- 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