(**********************************************************************)
(*                                                                    *)
(* Ph�niX SoftCrew  Turbo Pascal Programme                            *)
(* most (c) by PSC Software Development Lippstadt/Warendorf           *)
(*                                                                    *)
(* Ph�niX SoftCrew          ####   ####  ####                         *)
(* c/o Carsten Strotmann    #   # ##    ##                            *)
(* An der Kreutzbrede 20    ####   ###  ##     Software Development   *)
(*                          #        ## ##                            *)
(* 4410 Warendorf 1         #     ####   ####                         *)
(*                                                                    *)
(**********************************************************************)

(*

  Programmname   :ATARI DOS 2.5 --> MS-DOS Copy
  Filename       :ACOPY2.PAS
  von            :CARSTEN STROTMANN
  letzte �nderung:
  Bemerkung      :

*)


PROGRAM ACopy2;

USES CRT, DOS, A_UNIT;

CONST
  q : STRING = '1';

VAR
  filea,
  fileb : STRING;
  driva,
  drivb : CHAR;

  FUNCTION UpString (str : STRING) : STRING;

  VAR
    u : BYTE;

  BEGIN
    FOR u := 1 TO Length (str) DO
      str[u]:=UpCase(str[u]);

    UpString := str;
  END;

PROCEDURE CopyAM (filea, fileb : STRING);

VAR
  drivenuma,
  entry,
  checkentry,
  bytes,
  cy, count,
  u, error    : BYTE;
  startsec,
  nextsec     : WORD;
  msdosfile   : FILE OF BYTE;
  buffer      : a_sector;

BEGIN
  drivenuma := Ord(filea[2]) - 49;

  Read_Dir (drivenuma);

  Delete (filea,1,3);
  entry := A_FindFirst (filea);

  IF entry > 0 THEN
  BEGIN
    startsec := a_dir[entry].startsec;

    fileb := FExpand (fileb);

    WriteLn ('Kopiere ATARI DOS 2.x File ',filea,' nach MS-DOS File ',fileb);
    WriteLn;
    WriteLn;

    cy := WhereY;

    IF cy = 25 THEN
    BEGIN
      Dec(cy);
      GotoXY (1,1);
      DelLine;
    END;

    Assign (msdosfile,fileb);
    ReWrite (msdosfile);

    nextsec := startsec;
    error := 0;
    count := 0;

    WHILE (nextsec > 0) AND (error = 0) AND (nextsec < 720) DO
    BEGIN
      GotoXY (5,cy);
      WriteLn ('Lese ',filea,' Sektor #',nextsec,'  ');

      REPEAT
        Read_A_Sector (drivenuma,0,nextsec,buffer);

        error := DiskStatus;

        IF error > 0 THEN
        BEGIN
          Inc (count);
          DiskReset;
        END;

        bytes := buffer.secsize;

        checkentry := (buffer.sectordat[253] AND $FC) SHR 2;

        nextsec := (buffer.sectordat[253] AND $03) * $100 + buffer.sectordat[254];

      UNTIL (error = 0) AND (nextsec > 0) AND (nextsec < 720) OR (count > 10);

      FOR u := 0 TO bytes-1 DO
        Write (msdosfile, buffer.sectordat[u]);

      count := 0;

    END;

    IF error > 0 THEN
    BEGIN
      WriteLn;
      WriteLn (' Diskettenfehler Code ',error);
    END;

    IF (nextsec > 719) OR (entry-1 <> checkentry) THEN
    BEGIN
      WriteLn;
      WriteLn (' Linkfehler ');
    END;

    Close (msdosfile);
  END
  ELSE
  BEGIN
    WriteLn;
    WriteLn ('File ',filea,' nicht gefunden !!');
    WriteLn;
  END;

END;

BEGIN

  Writeln;
  Writeln;

  IF Paramcount <> 2 THEN
  BEGIN
    Writeln ('Fehlerhafte Parameter�bergabe !');
    Writeln;
    Writeln ('Aufruf : ');
    Writeln;
    Writeln ('ACOPY drive:filename.ext drive:filename.ext');
    Writeln;
    Writeln ('DRIVE: D1:,D2:  --> ATARI Formate');
    Writeln ('DRIVE: A:,B:,C: --> MS-DOS Formate');
    Writeln;
    HALT;
  END;

  filea := UpString(ParamStr(1));
  fileb := UpString(ParamStr(2));

  IF (filea[1] = 'D') AND (filea[2] = ':') THEN
    Insert (q,filea,2);

  IF (filea[1] = 'D') AND (filea[3] = ':') THEN
    driva := 'A'
  ELSE
    drivb := 'M';

  IF (fileb[1] = 'D') AND (fileb[3] = ':') THEN
    driva := 'A'
  ELSE
    drivb := 'M';

  IF driva = drivb  THEN
  BEGIN
    Writeln ('FEHLER: Zwei gleiche Formate !');
    HALT;
  END;

  IF DiskStatus > 0 THEN
    Diskreset;

  SetNewDriveTab (secprotrk,secsize);

  IF (driva = 'A') AND (drivb = 'M') THEN
    CopyAM (filea,fileb);

  SetOldDriveTab;

END.