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