VBS combined with wget implementation download website picture _vbs

Source: Internet
Author: User
Tags regular expression save file

VBS Function PROCEDURE:
1. Call wget: Download all pages of Web site to this script directory ...
2. Scan all files in this script directory ...
3. Read all pages in this script directory, match picture URL address ...
4. Save all picture URL address to Url-img.txt file ...
5. Call wget: Download url-img.txt specified picture to this script img directory ...

' Wget_img.vbs call Main () Sub main () ' CMD mode 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, STRM Edir Set WSO = WScript.CreateObject ("Wscript.Shell") Strmedir = Left (Wscript.scriptfullname, InStrRev ( Wscript.scriptfullname, "\"-1) ' launches wget download site All pages to this script directory 720.hao2046.net folder WScript.Echo ' 1. Start wget Download all pages of the website to this script directory 720.hao2046.net folder ... "WSO. Run "Wget-r-p-k-c-x-a=jpg,htm,html 720.hao2046.net-p" "& Strmedir &" "", 1, True ' Scan 720.hao2046.net All files in the folder WScript.Echo "2.
 Scan all files in the 720.hao2046.net folder ...
 Dim Strfolderspec, strHTML, strURL Dim arr (): ReDim Preserve-Arr (0) Strfolderspec = strmedir & "\720.hao2046.net"
 Call Scanfolder (arr, Strfolderspec) ' establishes regular expressions.
 Dim Regex Set regex = CreateObject ("VBScript.RegExp") ' establishes a regular expression.
 Regex.ignorecase = True ' Sets whether case sensitive. Regex.gloBal = True ' Sets global substitution. Regex.multiline = True ' sets multiple line matching mode ' Find all Files WScript.Echo ' 3.
 Read all pages in 720.hao2046.net folder, match picture URL address ... For i = 0 to UBound (arr) If LCase (Right (arr (i), 5)) = ". html" or LCase (right (arr (i), 4)) = ". htm" Then ' read files, matching picture U RL Address strhtml = Readpfile (arr (i), "gb2312") Regex.pattern = "src=[" ""]http://\s+\.jpg["" "" Set matches = R
     Egex.execute (strhtml) ' performs the search.
       For the match in matches ' traversal matching collection. If Not match.value = "" Then Regex.pattern = "(src=['" "]) * (['" "]) *" strURL = strURL & Regex.Replace ( Match.value, "") & VbCrLf End If Next ' Save all pictures URL address WScript.Echo ' 4.
 Save all picture URL addresses to Url-img.txt file ... " Call Savepfile (Strmedir & "\url-img.txt", "Utf-8", strURL) ' Start wget download pictures to this script img directory wscript.echo ' 5. Start wget download url-img.txt specified picture to this script img directory ... "WSO.
 
 Run "Wget-c-x-t 5-i" "& Strmedir &" \url-img.txt ""-P "" "& Strmedir &" \img "", 1, TrueMsgbox "Done!" "End Sub ' =========================================================================================== ' Read TXT file content by encoding Function readpfile (ByVal FileName, ByVal filecode) Dim objstream Set objstream = CreateObject ("ADODB". Stream ") ' with objstream. Type = 2. Mode = 3. Open. Charset = Filecode ' different encoding, Chinese (Simplified) (GB2312), Chinese GBK, Traditional Chinese Big5, Japanese euc-jp, Korean Euc-kr,charset=utf-8 (International Code), Ansi,unicode,unicode big endian. LoadFromFile FileName readpfile =. ReadText. The close end with the Set objstream = Nothing End Function ' ================================================================ =========================== ' save file as Unicode format text Function savepfile (ByVal FileName, ByVal filecode, ByVal textstring) Dim o Bjstream Set objstream = CreateObject ("ADODB. Stream ") with objstream. Type = 2. Mode = 3. Charset = Filecode ' different encoding, Chinese (Simplified) (GB2312), Chinese GBK, Traditional Chinese Big5, Japanese euc-jp, Korean Euc-kr,charset=utf-8 (International Code), Ansi,uniCode,unicode big endian. Open. WRITETEXT TextString. SaveToFile FileName, 2. Close the 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 (" Sc Ripting.  FileSystemObject ") Set objfolder = Fso.getfolder (strfolderspec) ReDim Preserve (arr (UBound) +1) arr (arr (UBound)) = Strfolderspec & ' For each subfile in Objfolder.files ReDim Preserve arr (UBound (arr) +1) arr (UBound (arr)) = Subfile.path next for all subfolder in Objfolder.subfolders Scanfolder arr, subfolder.path next Set fso = N 
 othing Set objfolder = Nothing End Sub

Attached page file Lookup string code (Findstr_html.vbs):

' Findstr_html.vbs call Main () Sub main () ' CMD mode If not (LCase right (wscript.fullname,11) = LCase ("CScript.exe")) T Hen 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 ' Scan folder Di M arr (): ReDim Preserve arr (0) Call Scanfolder (arr, Strmedir & "\720.hao2046.net") If UBound (arr) = 0 Then Wscrip
  T.echo Strmedir & "\720.hao2046.net" & ", not found!"
 Exit Sub End If ' establishes a regular expression.
 Set regEx = CreateObject ("VBScript.RegExp") ' establishes a regular expression.
 Regex.ignorecase = True ' Sets whether case sensitive.
 Regex.global = True ' Sets global substitution. Regex.multiline = True ' Sets multiline matching mode do Strpattern = InputBox ("Please enter a regular expression to match:", "Find all Page Files", "123456") Strinfo = Strpa
  Ttern & 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) ' performs the search.
      For the match in matches ' traversal matching collection. If Not match.value = "" Then ' Regex.pattern = "(src=['" "]) * (['" "]) *" ' strURL = strURL & Regex.Replace (Ma Tch.
     Value, "") & vbCrLf Strinfo = Strpattern & vbCrLf & Arr (i) & vbCrLf Exit for end If Next End If End If Next WScript.Echo strinfo Loop end Sub ' ============================================= ============================================== ' read TXT file content by encoding Readpfile (ByVal FileName, ByVal filecode) Dim objstream Set objstream = CreateObject ("ADODB. Stream ") ' with objstream. Type = 2.
    Mode = 3. Open. Charset = Filecode ' different encoding, Chinese (Simplified) (GB2312), Chinese GBK, Traditional Chinese Big5, Japanese euc-jp, Korean Euc-kr,charset=utf-8 (International Code), Ansi,unicode,unicode big endian. LoadFromFile FileName readpfile =. ReadText. Close the 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 (" Sc Ripting.  FileSystemObject ") Set objfolder = Fso.getfolder (strfolderspec) ReDim Preserve (arr (UBound) +1) arr (arr (UBound)) = Strfolderspec & ' For each subfile in Objfolder.files ReDim Preserve arr (UBound (arr) +1) arr (UBound (arr)) = Subfile.path next for all subfolder in Objfolder.subfolders Scanfolder arr, subfolder.path next Set fso = N
 othing Set objfolder = Nothing End Sub

Tips:
1. Warning: Please do not run the code directly, the model site here may not be accessible, or lack of security, please change to another Web site to use.
2. Place the Wget.exe in the same directory as the script and execute. The file structure is as follows:
.. \wget.exe
.. \wget_img.vbs
.. \findstr_html.vbs

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.