unit FileSys;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, FileCtrl;
type
TForm1 = class(TForm)
ListBox1: TListBox;
GroupBox1: TGroupBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
DriveComboBox1: TDriveComboBox;
procedure FormCreate(Sender: TObject);
procedure ListBox1Click(Sender: TObject);
procedure DriveComboBox1Change(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
function DriveExists(Drive : Byte) : Boolean;
begin
Result := Boolean(GetLogicalDrives AND(1 SHL Drive))
end;
function DriveExists1(Drive : Byte) : Boolean;
var
LogDrives : set of 0..25;
begin
Integer (LogDrives) := GetLogicalDrives;
Result := Drive IN LogDrives;
end;
function CheckDriveType(Drive : Byte) : String;
var
DriveLetter : Char;
DriveType : UInt;
begin
DriveLetter := Char(Drive + $41);
DriveType := GetDriveType(PChar(DriveLetter + ':\'));
Case DriveType of
0 : Result := '?';
1 : Result := 'Path does not exists';
DRIVE_REMOVABLE : Result := 'Removable';
DRIVE_FIXED : Result := 'Fixed';
DRIVE_REMOTE : Result := 'Remote';
DRIVE_CDROM : Result := 'CD-ROM';
DRIVE_RAMDISK : Result := 'RAMDISK'
Else
Result := 'Unknown';
end;
end;
{GetVolumeInformation}
function GetFileSysName(Drive : Byte) : String;
var
DriveLetter : Char;
NoMatter : Integer;
FileSysName : Array[0..MAX_PATH] of Char;
begin
DriveLetter := Char(Drive + $41);
GetVolumeInformation(PChar(DriveLetter + ':\'), Nil,
0,nil,NoMatter, NoMatter, FileSysName,
SizeOf(FileSysName));
Result := FileSysName;
end;
function GetVolumeName(Drive : Byte) : String;
var
DriveLetter : Char;
NoMatter : Integer;
VolumeName : Array[0..MAX_PATH] of Char;
begin
DriveLetter := Char(Drive + $41);
GetVolumeInformation(PChar(DriveLetter + ':\'), VolumeName,
SizeOf(VolumeName),nil,NoMatter, NoMatter, Nil,0);
Result := VolumeName;
end;
function GetVolumeFlags(Drive : Byte) : Integer;
var
DriveLetter : Char;
NoMatter : Integer;
FileSysFlags : Integer;
begin
DriveLetter := Char(Drive + $41);
GetVolumeInformation(PChar(DriveLetter + ':\'), nil,0,
nil,FileSysFlags, NoMatter, Nil,0);
Result := FileSysFlags;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
D : Byte;
begin
For D := 0 to 25 do
If DriveExists(D) Then
Begin
ListBox1.Items.Add(Chr(D+$41));
End;
end;
procedure TForm1.ListBox1Click(Sender: TObject);
var
Drive : Byte;
FileSysFlags : Integer;
begin
Label1.Caption := ''; Label2.Caption := '';
Label3.Caption := ''; Label4.Caption := '';
With ListBox1 do
Drive := Ord(Items[ItemIndex][1])-$41;
Label6.Caption := GetFileSysName(Drive);
FileSysFlags := GetVolumeFlags(Drive);
If FS_CASE_IS_PRESERVED AND FileSysFlags <> 0 Then
Label1.Caption := 'FS_CASE_IS_PRESERVED';
If FS_CASE_SENSITIVE AND FileSysFlags <> 0 Then
Label2.Caption := 'FS_CASE_SENSITIVE';
If FS_UNICODE_STORED_ON_DISK AND FileSysFlags <> 0 Then
Label3.Caption := 'FS_UNICODE_STORED_ON_DISK';
If FS_PERSISTENT_ACLS AND FileSysFlags <> 0 Then
Label4.Caption := 'FS_PERSISTENT_ACLS'
end;
procedure TForm1.DriveComboBox1Change(Sender: TObject);
var
CurDrive : Byte;
FileSysFlags : Integer;
begin
With DriveComboBox1 do
Begin
Label1.Caption := ''; Label2.Caption := '';
Label3.Caption := ''; Label4.Caption := '';
CurDrive := Ord(Drive)-$41;
Label6.Caption := GetFileSysName(CurDrive);
FileSysFlags := GetVolumeFlags(CurDrive);
If FS_CASE_IS_PRESERVED AND FileSysFlags <> 0 Then
Label1.Caption := 'FS_CASE_IS_PRESERVED';
If FS_CASE_SENSITIVE AND FileSysFlags <> 0 Then
Label2.Caption := 'FS_CASE_SENSITIVE';
If FS_UNICODE_STORED_ON_DISK AND FileSysFlags <> 0 Then
Label3.Caption := 'FS_UNICODE_STORED_ON_DISK';
If FS_PERSISTENT_ACLS AND FileSysFlags <> 0 Then
Label4.Caption := 'FS_PERSISTENT_ACLS'
end;
end;
end.
|