ツール

// ************************************************
// カンマ編集
// ************************************************
String.prototype.number_format = 
function (prefix) {
	var num = this.valueOf();
	prefix = prefix || '';
	num += '';
	var splitStr = num.split('.');
	var splitLeft = splitStr[0];
	var splitRight = splitStr.length > 1 ? '.' + splitStr[1] : '';
	var regx = /(\d+)(\d{3})/;
	while (regx.test(splitLeft)) {
		splitLeft = splitLeft.replace(regx, '$1' + ',' + '$2');
	}
	return prefix + splitLeft + splitRight;
}

// ************************************************
// オブジェクト
// ************************************************
var Shell = new ActiveXObject("Shell.Application");
var WshShell = new ActiveXObject("WScript.Shell");
var Fso = new ActiveXObject( "Scripting.FileSystemObject" );

// ************************************************
// 管理者権限のコマンドプロンプトで再実行
// ************************************************
if ( WScript.Arguments.length == 0 ) {
	Shell.ShellExecute( "cmd.exe", "/c cscript.exe " + Dd(WScript.ScriptFullName) + " next" + " & pause", "", "runas", 1 );
	WScript.Quit();
}


var target = SelectDir( "対象フォルダを選択して下さい" )
if ( target == "" ) {
	WScript.Quit();
}

WScript.Echo( target )

// ************************************************
// フォルダオブジェクト取得
// ************************************************
var objFolder =  Fso.GetFolder(target)

var folderCollection = new Enumerator(objFolder.SubFolders);

var TargetSize = 0;
var obj;
var num;
var line;
for ( ;!folderCollection.atEnd(); folderCollection.moveNext()) {

	obj = folderCollection.item();
	
	try {
		num = Math.floor(obj.Size / 1024) / 1024;
		num = Math.floor( num * 1000 ) / 1000
		line = Lpad(("" + num).number_format()," ", 15) + " M : " + obj.Name
		WScript.Echo( line );

		// フォルダ全体の合計
		TargetSize = TargetSize + obj.Size
	}
	catch(e) {
		WScript.Echo( obj.Name + " : 処理できません");
	}

}

WScript.Echo( "" );

num = Math.floor(TargetSize / 1024) / 1024;
num = Math.floor( num * 1000 ) / 1000
line = Lpad(("" + num).number_format()," ", 15) + " M : " + "表示合計"
WScript.Echo( line );

// ************************************************
// ディレクトリ選択
// ************************************************
function SelectDir( strTitle ) {

	var obj

	obj = Shell.BrowseForFolder( 0, strTitle, 0x4B, 0 )
	if ( obj == null ) {
		return "";
	}
	if ( !obj.Self.IsFileSystem ) {
		ErrorMessage = "ファイルシステムではありません";
		return "";
	}

	return obj.Self.Path;

}

// ************************************************
// ダブルクォートで囲む
// ************************************************
function Dd( strValue ) {

	return "\"" + strValue + "\""

}

// ************************************************
// 指定数、指定文字列左側を埋める
// ※少数以下３桁の調整
// ************************************************
function Lpad( strValue, str, nLen ) {

	var i;
	var wk = "";

	for( i = 0; i < nLen; i++ ) {
		wk += str;
	}
	
	var test = strValue.split(".");
	if ( test.length == 2 ) {
		if ( test[1].length == 0 ) {
			strValue += "000"
		}
		if ( test[1].length == 1 ) {
			strValue += "00"
		}
		if ( test[1].length == 2 ) {
			strValue += "0"
		}
	}
	else {
		strValue += ".000"
	}

	return ( wk + strValue ).slice( nLen * -1 );

}

' ************************************************
' 管理者権限で実行用
' ************************************************
Set Shell = CreateObject( "Shell.Application" )

' ************************************************
' 管理者権限で再実行
' ************************************************
if Wscript.Arguments.Count = 0 then
	Shell.ShellExecute "cmd.exe", "/c cscript.exe " & Dd(WScript.ScriptFullName) & " next" & " & pause", "", "runas", 1
	Wscript.Quit
end if

