(**********************************************)
(* Name: DriveType                            *)
(* Last Revision: 1st November 2005           *)
(* Version: 1.6                               *)
(*                                            *)
(* Copyright © 2000 - 2005, Christian Aaangel *)
(**********************************************)

unit DriveType;

interface

Uses
 Windows,
 ShellApi,
 SysUtils,
 Comobj;

Type
  TDriveType = (dtUnknown, dtNoDrive, dtFloppy, dtFixed, dtNetwork, dtCDROM,
    dtRAM);
  TDriveInfo = Record
   Volumelabel: String;
   FileSystem: String;
   Drivetype: String;
   DiskCapasity: Int64;
   DiskFree: Int64;
   DiskUsed: Int64;
  End;

Function DriveType_Version: String;
Function DriveType_Date: String;
Function TypeofDrive(Drive: Char): String;
Function GetDriveInfo(Drive: Char): TDriveInfo;
Function GetVolumeLabel(Drive: Char): String;
// Version 1.5
Function BuildDriveList(ofFloppy, ofFixed, ofCD, ofNetwork, ofRam: Boolean): String;
// Version 2.0
Function NTypeofDrive(Drive: Char): Byte; // Same function as TypofDrive, but uses numbers to enable the use of CASE

implementation

Function DriveType_Version: String;
Begin
 Result := '2.0';
End;

Function DriveType_Date: String;
Begin
 Result := '16 apr. 2000';
End;

Function TypeofDrive(Drive: Char): String;
Var
 S: String;
 DriveType : TDrivetype;
begin
  DriveType := TDriveType(GetDriveType(PChar(Drive+':\')));
  If Drivetype = dtUnknown Then S := 'Unknown';
  If Drivetype = dtNoDrive Then S := 'No drive';
  If Drivetype = dtFloppy Then S := 'Floppy';
  If Drivetype = dtFixed Then S := 'Fixed';
  If Drivetype = dtNetwork Then S := 'Network';
  If Drivetype = dtCDROM Then S := 'CDROM';
  If Drivetype = dtRAM Then S := 'Ram';
  Result := S;
end;

Function NTypeofDrive(Drive: Char): Byte;
Var
 S: Byte;
 DriveType : TDrivetype;
begin
  S := 0;
  DriveType := TDriveType(GetDriveType(PChar(Drive+':\')));
  If Drivetype = dtUnknown Then S := 0;
  If Drivetype = dtNoDrive Then S := 1;
  If Drivetype = dtFloppy Then S := 2;
  If Drivetype = dtFixed Then S := 3;
  If Drivetype = dtNetwork Then S := 4;
  If Drivetype = dtCDROM Then S := 5;
  If Drivetype = dtRAM Then S := 6;
  Result := S;
end;

function FileSystem(AFileName: string): String;
var
  fso, drv: OleVariant;
begin
  Result := 'Unknown';
  Try
   fso := CreateOleObject('Scripting.FileSystemObject');
   drv := fso.GetDrive(fso.GetDriveName(AFileName));
   result := drv.filesystem;
  except
  end;
end;

function GetVolumeLabel(Drive: Char): String;
Var
 VName: array[0..255] of Char;
 VMaxLength: Cardinal;
 VSystemFlags: Cardinal;
 VFileSystemName: array[0..255] of Char;
begin
 Result := '';
 If not GetVolumeInformation(Pchar(Drive + ':\'), VName, 255, nil, VMaxLength,
   VSystemFlags, VFileSystemName, 255) then exit;
 Result := VName;
end;

Function GetDriveInfo(Drive: Char): TDriveInfo;
Var
 TempInfo: TDriveInfo;
Begin
 TempInfo.Volumelabel := GetVolumeLabel(Drive);
 TempInfo.DriveType := TypeOfDrive(Drive);
 TempInfo.DiskCapasity := DiskSize(Ord(Drive)-64);
 TempInfo.DiskFree := DiskFree(Ord(Drive)-64);
 TempInfo.DiskUsed := TempInfo.DiskCapasity - TempInfo.DiskFree;
 TempInfo.FileSystem := Filesystem(drive + ':\');
 Result := TempInfo;
End;

Function BuildDriveList(ofFloppy, ofFixed, ofCD, ofNetwork, ofRam: Boolean): String;
// Creates a string of valid drive letters seperated by ';' use filter(tm) to seperate
// eg. "A;C;D;E;F;G"
Var
 I, First, Last: Integer;
 Res: String;
Begin
 If ofFloppy Then First := ord('A')
  else First := ord('C');
 Last := ord('Z');
 For I := First to Last do begin
  If (Typeofdrive(Chr(I)) = 'Floppy') and (ofFloppy) Then Res := Res + Chr(I) + ';';
  If (Typeofdrive(Chr(I)) = 'Fixed') and (ofFixed) Then Res := Res + Chr(I) + ';';
  If (Typeofdrive(Chr(I)) = 'CDROM') and (ofCD) Then Res := Res + Chr(I) + ';';
  If (Typeofdrive(Chr(I)) = 'Network') and (ofNetwork) Then Res := Res + Chr(I) + ';';
  If (Typeofdrive(Chr(I)) = 'Ram') and (ofRam) Then Res := Res + Chr(I) + ';';
 End;
 If Length(Res) > 0 then begin
  If Res[Length(Res)] = ';' Then Res := Copy(Res, 1, length(Res) - 1); // Remove trailing ;
 end;
 Result := Res;
End;


end.
