[Чипырик]

Здраствуйте!
Подскажите, пожайлуста, как программно отключить Floppy-дисковод. Или хотябы сделать так, чтобы на него нельзя было ничего записать/считать

[Thrasher]

Хукать функцию CreateFile и проверять имя файла. Или в БИОС отключить его.

[Чипырик]

А вот такой вот код я нашел:
CD-ROM блокирует, а Флопи не хочет.
Может что-то надо поправить?

Код:

var
  Form1: TForm1;
  function CheckDriveType(Drive: Byte): string; //Функция Определения Типа устройств
  procedure CD_Lock( DriveLetter: string; Locked: Boolean ); //Процедура блокировки-разблокировки

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

{$R *.dfm}

procedure TForm1.Button2Click(Sender: TObject);
begin
if Edit1.Text<>'' then CD_Lock( Edit1.Text, true ) else MessageDlg('Не выбрано устройство.', mtInformation, [mbOk], 0);

end;

procedure TForm1.Button3Click(Sender: TObject);
begin
if Edit1.Text<>'' then CD_Lock( Edit1.Text, false ) else MessageDlg('Не выбрано устройство.', mtInformation, [mbOk], 0);
end;

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

end;

procedure TForm1.ComboBox1Change(Sender: TObject);
begin
 Edit1.Text:=ComboBox1.Text[1]+':';
end;
end.

[Чипырик]

Вот ребята с другого форума поделились кодом для отключения Флоппи.
Проверил на Win XP2 Работает на ура

Код:

const 
 FILE_DEVICE_FILE_SYSTEM: Integer = $00000009; 
 METHOD_BUFFERED: Integer = $00000000; 
 FILE_ANY_ACCESS: Integer = $00000000; 
function CTL_CODE(DeviceType, FunctionNo, Method, Access: Integer): Integer; 
begin 
 Result := (DeviceType shl 16) or (Access shl 14) or (FunctionNo shl 2) or (Method); 
end; 
procedure TForm1.Button1Click(Sender: TObject); 
var 
 LHandle: THandle; 
 BytesReturned: Cardinal; 
 MsgBuf: PChar; 
 FSCTL_LOCK_VOLUME: Integer; 
begin 
 FSCTL_LOCK_VOLUME := CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 6, 
                                                  METHOD_BUFFERED, FILE_ANY_ACCESS); 
 LHandle := CreateFile('\\.\A:', GENERIC_READ or GENERIC_WRITE, FILE_SHARE_READ 
                      or FILE_SHARE_WRITE, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL or 
                      FILE_FLAG_DELETE_ON_CLOSE, 0); 
 if LHandle <> 0 then 
 begin 
   if DeviceIOControl(LHandle, FSCTL_LOCK_VOLUME, nil, 0, nil, 0, BytesReturned, nil) then 
     ShowMessage('Дисковод заблокирован. Нажмите ОК для разблокирования.') 
   else 
   begin 
     if FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER or 
          FORMAT_MESSAGE_FROM_SYSTEM, nil, GetLastError(), 0, @MsgBuf, 0, nil) > 0 then 
     begin 
       ShowMessage('Ошибка DeviceIOControl: ' + MsgBuf); 
       LocalFree(Cardinal(MsgBuf)); 
     end 
     else 
       ShowMessage('Ошибка при вызове DeviceIOControl!'); 
   end; 
   CloseHandle(LHandle); 
 end 
 else 
   ShowMessage('Ошибка при вызове CreateFile!'); 
end;