久久精品中文字幕,国产高清精品一区,国产精品久久久久久久久久99

主頁 > 知識庫 > vbs結合wget 實現下載網站圖片

vbs結合wget 實現下載網站圖片

vbs 函數過程：
1. 調用wget: 下載網站所有頁面到本腳本目錄 ……
2. 掃描本腳本目錄中所有文件 ……
3. 讀取本腳本目錄中的所有網頁，匹配圖片 URL 地址 ……
4. 保存所有圖片 URL 地址到 url-img.txt 文件 ……
5. 調用wget: 下載 url-img.txt 指定的圖片到本腳本 img 目錄 ……

' wget_img.vbs
Call Main()
Sub Main()

 ' CMD 模式
 If Not (LCase(Right(WScript.FullName,11)) = LCase("CScript.exe")) Then
  CreateObject("WScript.Shell").Run "cscript.exe //nologo """  WScript.ScriptFullName  """", 1, False
  WScript.Quit(1)
 End If
 
 Dim wso, strMeDir
 Set wso = WScript.CreateObject("WScript.Shell")
 strMeDir = Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName,"\")-1)
 ' 啟動 wget下載網站所有頁面到本腳本目錄的 720.hao2046.net 文件夾
 WScript.Echo "1. 啟動 wget下載網站所有頁面到本腳本目錄的 720.hao2046.net 文件夾 ……"
 wso.Run "wget -r -p -k -c -x -A=jpg,htm,html 720.hao2046.net -P """  strMeDir  """", 1, True

 ' 掃描 720.hao2046.net 文件夾中所有文件
 WScript.Echo "2. 掃描 720.hao2046.net 文件夾中所有文件 ……"
 Dim strFolderspec, strHTML, strURL
 Dim arr() : ReDim Preserve arr(0)
 strFolderspec = strMeDir  "\720.hao2046.net"
 Call ScanFolder(arr, strFolderspec)
 
 ' 建立正則表達式。
 Dim regEx
 Set regEx = CreateObject("VBScript.RegExp")   ' 建立正則表達式。
 regEx.IgnoreCase = True   ' 設置是否區分大小寫。
 regEx.Global = True     ' 設置全局替換。
 regEx.MultiLine = True   ' 設置多行匹配模式
 
 ' 查找所有文件
 WScript.Echo "3. 讀取 720.hao2046.net 文件夾中的所有網頁，匹配圖片 URL 地址 ……"
 For i = 0 To UBound(arr)
   If LCase(Right(arr(i),5)) = ".html" Or LCase(Right(arr(i),4)) = ".htm" Then
     ' 讀取文件，匹配圖片 URL 地址
     strHTML = ReadPfile(arr(i), "gb2312")
     regEx.Pattern = "src=['""]http://\S+\.jpg['""]"
     Set Matches = regEx.Execute(strHTML)   ' 執行搜索。
     For Each Match in Matches ' 遍歷匹配集合。
       If Not Match.Value = "" Then
         regEx.Pattern = "(src=['""])*(['""])*"
         strURL = strURL  regEx.Replace(Match.Value, "")  vbCrLf
       End If
     Next
   End If
 Next
 
 ' 保存所有圖片 URL 地址
 WScript.Echo "4. 保存所有圖片 URL 地址到 url-img.txt 文件 ……"
 Call SavePfile(strMeDir  "\url-img.txt", "utf-8", strURL) 
 
 ' 啟動 wget 下載圖片到本腳本 img 目錄
 WScript.Echo "5. 啟動 wget 下載 url-img.txt 指定的圖片到本腳本 img 目錄 ……"
 wso.Run "wget -c -x -t 5 -i """  strMeDir  "\url-img.txt"" -P """  strMeDir  "\img""", 1, True
 
 Msgbox "完成！"
End Sub

'===========================================================================================
'按編碼讀取txt文件內容
Function ReadPfile(ByVal FileName, ByVal FileCode)
  Dim objStream
  Set objStream = CreateObject("ADODB.Stream")
  '
  With objStream
    .Type = 2
    .Mode = 3
    .open
    .Charset = FileCode   '不同編碼時自己換,Chinese (Simplified) (GB2312),中文 GBK ,繁體中文 Big5 ,日文 EUC-JP ,韓文 EUC-KR,charset=UTF-8(國際化編碼),ANSI,Unicode,unicode big endian
    .LoadFromFile FileName
     ReadPfile = .ReadText
    .Close
  End With
  Set objStream = Nothing
End Function

'===========================================================================================
'保存文件為unicode格式文本
Function SavePfile(ByVal FileName, ByVal FileCode, ByVal TextString)
  Dim objStream
  Set objStream = CreateObject("ADODB.Stream")
  With objStream
    .Type = 2
    .Mode = 3
    .Charset = FileCode   '不同編碼時自己換,Chinese (Simplified) (GB2312),中文 GBK ,繁體中文 Big5 ,日文 EUC-JP ,韓文 EUC-KR,charset=UTF-8(國際化編碼),ANSI,Unicode,unicode big endian
    .open
    .WriteText TextString
    .SaveToFile FileName, 2
    .Close
  End With
  Set objStream = Nothing
End Function

'  Dim arr() : ReDim Preserve arr(0)
'  Call ScanFolder(arr, "V:\")
Sub ScanFolder(ByRef arr, ByVal strFolderspec)
  On Error Resume Next
  Dim fso, objFolder
  Set fso = Createobject("Scripting.FileSystemObject")
  Set objFolder = fso.getfolder(strFolderspec)
  ReDim Preserve arr(UBound(arr)+1)
  arr(UBound(arr)) = strFolderspec  "\"
  For Each subFile In objFolder.files
    ReDim Preserve arr(UBound(arr)+1)
    arr(UBound(arr)) = subFile.path
  Next
  For Each subFolder In objFolder.subfolders
    ScanFolder arr, subFolder.path
  Next
  Set fso = NoThing
  Set objFolder = NoThing
