'Fills empty space on all hard drives with files containing blanks.
'Deletes the created files after all space has been filled.
'Files are created in a root folder of the drive named after the 
'time YMDHMS. If run with CSCRIPT, a status display shows what 
'drive is being processed, what size file is being created, And
'how many files of that size have been created. File sizes are
'displayed as a power of 2 ranging from 2^25 (32MB) to 2^9 (512).

Option Explicit

If MsgBox("OK to overwrite all empty space on all fixed drives with blanks?", vbYesNo, "Write Permission") <> vbYes Then
	WScript.Quit
End If

Main

Sub Main
Dim fso, drv, dir, ts, lngFiles, lngSpace, lngCounter, intFactor
	Set fso = CreateObject("Scripting.FileSystemObject")
	For Each drv In fso.Drives
		If drv.DriveType = 2 Then
			Set dir = fso.CreateFolder(drv.DriveLetter & ":\" & Year(Now) & Month(Now) & Day(Now) & Hour(Now) & Second(Now))
			Status "Creating files in folder " & dir.Path
			On Error Resume Next
			intFactor = 25
			Do Until intFactor = 8
				Do Until Err.Number <> 0
					'Create the first file of this size
					lngCounter = 1
					Set ts = fso.CreateTextFile(fso.BuildPath(dir.Path, intFactor & "-0.txt"))
					ts.Write String(2^intFactor, " ")
					Status drv.DriveLetter & ": 2^" & intFactor & " # 0 (" & Clng(drv.FreeSpace / (2^20)) & "MB free)"
					ts.Close
					Do Until Err.Number <> 0
						'Create more files this size by copying the first one
						fso.CopyFile fso.BuildPath(dir.Path, intFactor & "-0.txt"), fso.BuildPath(dir.Path, intFactor & "-" & lngCounter & ".txt")
						Status drv.DriveLetter & ": 2^" & intFactor & " # " & lngCounter & " (" & Clng(drv.FreeSpace / (2^20)) & "MB free)"
						lngCounter = lngCounter + 1
					Loop
				Loop
				intFactor = intFactor - 1
				WScript.Sleep 1000
				Err.Clear
			Loop
			fso.DeleteFolder dir.Path
		End If
	Next
End Sub

Sub Status(strMessage)
	If Lcase(Right(Wscript.FullName, 12)) = "\cscript.exe" Then
		Wscript.Echo strMessage
	End If
End Sub