FAQ VCL
Железо\Диски\Общие вопросы

:: Меню ::
:: На главную ::
:: FAQ ::
:: Заметки ::
:: Практика ::
:: Win API ::
:: Проекты ::
:: Скачать ::
:: Секреты ::
:: Ссылки ::

:: Сервис ::
:: Написать ::

:: MVP ::

:: RSS ::

Яндекс.Метрика

Как определить, какие диски находятся на компьютере?

// Способ первый
function TForm1.CheckDriveType(Drive: Byte): string;
var
  DriveLetter: Char;
  DriveType: UInt;
begin
   DriveLetter := Chr( 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;

procedure TForm1.Button1Click(Sender: TObject);
var
  i: 0..25;
begin
   for i := 0 to 25 do
      if CheckDriveType( i ) <> 'Path does not exists' then
         Memo1.Lines.Add( Format( '%s - %s', [chr( i+$41 ), CheckDriveType( i )] ) );
end;

// Способ второй
uses
  System.IOUtils, System.Types;

procedure TForm1.Button1Click(Sender: TObject);
var
  FileName: string;
begin
   // Простое перечисление дисков
   for FileName in TDirectory.GetLogicalDrives do
      ShowMessage(FileName);
end;


Как проверить, существует ли диск в системе?

function DriveExists(Drive: Byte): boolean; 
begin
   Result := ( GetLogicalDrives and ( 1 shl Drive ) ) <> 0;
end;

procedure TForm1.Button1Click(Sender : TObject);
var
  Drive: byte;
begin
   for Drive := 0 to 25 do
      if DriveExists( Drive ) then
         ListBox1.Items.Add( Chr( Drive + $41 ) + ': присутствует' )
      else
         ListBox1.Items.Add( Chr( Drive + $41 ) + ': отсутствует' );
end;


Как проверить готовность диска к работе?

// Способ первый
function DiskInDrive( const Drive: char ): boolean;
var
  DrvNum: byte;
  EMode: Word;
begin
   Result := true;
   DrvNum := Ord( Drive );
   if DrvNum >= Ord( 'a' ) then
      Dec( DrvNum, $20 );
   EMode := SetErrorMode( SEM_FAILCRITICALERRORS );
   try
      while DiskSize( DrvNum - $40 ) = -1 do
      begin
         if ( Application.MessageBox( 'Диск не готов...' + #13 + #10 +
              'Повторить?', PChar( 'Диск '+ UpperCase( Drive ) ),
              mb_OKCANCEL + MB_ICONEXCLAMATION ) = IDCANCEL ) then
         begin
            Result := false;
            Break;
         end;
      end;
   finally
      SetErrorMode( EMode );
   end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   if DiskInDrive( 'a' ) then
      ShowMessage( 'Диск готов' )
   else
      ShowMessage( 'Диск не готов' );
end;

// Способ второй
function DiskInDrive( const Drive: char ): boolean;
var
  DrvNum: byte;
  EMode: Word;
begin
   Result := false;
   DrvNum := ord( Drive );
   if DrvNum >= ord( 'a' ) then Dec( DrvNum, $20 );
   EMode := SetErrorMode( SEM_FAILCRITICALERRORS );
   try
      if DiskSize( DrvNum - $40 ) <> -1 then
         Result := true
      else
         MessageBeep( 0 );
   finally
      SetErrorMode( EMode );
   end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   if DiskInDrive( 'a' ) then
      ShowMessage( 'Диск готов' )
   else
      ShowMessage( 'Диск не готов' );
end;

// Способ третий
function DiskInDrive( Drive: Char ): Boolean; 
var
  ErrorMode: Word;
begin
   if Drive in ['a'..'z'] then Dec( Drive, $20 );
   if not ( Drive in ['A'..'Z'] ) then
      raise EConvertError.Create( 'Не верно указан диск' );
   ErrorMode := SetErrorMode( SEM_FailCriticalErrors );
   try
      if DiskSize( Ord( Drive ) - $40 ) = -1 then
         Result := false
      else
         Result := true;
   finally
      SetErrorMode( ErrorMode );
   end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   if not DiskInDrive( 'a' ) then
      ShowMessage( 'Диск не готов' );
end;

// Способ четвертый
function IsDriveReady( DriveLetter: char ): boolean;
var
  OldErrorMode: Word;
  OldDirectory: string;
begin
   OldErrorMode := SetErrorMode( SEM_NOOPENFILEERRORBOX );
   GetDir( 0, OldDirectory );
   {$I-}
      ChDir( DriveLetter + ':\' );
   {$I+}
   if IoResult <> 0 then
      Result := false
   else
      Result := true;
   ChDir( OldDirectory );
   SetErrorMode( OldErrorMode );
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   if not IsDriveReady( 'a' ) then
      ShowMessage( 'Диск не готов' )
   else
      ShowMessage( 'Диск готов' );
end;

// Способ пятый
function IsDiskInDrive( Drive: string ): boolean;
var
  ErrMode: Cardinal;
  VolName: array[0..255] of Char;
  FS: array[0..255] of Char;
  MaxComSize: Cardinal;
  Flags: Cardinal;
begin
   ErrMode := SetErrorMode(SEM_FAILCRITICALERRORS);
   try
      Result := GetVolumeInformation( PChar( Drive ), VolName,
                                      SizeOf( VolName ), nil, MaxComSize,
                                      Flags, FS, SizeOf( FS ) );
   finally
      SetErrorMode( ErrMode );
   end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   if not IsDiskInDrive( 'A:' ) then
      raise Exception.Create( 'Дискеты нет' );
end;


Как показать свойства диска?

uses
  {...,} ShellAPI;

procedure ShowDiskProperties( Path: string );
var
  SEInfo: TShellExecuteInfo;
begin
   FillChar( SEInfo, SizeOf( SEInfo ), 0 );
   SEInfo.cbSize := SizeOf( TShellExecuteInfo );
   with SEInfo do
   begin
      fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_INVOKEIDLIST or SEE_MASK_FLAG_NO_UI;
      Wnd := Application.Handle;
      lpFile := PChar( Path );
      lpVerb := 'Properties';
      lpParameters := '';
      hInstApp := 0;
      lpIDList := nil;
      lpDirectory := PChar( Path );
      nShow := SW_SHOWNORMAL;
   end;
   ShellExecuteEx( @SEInfo );
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   ShowDiskProperties( 'c:\' ); // Свойства диска
end;

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