' ************************************************
' 除外フォルダ名を スペースで区切って並べる
' (簡易的な除外)
' ************************************************
Dim Exclude
Exclude = ".gem"
Exclude = Lcase(Exclude)

' ************************************************
' 処理用
' ************************************************
Set WshShell = CreateObject( "WScript.Shell" )
Set Fso = CreateObject( "Scripting.FileSystemObject" )

Dim target

' ************************************************
' 対象フォルダを選択
' ************************************************
target = SelectDir( "対象フォルダを選択して下さい" )
if target = "" then
	Wscript.Quit
end if

Wscript.Echo target
Wscript.Echo

' ************************************************
' フォルダオブジェクト取得
' ************************************************
Set objFolder =  Fso.GetFolder(target)

' ************************************************
' サブフォルダコレクション取得
' ************************************************
Set colSubFolder =  objFolder.SubFolders

' ************************************************
' 一覧
' ************************************************
Dim TargetSize : TargetSize = 0
For Each obj in colSubFolder

	Do While true

		if InStr(Exclude,Lcase(obj.Name)) > 0 then
			Exit Do
		end if

		on error resume next
		Wscript.Echo Lpad(FormatNumber((Fix(obj.Size / 1024) / 1024),3)," ", 15) & " M : " & obj.Name
		if Err.Number <> 0 then
			Wscript.Echo "                  ( " & obj.Name & " : 処理できません )"
		else
			TargetSize = TargetSize + obj.Size
		end if
		on error goto 0


		Exit Do
	Loop


Next

Wscript.Echo

Dim AllSize
Dim er : er = 0
on error resume next
AllSize = objFolder.Size
if Err.Number <> 0 then
	er = 1
	AllSize	= TargetSize
end if
on error goto 0


Wscript.Echo Lpad(FormatNumber((Fix(TargetSize / 1024) / 1024),3)," ", 15) & " M : " & "表示合計"

if er = 1 then
	Wscript.Echo "                  ( " & target & " のサイズは取得できませんでした )"
else
	Wscript.Echo Lpad(FormatNumber((Fix(AllSize / 1024) / 1024),3)," ", 15) & " M : " & target & " のサイズ"
end if

Dim fsize : fsize = 0
For Each file in objFolder.files
	fsize = fsize + file.size
Next
Wscript.Echo Lpad(FormatNumber((Fix((fsize) / 1024) / 1024),3)," ", 15) & " M : " & target & " 下のファイル"

Wscript.Echo

' ************************************************
' ディレクトリ選択
' ************************************************
Function SelectDir( strTitle )

	Dim obj

	Set obj = Shell.BrowseForFolder( 0, strTitle, &H4B, 0 )
	if obj is nothing then
		SelectDir = ""
		Exit Function
	end if
	if not obj.Self.IsFileSystem then
		ErrorMessage = "ファイルシステムではありません"
		SelectDir = ""
		Exit Function
	end if

	SelectDir = obj.Self.Path

End Function

' ************************************************
' ダブルクォートで囲む
' ************************************************
Function Dd( strValue )

	Dd = """" & strValue & """"

End function

' ************************************************
' 指定数、指定文字列左側を埋める
' ************************************************
Function Lpad( strValue, str, nLen )

	Lpad = Right( String(nLen,str) & strValue, nLen )

End Function

Set WshShell = Wscript.CreateObject("WScript.Shell")
Set Fso = Wscript.CreateObject("Scripting.FileSystemObject")

strTemp = WshShell.ExpandEnvironmentStrings("%temp%")
strPath = strTemp & "\__clipCommand.tmp"

Set objHandle = Fso.OpenTextFile( strPath, 2, True )
objHandle.Write Wscript.Arguments(0)

