| 
                          Как определить, какие диски находятся на компьютере?
                           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; 
                          Как проверить, существует ли диск в системе? 
                          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;
  
                           
                          Система: Windows 10 x64, Windows XP 
                          Среды программирования: Delphi 7, Delphi 10 Seattle 
                           
                          Я не профессионал, я всего лишь любитель 
                          Я не вредитель, я всего лишь теоретик
                         |