'------------------------------------------------------------------------
'               Copyright (C) 2002 Marios Polyzoes. marpoly@geo. gr
'------------------------------------------------------------------------
'SN: 020801

Dim fso, cd, f, ts, thisFolder, AllFolders, Fname, fc, drv, result, d, dc, n, s, t

L_Welcome_MsgBox_Message_Text   = "This script reads the folders and files" & Chr(13) & "contained in a Drive root " & Chr(13) & "and makes a file named folders_files_of_Drive_X.txt" & Chr(13) & Chr(13) & "Available drives on your system are:" & Chr(13) & ShowDriveList
L_Welcome_MsgBox_Title_Text     = "Utility by Marios Polyzoes. marpoly@ geo.gr"
Call Welcome()

' ********************************************************************************

cd = InputBox("Enter the CD letter: i.e D or E")
Const ForReading = 1, ForWriting = 2, ForAppending = 8
  Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
 result = "folders_files_of_Drive_" & UCase(cd) & ".txt"
  fso.CreateTextFile (result)
  Set f = fso.GetFile(result)
  Set ts = f.OpenAsTextStream(ForWriting, TristateUseDefault)
  
set thisFolder = fso.GetFolder(cd & ":\")
Set AllFolders = ThisFolder.SubFolders
drv = cd & ":"
ts.WriteLine Date & "  " & Time
ts.WriteLine ""
ts.WriteLine "---------------------------------------------------"
ts.WriteLine ShowFreeSpace (drv)
ts.WriteLine "---------------------------------------------------"
ts.WriteLine ""
ts.WriteLine "FOLDERS:"
ts.WriteLine "---------------------------------"
For Each folder in AllFolders
Fname = Folder.Name
ts.WriteLine Fname
Next
ts.WriteLine ""
ts.WriteLine ""
ts.WriteLine "FILES:"
ts.WriteLine "---------------------------------"
Set fc = thisFolder.files
For Each f1 in fc
Fname = f1.Name
ts.WriteLine Fname
Next

 ts.Close
WScript.Echo "The work is done. Thanks!"

Function ShowFreeSpace(drvPath)
   Dim fso, d, s
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set d = fso.GetDrive(fso.GetDriveName(drvPath))
   s = "Drive " & UCase(drvPath) & " - Name:" 
   s = s & d.VolumeName  &  ",  "
   s = s & "Free Space: " & FormatNumber(d.FreeSpace/1048576, 0) 
'  s = s & "Free Space: " & FormatNumber(d.FreeSpace/1024, 0) 
   s = s & " Mbytes"
   ShowFreeSpace = s
End Function

Function ShowDriveList
Set fso = CreateObject("Scripting.FileSystemObject")
   Set dc = fso.Drives
   For Each d in dc
      n = ""
      s = s & d.DriveLetter & " - " 
       Select Case d.DriveType
      Case 0: t = "Unknown"
      Case 1: t = "Removable"
      Case 2: t = "Fixed"
      Case 3: t = "Network"
      Case 4: t = "CD-ROM"
      Case 5: t = "RAM Disk"
   End Select

      If d.DriveType = Remote Then
         n = d.ShareName
      ElseIf d.IsReady Then
         n = d.VolumeName
      End If
      
      s = s & n & "  " & Chr(9) & Chr(9)& t & Chr(13)
   Next
   ShowDriveList = s
End Function

' ********************************************************************************
' *
' * Welcome
' *
Sub Welcome()
    Dim intDoIt

    intDoIt =  MsgBox(L_Welcome_MsgBox_Message_Text, _
                      vbOKCancel + vbInformation,    _
                      L_Welcome_MsgBox_Title_Text )
    If intDoIt = vbCancel Then
        WScript.Quit
    End If
End Sub