|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#1
|
|||
|
|||
Отключение Floppy-дисковода
Здраствуйте!
Подскажите, пожайлуста, как программно отключить Floppy-дисковод. Или хотябы сделать так, чтобы на него нельзя было ничего записать/считать |
#2
|
||||
|
||||
Хукать функцию CreateFile и проверять имя файла. Или в БИОС отключить его.
Хорошо написанная программа не требует документации ICQ 9-184-668. |
#3
|
|||
|
|||
А вот такой вот код я нашел:
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. |
#4
|
|||
|
|||
Вот ребята с другого форума поделились кодом для отключения Флоппи.
Проверил на 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; |