Klon floppy

[MadMax]

Vielen Dank jetzt funtzt das Teil auch. Nur leider hat diese Schlüssel Diskette noch einen Schutz aber es war trotzdem eine gute Übung. Ich Poste noch mal den Code.

Delphi-Quellcode:

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.