type TDiskGeometry =
packed record
Cylinders: Int64;
MediaType: Integer;
TracksPerCylinder: DWORD;
SectorsPerTrack: DWORD;
BytesPerSector: Integer;
// wichtig für die Reservierung des Buffer-Speichers
end;
TRawDrive =
record
DiskGeometry: TDiskGeometry;
Handle: THandle;
end;
var raw: TRawDrive;
const
IOCTL_DISK_GET_DRIVE_GEOMETRY = $00070000;
FSCTL_LOCK_VOLUME = $00090018;
FSCTL_UNLOCK_VOLUME = $0009001C;
function RawOpenDrive(DriveLetter: Char): TRawDrive;
var num: Cardinal;
begin
FillChar(Result, SizeOf(TRawDrive), 0);
Result.Handle := CreateFile(PChar('
\\.\' + DriveLetter + '
:'),
GENERIC_READ
or GENERIC_WRITE,
FILE_SHARE_READ
or FILE_SHARE_WRITE,
nil,
OPEN_EXISTING,
0,
0);
if Result.Handle = INVALID_HANDLE_VALUE
then RaiseLastWin32Error;
if not DeviceIoControl(Result.Handle, FSCTL_LOCK_VOLUME,
nil, 0,
nil, 0, num,
nil)
then
begin
showmessage('
Laufwerk wird gerade benützt!!!');
// Laufwerk für andere sperren
halt;
end;
{Disk-Geometry ermitteln. Vor allem ist das Feld BytesPerSector wichtig,
da nur vielfache Bytes gelesen werden können. Ist also BytesPerSector z.B:
512 und man will nur 1 Byte lesen, muss man 512 Bytes lesen. }
if not DeviceIoControl(result.Handle, IOCTL_DISK_GET_DRIVE_GEOMETRY,
nil, 0, @Result.DiskGeometry,
SizeOf(TDiskGeometry), num,
nil)
then
begin
ShowMessage('
Keine Floppy im Laufwerk !!!');
halt;
end
end;
procedure RawCloseDrive(RawDrive: TRawDrive);
var num: Cardinal;
begin
DeviceIoControl(RawDrive.Handle, FSCTL_UNLOCK_VOLUME,
nil, 0,
nil, 0, num,
nil);
CloseHandle(RawDrive.Handle);
RawDrive.Handle := 0;
end;
procedure RawReadSectors(RawDrive: TRawDrive;
var Buf; Count: Integer);
var num: Cardinal;
begin
if not ReadFile(RawDrive.Handle, Buf, Count * RawDrive.DiskGeometry.BytesPerSector, num,
nil)
then
RaiseLastWin32Error;
end;
procedure RawWriteSectors(RawDrive: TRawDrive;
var Buf; Count: Integer);
var num: Cardinal;
begin
if not WriteFile(RawDrive.Handle, Buf, Count * RawDrive.DiskGeometry.BytesPerSector, num,
nil)
then
RaiseLastWin32Error;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
raw := RawOpenDrive('
a');
timer1.Enabled := true;
end;
procedure TForm1.Button1Click(Sender: TObject);
var buf:
array[0..(512 * 20
{Sektoren}) - 1]
of Byte;
MSG: Integer;
begin
RawReadSectors(raw, buf, 20);
Panel1.Color := clgreen;
if Sizeof(buf) = 10240
then
RawCloseDrive(raw);
MSG := Application.MessageBox('
Neue Floppy Einlegen','
Meldungsfenster',49);
if MSG = 1
then begin
raw := RawOpenDrive('
a');
RawWriteSectors(raw,buf, 20)
end
else
if MSG = 2
then
halt;
end;
procedure TForm1.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
RawCloseDrive(raw);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
button1.Enabled := true;
end;
end.