End Sub

附網頁文件查找字符串代碼(findstr_html.vbs)：

' findstr_html.vbs
Call Main()
Sub Main()

 ' CMD 模式
 If Not (LCase(Right(WScript.FullName,11)) = LCase("CScript.exe")) Then
  CreateObject("WScript.Shell").Run "cscript.exe //nologo """  WScript.ScriptFullName  """", 1, False
  WScript.Quit(1)
 End If

 Dim strMeDir
 strMeDir = Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName,"\")-1)
 Dim regEx, strHTML, strURL
 
 ' 掃描文件夾
 Dim arr() : ReDim Preserve arr(0)
 Call ScanFolder(arr, strMeDir  "\720.hao2046.net")
 If UBound(arr) = 0 Then
  WScript.Echo strMeDir  "\720.hao2046.net"  ", Not Found!"
  Exit Sub
 End If

 ' 建立正則表達式。
 Set regEx = CreateObject("VBScript.RegExp")   ' 建立正則表達式。
 regEx.IgnoreCase = True   ' 設置是否區分大小寫。
 regEx.Global = True     ' 設置全局替換。
 regEx.MultiLine = True   ' 設置多行匹配模式
 
 
 Do
  strPattern = InputBox("請輸入要匹配的正則表達式：","查找所有網頁文件","123456")
  strInfo = strPattern  vbCrLf  "Not Found!"
  For i = 0 To UBound(arr)
   If LCase(Right(arr(i),5)) = ".html" Or LCase(Right(arr(i),4)) = ".htm" Then
    'WScript.Echo arr(i)
    strHTML = ReadPfile(arr(i), "gb2312")
    If InStr(strHTML, strPattern)>0 Then
     strInfo = strPattern  vbCrLf  arr(i)  vbCrLf
     Exit For
    Else
     'regEx.Pattern = "src=['""]http://\S+\.jpg['""]"
     regEx.Pattern = strPattern
     Set Matches = regEx.Execute(strHTML)   ' 執行搜索。
     For Each Match in Matches ' 遍歷匹配集合。
      If Not Match.Value = "" Then
       'regEx.Pattern = "(src=['""])*(['""])*"
       'strURL = strURL  regEx.Replace(Match.Value, "")  vbCrLf
       strInfo = strPattern  vbCrLf  arr(i)  vbCrLf
       Exit For
      End If
     Next
    End If
   End If
  Next
  WScript.Echo strInfo
  Loop
End Sub


'===========================================================================================
'按編碼讀取txt文件內容
Function ReadPfile(ByVal FileName, ByVal FileCode)
  Dim objStream
  Set objStream = CreateObject("ADODB.Stream")
  '
  With objStream
    .Type = 2
    .Mode = 3
    .open
    .Charset = FileCode   '不同編碼時自己換,Chinese (Simplified) (GB2312),中文 GBK ,繁體中文 Big5 ,日文 EUC-JP ,韓文 EUC-KR,charset=UTF-8(國際化編碼),ANSI,Unicode,unicode big endian
    .LoadFromFile FileName
     ReadPfile = .ReadText
    .Close
  End With
  Set objStream = Nothing
End Function

'  Dim arr() : ReDim Preserve arr(0)
'  Call ScanFolder(arr, "V:\")
Sub ScanFolder(ByRef arr, ByVal strFolderspec)
  On Error Resume Next
  Dim fso, objFolder
  Set fso = Createobject("Scripting.FileSystemObject")
  Set objFolder = fso.getfolder(strFolderspec)
  ReDim Preserve arr(UBound(arr)+1)
  arr(UBound(arr)) = strFolderspec  "\"
  For Each subFile In objFolder.files
    ReDim Preserve arr(UBound(arr)+1)
    arr(UBound(arr)) = subFile.path
  Next
  For Each subFolder In objFolder.subfolders
    ScanFolder arr, subFolder.path
  Next
  Set fso = NoThing
  Set objFolder = NoThing
End Sub

提示：
1. 警告：請不要直接運行代碼，這里的示范網址可能無法訪問、或缺乏安全性，請改為其他網址再使用。
2. 請將 wget.exe 放置于腳本同一目錄下，然后執行。文件結構如下：
..\wget.exe
..\wget_img.vbs
..\findstr_html.vbs

您可能感興趣的文章:

Linux的wget命令詳解
Linux中curl命令和wget命令的使用介紹與比較
windows系統配制wget計劃任務腳本
dos利用wget.exe讓殺毒軟件升級更自動化
使用wget遞歸鏡像網站
詳解Linux中的wget命令
Linux 中wget命令詳細介紹
wget下載整個網站(整個子目錄)或特定目錄

標簽：湖州鶴壁四平海口邢臺銅川文山西安

巨人網絡通訊聲明：本文標題《vbs結合wget 實現下載網站圖片》，本文關鍵詞 vbs,結合,wget,實現,下載網站,；如發現本文內容存在版權問題，煩請提供相關信息告之我們，我們將及時溝通與處理。本站內容系統采集于網絡，涉及言論、版權與本站無關。

婷婷综合国产,91蜜桃婷婷狠狠久久综合9色 ,九九九九九精品,国产综合av

vbs結合wget 實現下載網站圖片