Call WshShell.Run( "cmd.exe /c clip < """ & strPath & """", 0, True )

Set WshShell = Wscript.CreateObject("WScript.Shell")
Set Fso = Wscript.CreateObject("Scripting.FileSystemObject")

strTemp = WshShell.ExpandEnvironmentStrings("%temp%")
strPath = strTemp & "\__clipCommand.tmp"

Set objHandle = Fso.OpenTextFile( strPath, 2, True )
strName = Wscript.Arguments(0)
aPath = Split(strName,"\")
strName = aPath(Ubound(aPath))
objHandle.Write strName

Call WshShell.Run( "cmd.exe /c clip < """ & strPath & """", 0, True )

Set WshShell = Wscript.CreateObject("WScript.Shell")
Set Fso = Wscript.CreateObject("Scripting.FileSystemObject")

str = ""
For I = 0 to Wscript.Arguments.Count-1
	aData = Split( Wscript.Arguments(I), "\" )
	str = str & aData(Ubound(aData)) & vbCrLf
Next

strTemp = WshShell.ExpandEnvironmentStrings("%temp%")
strPath = strTemp & "\__clipCommand.tmp"

Set objHandle = Fso.OpenTextFile( strPath, 2, True )
objHandle.Write str
Call WshShell.Run( "cmd.exe /c clip < """ & strPath & """", 0, True )

strName = "BK_C_temp_lightbox"
strTarget = "C:\temp\lightbox"
strBackupFolder = "C:\tmp\vbs"
if MsgBox( strTarget & vbCrLf & "のバックアップを開始します。よろしいですか? (保存先:" & strBackupFolder & "\" & strName & ")", 1 ) = 2 then
	Wscript.Quit
end if
Set WshShell = Wscript.CreateObject( "WScript.Shell" )
ExecCommand = "cmd.exe /C ""xcopy.exe """ & strTarget & """ """ & strBackupFolder & "\" & strName & "\"" /D /E /C /S /Y & PAUSE"""
Call WshShell.Run( ExecCommand )

' ***********************************************************
' 処理開始
' ***********************************************************
Set Fso = Wscript.CreateObject( "Scripting.FileSystemObject" )
Set Shell = Wscript.CreateObject( "Shell.Application" )

' ***********************************************************
' 実行中ディレクトリの取得
' ***********************************************************
strPath = Wscript.ScriptFullName 
Set objFile = Fso.GetFile( strPath )
strBackupFolder = Fso.GetParentFolderName( objFile )

' ***********************************************************
' バックアップ対象ディレクトリの取得
' ***********************************************************
' ① 省略すると、ルートはデスクトップ
Set objFolder = Shell.BrowseForFolder( 0, "バックアップするフォルダを選択してください", &H4B )

' ② 文字列による直接指定
' strRoot = "c:\"
' Set objFolder = Shell.BrowseForFolder( 0, "バックアップするフォルダを選択してください", &H4B, strRoot )

' ③ ルートを番号で指定( この場合は C:\Users\username\AppData\Local )
' ※ あまり現実的ではない特殊ディレクトリの選択
' nRoot = &h1c
' Set objFolder = Shell.BrowseForFolder( 0, "バックアップするフォルダを選択してください", &H4B, nRoot )

if objFolder is nothing then
	WScript.Quit
end if
if not objFolder.Self.IsFileSystem then
	WScript.Echo "ファイルシステムではありません"
	WScript.Quit
end if

strTargetFolder = objFolder.Self.Path
strName = Replace( strTargetFolder, ":", "" )
strName = Replace( strName, "\", "_" )
strName = Replace( strName, " ", "" )
strName = "BK_" & strName

' ***********************************************************
' スクリプト作成
' ***********************************************************
Set OutFile = Fso.OpenTextFile( strBackupFolder & "\" & strName & ".vbs", 2, True )

OutFile.WriteLine "strName = """ & strName & """"
OutFile.WriteLine "strTarget = """ & strTargetFolder & """"
OutFile.WriteLine "strBackupFolder = """ & strBackupFolder & """"
OutFile.Write "if MsgBox( strTarget & vbCrLf & ""のバックアップを開始します。よろしいですか? (保存先:"" & strBackupFolder & ""\"" & strName & "")"""
OutFile.WriteLine ", 1 ) = 2 then"
OutFile.WriteLine "	Wscript.Quit"
OutFile.WriteLine "end if"

OutFile.WriteLine "Set WshShell = Wscript.CreateObject( ""WScript.Shell"" )"
OutFile.Write "ExecCommand = ""cmd.exe /C """"xcopy.exe """""" & strTarget & """""" """""" & strBackupFolder & ""\"" & strName & ""\"""""
OutFile.WriteLine " /D /E /C /S /Y & PAUSE"""""""
OutFile.WriteLine "Call WshShell.Run( ExecCommand )"

OutFile.Close

WScript.Echo "バックアップスクリプト : " &  strName & ".vbs" & " を作成しました"


' ***********************************************************
' ディレクトリ指定用番号
' https://docs.microsoft.com/ja-jp/windows/desktop/api/shldisp/ne-shldisp-shellspecialfolderconstants
' typedef enum {
' 	ssfALTSTARTUP = 0x1d,
' 	ssfAPPDATA = 0x1a,
' 	ssfBITBUCKET = 0x0a,
' 	ssfCOMMONALTSTARTUP = 0x1e,
' 	ssfCOMMONAPPDATA = 0x23,
' 	ssfCOMMONDESKTOPDIR = 0x19,
' 	ssfCOMMONFAVORITES = 0x1f,
' 	ssfCOMMONPROGRAMS = 0x17,
' 	ssfCOMMONSTARTMENU = 0x16,
' 	ssfCOMMONSTARTUP = 0x18,
' 	ssfCONTROLS = 0x03,
' 	ssfCOOKIES = 0x21,
' 	ssfDESKTOP = 0x00,
' 	ssfDESKTOPDIRECTORY = 0x10,
' 	ssfDRIVES = 0x11,
' 	ssfFAVORITES = 0x06,
' 	ssfFONTS = 0x14,
' 	ssfHISTORY = 0x22,
' 	ssfINTERNETCACHE = 0x20,
' 	ssfLOCALAPPDATA = 0x1c,
' 	ssfMYPICTURES = 0x27,
' 	ssfNETHOOD = 0x13,
' 	ssfNETWORK = 0x12,
' 	ssfPERSONAL = 0x05,
' 	ssfPRINTERS = 0x04,
' 	ssfPRINTHOOD = 0x1b,
' 	ssfPROFILE = 0x28,
' 	ssfPROGRAMFILES = 0x26,
' 	ssfPROGRAMFILESx86 = 0x30,
' 	ssfPROGRAMS = 0x02,
' 	ssfRECENT = 0x08,
' 	ssfSENDTO = 0x09,
' 	ssfSTARTMENU = 0x0b,
' 	ssfSTARTUP = 0x07,
' 	ssfSYSTEM = 0x25,
' 	ssfSYSTEMx86 = 0x29,
' 	ssfTEMPLATES = 0x15,
' 	ssfWINDOWS = 0x24
' } ShellSpecialFolderConstants;
' ***********************************************************

if WScript.Arguments.Count = 1 then
	strMessage = "送るから実行して下さい" & vbCrLf & vbCrLf
	strMessage = strMessage & "※ リンク先の最後の数字はコマンドプロンプトの行数です　　　" & vbCrLf
	strMessage = strMessage & "※ プロパティよりウインドウを最大化する方法もあります　　　" & vbCrLf
	Call MsgBox(strMessage,0,"lightbox")
	Wscript.Quit
end if

Set WshShell = CreateObject( "WScript.Shell" )   
Set Fso = CreateObject( "Scripting.FileSystemObject" )

strCurPath = WScript.ScriptFullName
Set obj = Fso.GetFile( strCurPath )
Set obj = obj.ParentFolder
strCurPath = obj.Path

strCommand = "cmd /c mode CON lines="&WScript.Arguments(0)&" & cscript.exe """ & _
strCurPath & "\dump_c.vbs"" """ & WScript.Arguments(1) & """ | more & pause"
Call WshShell.Run( strCommand )

' ****************************************************
' ファイルを１６進数でダンプします
' ****************************************************
Dim Fs,Stream
Dim InFile
Dim Kana
Dim KjFlg
Kana = Array( _
"｡","｢","｣","､","･","ｦ","ｧ","ｨ","ｩ","ｪ","ｫ","ｬ","ｭ","ｮ","ｯ", _
"ｰ","ｱ","ｲ","ｳ","ｴ","ｵ","ｶ","ｷ","ｸ","ｹ","ｺ","ｻ","ｼ","ｽ","ｾ","ｿ", _
"ﾀ","ﾁ","ﾂ","ﾃ","ﾄ","ﾅ","ﾆ","ﾇ","ﾈ","ﾉ","ﾊ","ﾋ","ﾌ","ﾍ","ﾎ","ﾏ", _
"ﾐ","ﾑ","ﾒ","ﾓ","ﾔ","ﾕ","ﾖ","ﾗ","ﾘ","ﾙ","ﾚ","ﾛ","ﾜ","ﾝ","ﾞ","ﾟ" )

Set Fs = CreateObject( "Scripting.FileSystemObject" )
Set Stream = CreateObject("ADODB.Stream")

InFile = WScript.Arguments(0)

Dim LineBuffer,DispBuffer,CWork,nCnt,strBuff,i,j

if not Fs.FileExists( InFile ) then
	Wscript.Echo "ファイルが存在しません"
	Wscript.Quit
end if

' ------------------------------------------------------
' Stream のオープン
Stream.Open
 
' ------------------------------------------------------
' Stream タイプの指定
Stream.Type = 1		' StreamTypeEnum の adTypeBinary
 
' ------------------------------------------------------
' 既存ファイルの内容を Stream に読み込む
Stream.LoadFromFile InFile
 
' ------------------------------------------------------
' バイナリ型の Stream オブジェクトからを読み取って加工
Bcnt = 0
nCnt = 0
KjFlg = ""

Do while not Stream.EOS

	if ( nCnt MOD 16 ) = 0 then
		Wscript.Echo "          0  1  2  3  4  5  6  7" _
		& "  8  9  A  B  C  D  E  F"
		Wscript.Echo "--------------------------------" _
		& "------------------------------------------"
	end if

	' 16 バイトの読込
	LineBuffer = Stream.Read(16)

	strBuff = ""
	For i = 1 to LenB( LineBuffer )
		CWork = MidB(LineBuffer,i,1)
		Cwork = AscB(Cwork)
		Cwork = Hex(Cwork)
		Cwork = Ucase(Cwork)
		Cwork = Right( "0" & Cwork, 2 )
		DispBuffer = DispBuffer & Cwork & " "
		strBuff = strBuff & CharConv( Cwork )
	Next

	Wscript.Echo _
		Right( _
			"00000000" & Ucase(Hex( nCnt * 16 )), 8 _
		) & " " & _
		Left(DispBuffer & String(49," "), 49 ) & strBuff
	DispBuffer = ""

	nCnt = nCnt + 1
 
Loop
 
' ------------------------------------------------------
' Stream を閉じる
Stream.Close

Set Stream = Nothing
Stream = Empty
Set Fs = Nothing
Fs = Empty

' ****************************************************
' 生データのテキスト
' ****************************************************
function CharConv( HexCode )

	Dim nCode

	nCode = Cint( "&H" & HexCode )

	if KjFlg = "" then
		if &H81 <= nCode and nCode <= &H84 or _
			&H88 <= nCode and nCode <= &H9f or _
			&HE0 <= nCode and nCode <= &HEA then
			KjFlg = HexCode
			CharConv = ""
			Exit Function
		end if
	else
		if HexCode <> "00" then
			KjFlg = KjFlg & HexCode
			CharConv = Chr( Cint( "&H" & KjFlg ) )
		else
			CharConv = ".."
		end if
		KjFlg = ""
		Exit Function
	end if

	if 0 <= nCode and nCode <= &H1F then
		CharConv = "."
	end if
	if &H20 <= nCode and nCode <= &H7E then
		CharConv = Chr(nCode)
	end if
	if &H7F <= nCode and nCode <= &HA0 then
		CharConv = "."
	end if
	if &HA1 <= nCode and nCode <= &HDF then
		CharConv = Kana(nCode-&HA1)
	end if
	if &HE0 <= nCode and nCode <= &HFF then
		CharConv = "."
	end if

end function