'====================================================================
' AJPapps - Drive bars (text edition)
' Линда Кайе 2013-2014. Посвящается Ариэль
' 
' Этот скрипт родился из новой фичи WR266 - информации о дисках, 
' а именно шкал заполненности в текстовом виде. По сути, эта фича 
' WR266 была всего лишь немного модифицированным кодом Drive Bars, 
' и мне захотелось написать программу, которая будет выводить те же 
' шкалы по запросу. Писать самостоятельную программу не хотелось, 
' поэтому я просто написала скрипт, портировав кусок кода WR266. 
' Информация, которую он показывает, почти эквивалентна информации 
' в дополнительных данных WR266.
' 
' ВНИМАНИЕ! В программе использован кустарный алгоритм сокращения 
' размера (перевод в мегабайты, гигабайты и терабайты), так что 
' цифры могут немного не соответствовать цифрам из Drive Bars. 
' Но теоретически они вычисляются правильно, разница в способах 
' округления.
' 
' Также программа использует кустарный способ определения Subst 
' дисков. Она запоминает для каждого диска метку тома, серийный 
' номер и общий размер и последующие диски с теми же данными 
' отсекает. Если реальный диск имеет букву, идущую после Subst 
' диска, то программа посчитает первый диск реальным. А если 
' случится чудо, и в системе найдётся два реальных диска 
' с одинаковыми размерами, метками и серийными номерами, то второй 
' диск тоже будет проигнорирован.
' 
' Программа поддерживает два параметра командной строки:
' /NoLogo - отменяет вывод баннера с названием программы.
' /NoIndent - убирает пробелы перед шкалами.
' 
' • 7.05.2013
'   Первая версия ^^
'
' • 13.05.2014
'   [-] Возникала ошибка, если один из дисков имел имя тома длиннее 
'       одиннадцати символов.
' 
'====================================================================
' Маленький копирайт
' 
' 1. Программа и исходный код распространяются бесплатно.
' 2. Вы имеете право распространять их на тех же условиях.
' 3. Вы не имеете права использовать имя автора после модификации 
'    исходного кода.
' 4. При этом желательно указывать ссылку на автора оригинальной 
'    версии исходного кода.
' 5. Вы не имеете права на платное распространение исходного кода, 
'    а также программных модулей, содержащих данный исходный код.
' 6. Программа и исходный код распространяются как есть. Автор не 
'    несёт ответственности за любые трагедии или несчастные случаи, 
'    вызванные использованием программы и исходного кода.
' 7. Для любого пункта данного соглашения может быть сделано 
'    исключение с разрешения автора программы.
' 8. По любым вопросам, связанным с данной программой, обращайтесь 
'    по адресу lindaoneesama@gmail.com
' 
' Загружено с http://purl.oclc.org/Linda_Kaioh/Homepage/
'====================================================================
Option Explicit

Const AppTitle = "AJPapps - Drive bars (text edition)"

Const DRIVE_CDROM = 4
Const DRIVE_REMOTE = 3
Const DRIVE_UNKNOWN = 0
Const DRIVE_NO_ROOT_DIR = 0 ' Фиг его знает!

Const BAR_WIDTH = 22 '18 '20
Const DEF_INDENT = "    "

Const SET_WRAI_ShowFreeSpace = True

Const MULTIPLER = 1024

Dim FSO
Dim DiskIDs
Dim Indent

Dim sTotal  ' Static
Dim sFree   ' Static

DoIt

'====================================================================
Private Sub DoIt()
  Dim TXT
  
  Set FSO = CreateObject("Scripting.FileSystemObject")
  Set DiskIDs = CreateObject("Scripting.Dictionary")
  
  SetIndent
  
  TXT = ShowLogo
  TXT = TXT & GetDiskInfo2()
  
  WScript.Echo TXT
End Sub

Private Function ShowLogo()
  Dim TMP
  
  For TMP = 0 To WScript.Arguments.Count - 1
    If UCase(WScript.Arguments(TMP)) = "/NOLOGO" Then Exit Function
  Next
  
  ShowLogo = AppTitle & vbCrLf & _
             "Линда Кайе 2013-2014. Посвящается Ариэль" & vbCrLf & _
             vbCrLf
End Function

Private Sub SetIndent()
  Dim TMP
  
  For TMP = 0 To WScript.Arguments.Count - 1
    If UCase(WScript.Arguments(TMP)) = "/NOINDENT" Then 
      Indent = ""
      Exit Sub
    End If
  Next
  
  Indent = DEF_INDENT
End Sub

