Lock floppy drive functions (Views: 27)
Problem/Question/Abstract: How can I lock a floppy drive so that it cannot access system functions like copy, move between hard disks etc.? Answer: The following code works for WinNT. You may need to enclose the main calls (CreateFile, DeviceIoControl, CloseHandle) inside a loop with a sleep interval because it fails sometimes. { ... } 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('Drive locked. Press OK to unlock.') else begin if FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER or FORMAT_MESSAGE_FROM_SYSTEM, nil, GetLastError(), 0, @MsgBuf, 0, nil) > 0 then begin ShowMessage('DeviceIOControl failed: ' + MsgBuf); LocalFree(Cardinal(MsgBuf)); end else ShowMessage('DeviceIOControl failed!'); end; CloseHandle(LHandle); end else ShowMessage('CreateFile failed!'); end; |