Как определить, какие диски находятся на компьютере? 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;