Программирование на Delphi

FAQ VCL
Железо\Диски\HDD & Floppy

:: Меню ::

:: На главную ::

:: FAQ ::

:: Заметки ::

:: Практика ::

:: Win API ::

:: Проекты ::

:: Скачать ::

:: Секреты ::

:: Ссылки ::

:: Сервис ::

:: Написать ::

:: MVP ::

:: RSS ::

Как узнать объем жесткого диска?


function TForm1.GetTotalSpaceMb(Root: string): string;
var
  free, total: int64;
  call: int64;
  Gb, Mb, Kb, b: integer;
begin
   GetDiskFreeSpaceEx( PChar( Root ), free, total, @call );
   Gb := total div 1000000000;
   Mb := ( total mod 1000000000 ) div 1000000;
   Kb := ( total mod 1000000 ) div 1000;
   b := total mod 1000;
   Result := Format( '%d %.3d %.3d %.3d', [Gb, Mb, Kb, b] );
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   ShowMessage( GetTotalSpaceMb( 'c:\' ) );
end;

Как узнать объем свободного места жесткого диска?


function TForm1.GetFreeSpaceMb(Root: string): string;
var
  free, total: int64;
  call: int64;
  Gb, Mb, Kb, b: integer;
begin
   GetDiskFreeSpaceEx( PChar( Root ), free, total, @call );
   Gb := free div 1000000000;
   Mb := ( free mod 1000000000 ) div 1000000;
   Kb := ( free mod 1000000 ) div 1000;
   b := free mod 1000;
   Result := Format( '%d %.3d %.3d %.3d', [Gb, Mb, Kb, b] );
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   ShowMessage( GetFreeSpaceMb( 'c:\' ) );
end;

Как узнать объем занятого места жесткого диска?


function TForm1.GetFullSpaceMb(Root: string): string;
var
  free, total: int64;
  call: int64;
  Gb, Mb, Kb, b: integer;
begin
   GetDiskFreeSpaceEx( PChar( Root ), free, total, @call );
   Gb := ( total - free ) div 1000000000;
   Mb := ( ( total - free ) mod 1000000000 ) div 1000000;
   Kb := ( ( total - free ) mod 1000000 ) div 1000;
   b := ( total - free ) mod 1000;
   Result := Format( '%d %.3d %.3d %.3d', [Gb, Mb, Kb, b] );
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   ShowMessage( GetFullSpaceMb( 'c:\' ) );
end;

Как определить тип файловой системы на указанном диске?


function TForm1.GetHDDFileSystem( ADisk: Char ): String;
var
  SerialNum           : DWORD;
  VolumeName, FSName  : array [0..255] of Char;
  MaximumFNameLength,
  FileSystemFlags     : DWORD;
begin
   Result := '';
   if GetVolumeInformation( PChar( ADisk + ':\' ),
                            VolumeName, SizeOf( VolumeName ),
                            @SerialNum,
                            MaximumFNameLength,
                            FileSystemFlags,
                            FSName, SizeOf( FSName ) ) then
   Result := FSName;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   ShowMessage( GetHDDFileSystem( 'c' ) );
end;

Как определить метку тома на указанном диске?


function TForm1.GetHDDLabel( ADisk: Char ): String;
var
  SerialNum           : DWORD;
  VolumeName, FSName  : array [0..255] of Char;
  MaximumFNameLength,
  FileSystemFlags     : DWORD;
begin
   Result := '';
   if GetVolumeInformation( PChar( ADisk + ':\' ),
                            VolumeName, SizeOf( VolumeName ),
                            @SerialNum,
                            MaximumFNameLength,
                            FileSystemFlags,
                            FSName, SizeOf( FSName ) ) then
   Result := VolumeName;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   ShowMessage( GetHDDLabel( 'c' ) );
end;

Как изменить метку тома на указанном диске?


// Первый аргумент - том, метку которого нужно изменить
// Второй аргумент - новая метка

SetVolumeLabel( PChar( 'c:\' ), PChar( 'Win98' ) );

Как определить серийный номер тома?


function TForm1.GetHDDSerialNumber(ADisk: Char): String;
var
  SerialNum           : DWORD;
  VolumeName, FSName  : array [0..255] of Char;
  MaximumFNameLength,
  FileSystemFlags     : DWORD;
begin
   Result := '';
   if GetVolumeInformation( PChar( ADisk + ':\' ),
                            VolumeName, SizeOf( VolumeName ),
                            @SerialNum,
                            MaximumFNameLength,
                            FileSystemFlags,
                            FSName, SizeOf( FSName ) ) then
   Result := Format( '%.8x', [SerialNum] );
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   ShowMessage( GetHDDSerialNumber( 'c' ) );
end;

Как узнать общее количество кластеров на указанном диске?


function GetTotalNumberClusters( Disk: char ): Cardinal;
var
  SectorsPerCluster: Cardinal;    // Количество секторов в кластере
  BytesPerSector: Cardinal;       // Количество байт в секторе
  NumberOfFreeClusters: Cardinal; // Количество свободных кластеров
  TotalNumberClusters: Cardinal;  // Общее количество кластеров
begin
   GetDiskFreeSpace( PChar( Disk + ':\' ),
                     SectorsPerCluster, BytesPerSector,
                     NumberOfFreeClusters, TotalNumberClusters );
   Result := TotalNumberClusters;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   ShowMessage( IntToStr( GetTotalNumberClusters( 'c' ) ) );
end;

Как узнать количество свободных кластеров на указанном диске?


function GetNumberOfFreeClusters( Disk: Char ): Cardinal;
var
  SectorsPerCluster: Cardinal;    // Количество секторов в кластере
  BytesPerSector: Cardinal;       // Количество байт в секторе
  NumberOfFreeClusters: Cardinal; // Количество свободных кластеров
  TotalNumberClusters: Cardinal;  // Общее количество кластеров
begin
   GetDiskFreeSpace( PChar( Disk + ':\' ),
                     SectorsPerCluster, BytesPerSector,
                     NumberOfFreeClusters, TotalNumberClusters );
   Result := NumberOfFreeClusters;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   ShowMessage( IntToStr( GetNumberOfFreeClusters( 'c' ) ) );
end;

Как узнать количество занятых кластеров на указанном диске?


function GetNumberOfFullClusters( Disk: Char ): Cardinal;
var
  SectorsPerCluster: Cardinal;    // Количество секторов в кластере
  BytesPerSector: Cardinal;       // Количество байт в секторе
  NumberOfFreeClusters: Cardinal; // Количество свободных кластеров
  TotalNumberClusters: Cardinal;  // Общее количество кластеров
begin
   GetDiskFreeSpace( PChar( Disk + ':\' ),
                     SectorsPerCluster, BytesPerSector,
                     NumberOfFreeClusters, TotalNumberClusters );
   Result := TotalNumberClusters - NumberOfFreeClusters;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   ShowMessage( IntToStr( GetNumberOfFullClusters( 'c' ) ) );
end;

При использовании материала - ссылка на сайт обязательна