Option Explicit On Error Resume Next Dim strBaseDir, strMoveToDir, iMaxSize '/////////////////////////////////////////////////////////////////// ' ' SourceTV demoファイル管理スクリプト(for Windows)Ver 1.0.1 ' ' 作者:ZUNAsan (http://noob93.com/) ' ライセンス:MIT License ' 本ソフトウェアを使用することによって発生したいかなる損害について ' 作者は一切の責任を負いません。 ' ' ' 説明 ' このスクリプトはSource Engine系ゲームのdemファイルを任意のフォルダに ' 移動し、移動先のフォルダの総容量が指定以上になった場合に、古いdem ' ファイルから削除します。 ' サーバー側でdemoを自動録画状態にし、demファイルを自動的にWEBサーバー ' 公開ディレクトリに移動することを想定しています。またクライアントに ' おいてもdemoを撮りすぎてディスク容量を圧迫しないようにする為にも利用 ' できます。 ' ' ' 起動方法 ' このファイルをメモ帳などのテキストエディタで開き、下記「初期設定」の ' 欄に必要な情報を入力します。 ' 保存後、このファイルをダブルクリックすればdemファイルの移動、容量オー ' バーのファイルの削除を自動的に行います。(画面には何も表示されません) ' ' 定期的に実行したい場合は、Windowsのタスクを利用してください。 ' ' ' 更新履歴 ' 1.0.0 2009/07/23 初版 ' 1.0.1 2009/07/24 使用中のdemファイルがあると移動されない不具合の改修 ' '//////////////////////////////////////////////////////////////////// '------------------------------------------------------------------- ' 初期設定 '------------------------------------------------------------------- '// ベースフォルダ(フルパス) strBaseDir = "C:\SRCDS\orangebox\tf2\" '// 移動先フォルダ(フルパス) strMoveToDir = "C:\wwwroot\tf2demo\" '// 移動先ディレクトリのMAXサイズ(MB単位)(0=無制限) iMaxSize = 100 '------------------------------------------------------------------- Dim objFileSys Dim objFolder, objFile If Right(strBaseDir, 1) <> "\" Then strBaseDir = strBaseDir & "\" End If If Right(strMoveToDir, 1) <> "\" Then strMoveToDir = strMoveToDir & "\" End If Set objFileSys = CreateObject("Scripting.FileSystemObject") If objFileSys.FolderExists(strBaseDir) = False Then MsgBox "ベースフォルダ" & strBaseDir & "が見つかりません。" WScript.Quit End If If objFileSys.FolderExists(strMoveToDir) = False Then MsgBox "移動先フォルダ" & strMoveToDir & "が見つかりません。" WScript.Quit End If If IsNumeric(iMaxSize) = False Then MsgBox "MAXサイズの指定が数値ではありません。" WScript.Quit End If Set objFolder = objFileSys.GetFolder(strBaseDir) For Each objFile In objFolder.Files If Right(objFile.Path, 4) = ".dem" Then objFileSys.MoveFile objFile.Path, strMoveToDir End If Next Set objFolder = Nothing Set objFile = Nothing If iMaxSize > 0 Then DelFile objFileSys, strMoveToDir, iMaxSize End If Set objFileSys = Nothing Sub DelFile(ByRef objFileSys, ByVal strMoveToDir, ByVal iMaxSize) Dim strOldestFilePath, dtOldestFileDate Dim objFolder, objFile strOldestFilePath = "" dtOldestFileDate = "" Set objFolder = objFileSys.GetFolder(strMoveToDir) If objFolder.Size > iMaxSize * 1024 * 1024 Then For Each objFile In objFolder.Files If Right(objFile.Path, 4) = ".dem" Then If dtOldestFileDate = "" Or objFile.DateCreated < dtOldestFileDate Then strOldestFilePath = objFile.Path dtOldestFileDate = objFile.DateCreated End If End If Next If strOldestFilePath <> "" Then objFileSys.DeleteFile strOldestFilePath, True DelFile objFileSys, strMoveToDir, iMaxSize End If End If Set objFolder = Nothing Set objFile = Nothing End Sub