'====================================================================
' AJPapps - New drive no seme
' Линда Кайе 2010. Посвящается Ариэль
' 
' Этот яойный скрипт беспощадно насилует диск в надежде, что слабые 
' места найдутся сразу. Скажем, с его помощью можно заранее выявить, 
' что винт будет выключаться при больших количествах записываемой 
' информации или на флэшке есть пара сбойных блоков, из-за который 
' слетает вся файловая система.
' 
' В отличие от AJPapps - Drive no seme, этот скрипт выполнен в 
' форме, собственно, скрипта, и оперирует не с кучей мелких файлов, 
' а с одним очень большим файлом. Также он не имеет интерфейса 
' пользователя. Возможно, позже я просто расширю функционал 
' программы, основываясь на этом скрипте.
' 
' На данный момент программа имеет ограничение на FAT томах. Там она 
' может создать файл не более 4Гб, а дальше получит сообщение об 
' ошибке. Поэтому она закроет текущий файл и начнёт писать новый. 
' И так до реального заполнения диска.
' 
' • 15.04.2010
'   Первая версия ^^
' 
'====================================================================
' Маленький копирайт
' 
' 1. Программа и исходный код распространяются бесплатно.
' 2. Вы имеете право распространять их на тех же условиях.
' 3. Вы не имеете права использовать имя автора после модификации 
'    исходного кода.
' 4. При этом желательно указывать ссылку на автора оригинальной 
'    версии исходного кода.
' 5. Вы не имеете права на платное распространение исходного кода, 
'    а также программных модулей, содержащих данный исходный код.
' 6. Программа и исходный код распространяются как есть. Автор не 
'    несёт ответственности за любые трагедии или несчастные случаи, 
'    вызванные использованием программы и исходного кода.
' 7. Для любого пункта данного соглашения может быть сделано 
'    исключение с разрешения автора программы.
' 8. По любым вопросам, связанным с данной программой, обращайтесь 
'    по адресу lindaoneesama@gmail.com
' 
' Загружено с http://purl.oclc.org/Linda_Kaioh/Homepage/
'====================================================================
Option Explicit

Const AppTitle = "AJPapps - New drive no seme"

' Размер блока.
Const CHUNK_SIZE = 1024

Dim FSO
Dim File
Dim Drive
Dim BaseName

If WScript.Arguments.Count <> 1 Then
  ShowUsage
  WScript.Quit
End If

Drive = WScript.Arguments(0)
Drive = UCase(Drive)
Drive = Trim(Drive)

If Len(Drive) <> 1 Then
  If Len(Drive) = 2 And Right(Drive, 1) = ":" Then
    Drive = Left(Drive, 1)
  Else
    ShowUsage
    WScript.Quit
  End If
End If

If Asc(Drive) < Asc("A") Or Asc(Drive) > Asc("Z") Then
  ShowUsage
  WScript.Quit
End If

On Error Resume Next

Set FSO = CreateObject("Scripting.FileSystemObject")

Do
  Err.Clear
  BaseName = ":\Yaoi." & Year(Now) & Month(Now) & Day(Now) & _
             Hour(Now) & Minute(Now) & Second(Now) & ".EAT"

  Set File = FSO.CreateTextFile(Drive & BaseName)
  If Err Then
    MsgBox Drive & BaseName & vbCrlf & vbCrLf & _
           "Не удалось создать файл. Возможно, диск " & _
           "защищён от записи." & vbCrLf & vbCrLf & _
           "Error number: " & Err.Number & vbCrLf & _
           "Description:  " & Err.Description, _
           vbCritical, AppTitle
    WScript.Quit
  End If

  Do While Err.Number = 0
    File.Write String(CHUNK_SIZE, "Ы")
  Loop
  
  File.Close
  
  ' Хитрая штука. Если произошла ошибка, то тут либо диск переполнен, 
  ' либо мы наткнулись на ограничение размера файла. Чтобы учесть 
  ' это, проверяем сколько места осталось.
  If Err.Number = &h80070070 Then
    If FSO.GetDrive(Drive & ":").AvailableSpace < CHUNK_SIZE Then
      MsgBox "Disk " & Drive & ": full!", vbInformation, AppTitle
      WScript.Quit
    End If
  Else
    MsgBox Drive & BaseName & vbCrlf & vbCrLf & _
           "Произошла ошибка записи файла." & vbCrLf & vbCrLf & _
           "Error number: " & Err.Number & vbCrLf & _
           "Description:  " & Err.Description, _
           vbCritical, AppTitle
    WScript.Quit
  End If
Loop

'====================================================================
Private Sub ShowUsage()
  MsgBox "NewDiskFucker.VBS DriveLetter" & vbCrLf & _
         vbCrLf & _
         "DriveLetter - буква диска, на который будет " & _
         "записываться очень большой файл.", _
         vbInformation, AppTitle
End Sub