unit ScreenDriveSummary;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    ButtonShowList: TButton;
    Memo1: TMemo;
    procedure ButtonShowListClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
{$R *.DFM}

USES
  FileCtrl; // TDriveType


// From www.gnomehome.demon.nl/uddf/pages/disk.htm#disk0
// Also see http://community.borland.com/article/0,1410,15921,00.html
FUNCTION DiskInDrive(CONST Drive: CHAR): BOOLEAN;
  VAR
    DriveNumber:  BYTE;
    ErrorMode  : Word;
BEGIN
  RESULT := FALSE;
  DriveNumber := ORD( UpCase(Drive) );
  ErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
  TRY
    // 'A'=1, 'B'=2, ... in DiskSize call
    IF   DiskSize(DriveNumber-ORD('A')+1) <> -1
    THEN RESULT := TRUE
  FINALLY
    SetErrorMode(ErrorMode)
  end;
END;


// Attempt to create temporary file on specified drive.
// If created, the temporary file is deleted.
FUNCTION IsDiskWriteProtected(CONST drive:  CHAR):  BOOLEAN;
  VAR
    ErrorMode:  Word;
    PathName :  STRING;
    TempName :  STRING;
BEGIN
  ErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
  TRY
    ASSERT (Upcase(drive) IN ['A'..'Z'], 'Invalid drive specification');
    PathName := drive + ':\';    // example:  'A:\'
    SetLength(TempName, MAX_PATH+1);
    GetTempFileName(pChar(PathName), 'RWRO', 0, pChar(TempName));

    // GetLastError could be ERROR_PATH_NOT_FOUND but that is ignored here.
    RESULT := (GetLastError = Windows.ERROR_WRITE_PROTECT);

    // Delete temporary file.  Error if it does not exist.
    IF   NOT RESULT   // NOT R/O ==> Disk appears to be R/W
    THEN BEGIN
      // If file cannot be deleted, then the disk is write protected, or
      // possibly the media is absent
      RESULT := NOT DeleteFile(TempName);
    END
  FINALLY
    SetErrorMode(ErrorMode)
  END
END {IsDiskWriteProtected};


// Assumes non-proportional "Terminal" font in TMemo
// Limited to 2 GB values in D3 -- no limit in D4
PROCEDURE ShowDrives(CONST MemoInfo:  TMemo);
  VAR
    DriveBits         :  SET OF 0..25;
    DriveIndex        :  INTEGER;
    DriveLetter       :  CHAR;
    DriveType         :  TDriveType;
    NotUsed           :  DWORD;   // Use DWORD for D3/D4 compatibility
    ReadWrite         :  STRING;
    s                 :  STRING;
    VolumeFlags       :  DWORD;
    VolumeInfo        :  ARRAY[0..MAX_PATH] OF CHAR;
    VolumeSerialNumber:  INTEGER;

  FUNCTION GetDriveTypeString(CONST DriveType: TDriveType):  STRING;
  BEGIN
    CASE DriveType OF
      dtFloppy :  RESULT := 'Floppy';
      dtFixed  :  RESULT := 'Fixed';
      dtNetwork:  RESULT := 'Network';
      dtCDROM  :  RESULT := 'CDROM';
      dtRAM    :  RESULT := 'RAM';
      ELSE        RESULT := 'Unknown'
    END
  END {GetDriveTypeString};

{$IFDEF VER100}          // Delphi 3
  FUNCTION FormatBytes(CONST Bytes:  DWORD):  STRING;
{$ELSE}                   // Delphi 4 or greater
  FUNCTION FormatBytes(CONST Bytes:  Int64):  STRING;
{$ENDIF}
  BEGIN
    IF   Bytes < 0
    THEN RESULT := 'not available'
    ELSE RESULT := FormatFloat('0,', Bytes)
  END {FormatBytes};

begin
  Screen.Cursor := crHourGlass;

  TRY
    // Assumes MemoInfo is using a fixed font, like courier new
    MemoInfo.Lines.Add('Disks');
    MemoInfo.Lines.Add('');
    MemoInfo.Lines.Add('    Drive   R/W   Total Bytes       Free Bytes    Vol Ser     Label');
    MemoInfo.Lines.Add('  --------- --- ---------------- ---------------- -------- -------------');

    // GetLogicalDrives returns a bitmask representing the currently
    // available disk drives. Bit position 0 (the least-significant bit) is drive
    // A, bit position 1 is drive B, bit position 2 is drive C, and so on.
    INTEGER(DriveBits) := GetLogicalDrives;

    //  Look at Drives A .. Z
    FOR  DriveIndex := 0 TO 25 DO
    BEGIN
      IF  DriveIndex IN DriveBits
      THEN BEGIN
        DriveLetter := CHR(ORD('A') + DriveIndex);

        DriveType   := TDriveType(GetDriveType(pChar(DriveLetter + ':\')));

        GetVolumeInformation(pChar(DriveLetter + ':\'),
                             VolumeInfo, SizeOf(VolumeInfo),
                             @VolumeSerialNumber, NotUsed, VolumeFlags, NIL, 0);

        IF   DiskInDrive(DriveLetter)
        THEN BEGIN
          IF   IsDiskWriteProtected(DriveLetter)
          THEN ReadWrite := 'R/O'
          ELSE ReadWrite := 'R/W';

          s := Format('  %s %-7s %3s %16s %16s %8.8X %s',
                      [DriveLetter,
                       GetDriveTypeString(DriveType),
                       ReadWrite,
                       FormatBytes(DiskSize(DriveIndex+1)),
                       FormatBytes(DiskFree(DriveIndex+1)),
                       VolumeSerialNumber,
                       VolumeInfo
                      ]
                     )
        END
        ELSE  s := Format('  %s %-7s %20s',
                      [DriveLetter,
                       GetDriveTypeString(DriveType),
                       '<disk missing>']);

        MemoInfo.Lines.Add(s);
      END
    END;

    MemoInfo.Lines.Add(' ')
  FINALLY
    Screen.Cursor := crDefault
  END
end {ShowDrives};



procedure TForm1.ButtonShowListClick(Sender: TObject);
begin
  Screen.Cursor := crHourGlass;
  TRY
    ShowDrives(Memo1)
  FINALLY
    Screen.Cursor := crDefault
  END
end;

end.