'====================================================================
Private Function GetDiskInfo2()
  Dim Drives
  Dim Drive
  Dim DT
  
  Set Drives = FSO.Drives
  
  For Each Drive In Drives
    DT = Drive.DriveType
    
    If DT <> DRIVE_CDROM Then
      If DT <> DRIVE_REMOTE Then
        If DT <> DRIVE_UNKNOWN Then
          If DT <> DRIVE_NO_ROOT_DIR Then
            If Drive.DriveLetter <> "A" Then
              If Drive.DriveLetter <> "B" Then
                If Not IsSubstDrive(Drive) Then
                  If Drive.TotalSize <> 0 Then
                    GetDiskInfo2 = GetDiskInfo2 & GetDiskBar(Drive) & vbCrLf
                  End If
                End If
              End If
            End If
          End If
        End If
      End If
    End If
  Next
  
  ' Саммари...
  GetDiskInfo2 = GetDiskInfo2 & GetDiskBar(Nothing)
End Function

Private Function IsSubstDrive(ByRef Drive)
  Dim DiskID
  
  ' Для отладки...
  'IsSubstDrive = False
  'Exit Function
  
  DiskID = UCase(Drive.VolumeName & "_" & Drive.SerialNumber & "_" & Drive.TotalSize)
  If DiskIDs.Exists(DiskID) Then
    IsSubstDrive = True
  Else
    DiskIDs.Add DiskID, DiskID
    IsSubstDrive = False
  End If
End Function

Private Function GetDiskBar(ByRef Drive)
  Dim Percent
  Dim Total
  Dim Free
  Dim VolumeName
  Dim FilledBar
  
  If Drive Is Nothing Then
    Total = sTotal
    Free = sFree
    
    sTotal = 0
    sFree = 0
    
    GetDiskBar = Indent & "Мой компьютер          "
  Else
    Total = Drive.TotalSize
    Free = Drive.FreeSpace
    
    sTotal = sTotal + Total
    sFree = sFree + Free
    
    VolumeName = Drive.VolumeName
    VolumeName = Left(VolumeName, 11) ' It can be longer!
    VolumeName = VolumeName & String(11 - Len(VolumeName), " ")
    
    GetDiskBar = Indent & "Диск " & Drive.DriveLetter & ": " & _
                 "[" & VolumeName & "]  "
  End If
  
  If Total = 0 Then
    Percent = 0
  Else
    Percent = Free / (Total / 100)
  End If
  
  If SET_WRAI_ShowFreeSpace Then
    FilledBar = String(Round((BAR_WIDTH / 100) * Percent, 0), "|")
  Else
    FilledBar = String(Round((BAR_WIDTH / 100) * (100 - Percent), 0), "|")
  End If
  FilledBar = FilledBar & String(BAR_WIDTH - Len(FilledBar), ".")
  GetDiskBar = GetDiskBar & "[" & FilledBar & "]"
  
  If SET_WRAI_ShowFreeSpace Then
    GetDiskBar = GetDiskBar & "  " & asFormatByteSizeEx(Free) & _
                              " / " & asFormatByteSizeEx(Total)
  Else
    GetDiskBar = GetDiskBar & "  " & asFormatByteSizeEx(Total - Free) & _
                              " / " & asFormatByteSizeEx(Total)
  End If
  
  'If DiskLetter <> "" Then
  '  Dim Serial As Long
  '  Dim SerialString As BStr
  '
  '  Serial = asGetVolumeSerialNumber(DiskLetter & ":\")
  '  SerialString = asFormatVolumeSerialNumber( Serial)
  '
  '  GetDiskBar = GetDiskBar & "  [" & _
  '                            asGetVolumeFileSystemName(DiskLetter & ":\") & _
  '                            " | " & SerialString & "]"
  'End If
End Function

Private Function asFormatByteSizeEx(ByVal Number)
  Dim Suffix
  
  If Number < MULTIPLER Then
    Suffix = " байт"
  Else
    Number = Round(Number / MULTIPLER, 2)
    If Number < MULTIPLER Then
      Suffix = " Кб"
    Else
      Number = Round(Number / MULTIPLER, 2)
      If Number < MULTIPLER Then
        Suffix = " Мб"
      Else
        Number = Round(Number / MULTIPLER, 2)
        If Number < MULTIPLER Then
          Suffix = " Гб"
        Else
          Number = Round(Number / MULTIPLER, 2)
          If Number < MULTIPLER Then
            Suffix = " Тб"
          End If ' Теребайтов хватит всем!
        End If
      End If
    End If
  End If
  
  ' Тоже нужно думать =_=
  asFormatByteSizeEx = FormatNumber(Number) & Suffix
End Function