[jeckp]

Подскажите как можно распознать тип устройства (Flash, CD, DWD, HD, FD, MO, Zip и другие) и как можно (за)разблокировать съемные устройства от случайного их извлечения.

[Decoding]

Код:

function 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;

Функция CheckDriveType выдаст тебе тип найденного устройства. Тут есть небольшой нюанс. Функция выдаст Removable для съемных устройств, таких, например, как Floppy или USB Flash. Тут смотри по индексу: если i = 0 или 1, то это Floppy, а если i > 1, то это USB Flash (или другое съемное устройство).

[Decoding]

Заблокировать/разблокировать CD можно так:

Код:

procedure CD_Lock( DriveLetter: string; Locked: Boolean );
const
  IOCTL_STORAGE_MEDIA_REMOVAL = $002D4804;
var
  hDrive: THandle;
  Returned: DWORD;
begin
   hDrive := CreateFile( PChar( '\\.\' + DriveLetter ), GENERIC_READ,
                         FILE_SHARE_READ, nil, OPEN_EXISTING,
                         FILE_ATTRIBUTE_NORMAL, 0 );
   if GetLastError <> 0 then
      MessageDlg( 'Ошибка: ' + IntToStr( GetLastError ), mtError, [mbOK], 0 );
   try
      if not DeviceIoControl( hDrive,
                              IOCTL_STORAGE_MEDIA_REMOVAL, // PREVENT_MEDIA_REMOVAL,
                              @Locked, SizeOf( Locked ),
                              nil, 0, Returned, nil ) then
         MessageDlg( 'Ошибка: ' + IntToStr( GetLastError ), mtError, [mbOK], 0 );
   finally
      CloseHandle( hDrive );
   end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   // Заблокировать
   CD_Lock( 'f:', true );
   // Разблокировать
   CD_Lock( 'f:', false );
end;