戻る

そもそもハードディスクを無駄なファイルで埋め尽くすことにどんな意味があるのか。
意味は、あるといえばある、ないといえばない、たぶん人によるんだと思います。
ここではこれ以上言及しません。

それはともかく。

いま自分の使っているパソコンのハードディスクの残は約5.5GBです(トータルで12GB)
世間一般の標準からするとべらぼうに少ないと思います。
でもこれだって、手作業のファイルコピー&ペーストで埋めようと思ったらけっこうな手間がかかる。
やるなら自動化したほうが絶対楽なはずです。

前ページで書いた大量画像一気吐き出しソフトも相当雑な代物ですが、さらに雑な、こんな感じのもので充分でしょう。

Celeron1200MHzのしょぼいマシンで無駄画像ファイル100MBつくるのに11〜12秒。
ちょっと遅いかなという感じ。
これだと1GBで2分、10GBで20分、100GBで3時間超(よくわかりませんけど、今どきのパソコンってそれぐらいの容量ありそう)

悠長に画像なんかつくってるから遅いんじゃないか。
文字列なら遥かに速いんじゃないか。

というわけで以下。
Option Explicit から "完了"まで、コピーしてメモ帳に貼り付け、"muda.vbs"とか適当な名前で保存してみてください(尻尾の4文字が .vbs なら何でも。ついでに、使った文字列はたまたま「000・・・」だけど、いわゆるハードディスク0埋めとは違うんで、「111・・・」でも「abc・・・」でも自分の名前でも住所でも」)
Option Explicit
On Error Resume Next
    Dim MyStrIP, MyStr0, MyStrDir, MyTM0, MyTM1
    Dim MyCnt, MyInc0, MyInc1
    Dim MyFSO, MyDRV, MyTXT
    Dim MyFreeSpace
    Dim MyChk
    
    MyCnt = 1
    MyStrIP = InputBox("100MBの巨大無駄ファイル、いくつ作る?")
    If MyStrIP = "" Then
        WScript.Quit
    End If
    If IsNumeric(MyStrIP) = False Then
        MsgBox "数字を入れろ", vbOKOnly, "何やってんだバカ"
        WScript.Quit
    End If
    MyCnt = Int(MyStrIP)
    MyTM0 = Time
    Set MyFSO = CreateObject("Scripting.FileSystemObject")
    Set MyDRV = MyFSO.GetDrive("C:")
    MyFreeSpace = Int(MyDRV.FreeSpace / 1048576)
    Set MyDRV = Nothing
    If 100 * MyCnt > MyFreeSpace - 500 Then
        Set MyFSO = Nothing
        MsgBox "100MBX" & MyCnt & "個なんて無茶だ、やめろ", vbOKOnly, "ハードディスクの残" & MyFreeSpace & "MB"
        WScript.Quit
    End If
    MyChk = False
    MyStrDir = CreateObject("WScript.Shell").CurrentDirectory & "\muda"
    For MyInc0 = 0 To 999
        If MyFSO.FolderExists(MyStrDir + Right("00" & MyInc0, 3)) = False Then
            MyStrDir = MyStrDir + Right("00" & MyInc0, 3)
            MyFSO.CreateFolder (MyStrDir)
            MyChk = True
            Exit For
        End If
    Next
    If MyChk = False Then
        MsgBox "とりあえず作りすぎた無駄フォルダ削除してくれ", vbOKOnly, "どうでもいいけど"
        WScript.Quit
    End If
    MyStr0 = ""
    For MyInc0 = 1 To 5120
        MyStr0 = MyStr0 & "0000000000" '10文字を5120回つなげて50KB
    Next


    For MyInc0 = 1 To MyCnt
        Set MyTXT = MyFSO.CreateTextFile(MyStrDir & "\" & Right("000" & MyInc0, 4), True)
        For MyInc1 = 1 To 2048 '50KBを2048回書き込んで100MB
            MyTXT.Write MyStr0
        Next
        MyTXT.Close
        Set MyTXT = Nothing
    Next
    Set MyFSO = Nothing
    MyTM1 = Time
    MsgBox MyTM0 & " - " & MyTM1, vbOKOnly, "完了"

これで処理時間は、100MBあたり約10秒(画像でも文字でも変わんねーじゃん)
文字をつなげる回数と書き込む回数のバランスを変えると、いくらか速くなったり遅くなったりしますけど、それでもびっくりするほどの違いは出ない。

何だか分からないのでとりあえずこれで妥協と。

ハードディスクの残が何十GBあるにせよ、一気にやらずに1GBぐらいずつ潰していったほうが無難です。
処理中砂時計は出ません。 「完了」のメッセージが出るまで我慢して待ってください(VBSというかWSHでは砂時計を出すのはきっと無理)

上のコードはほぼそのままAccessやExcelなどMSOfficeのVBAでも使えます(→例)
処理途中抜けの書き方がいくらか違う程度(VBSだとWScript.Quit、VBAだとExit SubかExit Function)
あと現在地の取得法がAccess、Excelでそれぞれ独特(OfficeVBA中で CreateObject("WScript.Shell").CurrentDirectory を使うと、現在地じゃなく、それぞれのアプリのデフォルト保存場所になる模様)

この処理でMSOfficeを使う唯一のメリットは、砂時計が出せること(Wordについてはやりかたが分からない。もうどうでもいい)
それだけのメリットのためにExcelだのAccessだの馬鹿重いアプリを立ち上げるのもどうかと思います。
ここはメモ帳で充分でしょう。

出来上がった巨大無駄ファイルはあえて開きにくいように拡張子なしにしてあります。
その気になればメモ帳で開けますけどやめたほうがいいと思います。
たぶんマシンがフリーズする。
運良く開けたとしても、"0"がびっしり並んでるだけ。
(大量画像吐き出し型のほうは、一個あたり2MBのbitmapファイルなので、簡単に開けます。ただ中身は何てこともない只の色と柄)

さて、ハードディスクの残ぎりぎりまで無駄なファイルで埋めたら、次はそれを削除しましょう。
べつに放っておいてもいいんですけど、そのマシンをこれからも使い続けるなら、無駄なファイルは消したほうがいいです。
これも手作業よりは、以下のスクリプトで一撃("delphi_mudabmp.exe" "muda.vbs"と同じフォルダ中に、"deletemuda.vbs"とか名前を付けて保存して使ってください)
Option Explicit
On Error Resume Next
    Dim MyStrDir
    Dim MyInc
    Dim MyFSO
    Dim MyChk
    
    MyChk = False
    Set MyFSO = CreateObject("Scripting.FileSystemObject")
    MyStrDir = CreateObject("WScript.Shell").CurrentDirectory & "\muda"
    For MyInc = 0 To 999
        If MyFSO.FolderExists(MyStrDir + Right("00" & MyInc, 3)) = True Then
            MyFSO.DeleteFolder (MyStrDir + Right("00" & MyInc, 3))
            MyChk = True
        End If
    Next
    Set MyFSO = Nothing
    If MyChk = True Then
        MsgBox "削除完了"
    Else
        MsgBox "削除する相手が全然いない"
    End If