procedure TForm1.FormCreate(Sender: TObject);
var C:Char;
    RootPath:PChar;
begin
ListBox1.Clear;GetMem(RootPath,16);
For C:='A' to 'Z' do begin
  StrPLCopy(RootPath,C+':\',16);
  case GetDriveType(RootPath) of
  0:ListBox1.Items.Add(C+':\ (неизвестный)');
  DRIVE_REMOVABLE:ListBox1.Items.Add(C+':\ (съемный)');
  DRIVE_FIXED:ListBox1.Items.Add(C+':\ (жесткий)');
  DRIVE_REMOTE:ListBox1.Items.Add(C+':\ (сетевой)');
  DRIVE_CDROM:ListBox1.Items.Add(C+':\ (компакт диск)');
  DRIVE_RAMDISK:ListBox1.Items.Add(C+':\ (RAM диск)');
  end;
end;
FreeMem(RootPath,16);
end;

procedure TForm1.ListBox1Click(Sender: TObject);
Function GetNorm(I:Int64):string;
var Letter:char;
    G:double;
begin Letter:=#0;
if I>1024 then begin
  G:=I/1024;Letter:='k';
  if G>1024 then begin
  G:=G/1024;Letter:='M';
  if G>1024 then begin
    G:=G/1024;Letter:='G';
  end;
  end;
end else G:=I;
if Letter=#0 then Result:=inttostr(I)
else Result:=Format('%6.2f',[G])+Letter;
end;
Function MakeSerial(I:dword):string;
begin
Result:=Format('%x',[I]);
Insert('-',Result,5);
end;
var RootPathName,VolumeName,FileSystemName:PChar;
    Serial,MaxLen,Flags:dword;
    FreeAvail,Total,TotalFree:Int64;
    Handle:dword;
begin
Memo1.Lines.Clear;
GetMem(RootPathName,128);
GetMem(VolumeName,128);
GetMem(FileSystemName,128);
StrPLCopy(RootPathName,Copy(ListBox1.Items[ListBox1.ItemIndex],1,3),128);
if GetVolumeInformation(RootPathName,VolumeName,128,@Serial,MaxLen,Flags,FileSystemName,128) then begin
  GetDiskFreeSpaceEx(RootPathName,FreeAvail,Total,@TotalFree);
  Memo1.Lines.Add('Диск '+StrPas(RootPathName)+' ('+StrPas(FileSystemName)+')');
  Memo1.Lines.Add('Свободно '+GetNorm(FreeAvail)+' из '+GetNorm(Total));
  Memo1.Lines.Add('Метка тома: '+StrPas(VolumeName));
  Memo1.Lines.Add('Серийный номер тома: '+MakeSerial(Serial));
  Memo1.Lines.Add('Максимальная длина имени: '+inttostr(MaxLen));
  if Flags and FS_CASE_IS_PRESERVED<>0 then Memo1.Lines.Add('Регистр файлов сохраняется');
  if Flags and FS_CASE_SENSITIVE<>0 then Memo1.Lines.Add('Регистр учитывается');
  if Flags and FS_UNICODE_STORED_ON_DISK<>0 then Memo1.Lines.Add('Имена файлов записываются в Unicode');
  if Flags and FS_PERSISTENT_ACLS<>0 then Memo1.Lines.Add('Сохраняет и спользует ACLы (???)');
  if Flags and FS_FILE_COMPRESSION<>0 then Memo1.Lines.Add('Файловая система поддерживает сжатие');
  if Flags and FS_VOL_IS_COMPRESSED<>0 then Memo1.Lines.Add('Диск сжат (возможно, DoubleSpace)');
  Handle:=CreateFile(RootPathname,GENERIC_READ,0,nil,OPEN_EXISTING,FILE_FLAG_BACKUP_SEMANTICS,0);
  if Handle<>INVALID_HANDLE_VALUE then begin
  CloseHandle(Handle);
  Memo1.Lines.Add('Диск доступен для чтения');
  end else Memo1.Lines.Add('Диск недоступен для чтения');
  lstrcat(RootPathname,'temp.$$$');
  Handle:=CreateFile(RootPathName,GENERIC_WRITE,0,nil,CREATE_ALWAYS,FILE_FLAG_DELETE_ON_CLOSE,0);
  if Handle<>INVALID_HANDLE_VALUE then begin
  CloseHandle(Handle);
  Memo1.Lines.Add('Диск доступен для записи');
  end else Memo1.Lines.Add('Диск недоступен для записи');
end else Memo1.Lines.Add('Диск '+StrPas(RootPathName)+' (недоступен)');
Memo1.Perform(WM_VSCROLL,SB_TOP,0);
if Memo1.Lines.Count>6 then Memo1.ScrollBars:=ssVertical
else Memo1.ScrollBars:=ssNone;
FreeMem(FileSystemName,128);
FreeMem(VolumeName,128);
FreeMem(RootPathName,128);
end;