Option Explicit Dim WGET_PATH: WGET_PATH = "C:\Program Files (x86)\GnuWin32\bin\wget.exe" ' Wgetインストールパス Dim YAPLOG_USERNAME: YAPLOG_USERNAME = "lp-n-rena" ' ダウンロード対象のヤプログユーザ名 Dim RM_FILE_PATH: RM_FILE_PATH = "data\yaplog.jp\dwrguest\engine.js" ' 削除ファイルパス Dim CSS_FILE_PATH: CSS_FILE_PATH = "data\yaplog.jp\"&YAPLOG_USERNAME&"\style.css" ' CSSファイルパス(サイトによって異なる) ' Wgetオプション Dim WGET_OPT: WGET_OPT = Array("--directory-prefix=data"_ ,"--input-file=list.txt"_ ,"--output-file=log.txt"_ ,"--append-output=log.txt"_ ,"--html-extension"_ ,"--recursive --level=1"_ ,"--convert-links"_ ,"--span-hosts"_ ,"--page-requisites"_ ,"--domains=yaplog.jp,img.yaplog.jp,static.yaplog.jp,www.yaplog.jp,stat.ameba.jp"_ ,"--include-directories=/img,/blog,/static,/js,/dwrguest,/user_images,/"&YAPLOG_USERNAME&""_ ,"--exclude-directories="&YAPLOG_USERNAME&"/archive,"&YAPLOG_USERNAME&"/category_*,"&YAPLOG_USERNAME&"/daily,"&YAPLOG_USERNAME&"/monthly"_ ,"--wait=1"_ ,"--random-wait"_ ,"--no-clobber"_ ,"--header="&Chr(34)&"Referer: http://www.ameba.jp"&Chr(34)_ ) ' "-e HTTP_PROXY=localhost:8888"_ Dim g_sScriptDir: g_sScriptDir = Replace(WScript.ScriptFullName, WScript.ScriptName,"") Dim g_oWshShell: Set g_oWshShell = CreateObject("Wscript.Shell") Dim g_oFso: Set g_oFso = CreateObject("Scripting.FileSystemObject") ExecWget RemoveFile ModifyCssFile WScript.Echo "完了" '********************************************************* ' Wget実行 '********************************************************* Sub ExecWget() Dim sOpt: sOpt = Join(WGET_OPT, " ") Dim oExec: Set oExec = g_oWshShell.Exec(WGET_PATH&" "&sOpt) Do While oExec.Status = 0 WScript.Sleep 100 Loop End Sub '********************************************************* ' 不要ファイル削除 '********************************************************* Sub RemoveFile() Dim sRmFilePath: sRmFilePath = g_sScriptDir & RM_FILE_PATH If g_oFso.FileExists(sRmFilePath) Then g_oFso.DeleteFile sRmFilePath, TRUE End If End Sub '********************************************************* ' CSSファイル修正 '********************************************************* Sub ModifyCssFile() ' CSSファイルが無ければ何もしない Dim sCssFilePath: sCssFilePath = g_sScriptDir & CSS_FILE_PATH If g_oFso.FileExists(sCssFilePath) = False Then Exit Sub End If ' CSSファイル内にhttp://記述が無ければ何もしない Dim oTextStream: Set oTextStream = g_oFso.OpenTextFile(sCssFilePath) Dim sCssText: sCssText = oTextStream.ReadAll oTextStream.Close() Dim oRegExp: Set oRegExp = CreateObject("VBScript.RegExp") oRegExp.Pattern = "url\(['"&Chr(34)&"](http://.+?)['"&Chr(34)&"]\)" oRegExp.Global = True If oRegExp.Test(sCssText) = False Then Exit Sub End If ' ファイル内から画像URLを抽出して追加ダウンロード Dim oMatches: Set oMatches = oRegExp.Execute(sCssText) Dim i For i = 0 To (oMatches.Count - 1) Dim oSub: Set oSub = oMatches.Item(i).SubMatches If 0 < oSub.Count Then Dim sSourceUrl: sSourceUrl = oSub.Item(0) Dim sOpt, oExec sOpt = "--directory-prefix=data\addfile --recursive --level=1 --wait=1 --random-wait --no-clobber " Set oExec = g_oWshShell.Exec(WGET_PATH&" "&sOpt&sSourceUrl) Do While oExec.Status = 0 WScript.Sleep 100 Loop ' ファイル内のパスをURL→相対パスに置換 Dim sReplacePath: sReplacePath = "../../addfile/"&Replace(sSourceUrl, "http://", "") sCssText = Replace(sCssText, sSourceUrl, sReplacePath) End If Next ' 元ファイル名を変更 Dim oFile: Set oFile = g_oFso.GetFile(sCssFilePath) oFile.Name = g_oFso.GetBaseName(sCssFilePath)&"_org."&g_oFso.GetExtensionName(sCssFilePath) ' 新たなファイルに編集後のCSS文字列書き込み Dim oNewTextStream: Set oNewTextStream = g_oFso.CreateTextFile(sCssFilePath) oNewTextStream.Write(sCssText) oNewTextStream.Close() End Sub