MODULE FileCopy;

CONST
  BlockSize = 127;

TYPE
  Block = ARRAY [ 0..BlockSize ] OF CHAR;
  BlockFile = FILE OF Block;


EXTERNAL FUNCTION RENAME ( VAR F:BlockFile; VAR NEWNAME:STRING ): INTEGER;
EXTERNAL PROCDURE Halt ( ErrorMessage: STRING );
EXTERNAL PROCEDURE ClearScreen;


PROCEDURE  CopyFile ( VAR SrcName, DestName: STRING );

VAR
  Src, Dest: BlockFile;
  Res: INTEGER;
  TempName: STRING;
  BakName : STRING;


  PROCEDURE OpenSrcFile;

  BEGIN
    ASSIGN (Src, SrcName);
    RESET (Src);
    IF IORESULT = 255 THEN BEGIN
      ClearScreen;
      Halt ('*** I/O-Error: Reset');
    END;
  END (* OpenSrcFile *);


  PROCEDURE OpenDestFile;

  BEGIN
    ASSIGN (Dest, TempName);
    REWRITE (Dest);
    IF IORESULT = 255 THEN BEGIN
      ClearScreen;
      Halt ('*** I/O-Error: Rewrite');
    END;
  END (* OpenDestFile *);


  PROCEDURE CloseDestFile;

  BEGIN
    CLOSE (Dest, Res);
    IF IORESULT = 255 THEN BEGIN
      ClearScreen;
      Halt ('*** I/O-Error: Close');
    END;
  END (* CloseDestFile *);


  PROCEDURE RenameDestFile;

  BEGIN
    (* L|schen der alten .BAK Version, falls vorhanden *)
    ASSIGN (Dest, BakName);
    PURGE (Dest);
    (* Benenne Zieldatei in .BAK um *)
    ASSIGN (Dest, DestName);
    Res := Rename (Dest, BakName);
    (* Benenne Zwischendatei in die Zieldatei um *)
    ASSIGN (Dest, TempName);
    Res := Rename (Dest, DestName);
  END (* RenameDestFile *);


  PROCEDURE TransferFile;

  CONST
    BufferSize = 128;

  TYPE
    BufferType = ARRAY [1..BufferSize] OF Block;

  VAR
    BufferIndex: INTEGER;
    Buffer: BufferType;

    PROCEDURE WriteBuffer;
    VAR
      I: INTEGER;

    BEGIN (* WriteBuffer *)
      FOR I := 1 TO BufferIndex DO BEGIN
        Dest^ := Buffer[I];
        PUT (Dest);
        IF IORESULT <> 0 THEN BEGIN
          ClearScreen;
          Halt ('*** I/O-Error: Write');
        END;
      END;
    END (* WriteBuffer *);

  BEGIN (* TransferFile *)
    BufferIndex := 0;
    WHILE (NOT (EOF (Src))) DO BEGIN
      IF (BufferIndex = BufferSize) THEN BEGIN
        WriteBuffer;
        BufferIndex := 0;
      END;
      BufferIndex := BufferIndex + 1;
      Buffer[BufferIndex] := Src^;
      Get (Src);
    END;
    WriteBuffer;
  END (* TransferFile *);


  PROCEDURE BuildTempName;
  VAR
    PeriodPos: INTEGER;

  BEGIN
    TempName := DestName;
    PeriodPos := POS ('.', TempName);
    IF (PeriodPos <> 0) THEN BEGIN
      DELETE (TempName, PeriodPos, LENGTH (Tempname)-PeriodPos+1);
    END;
    BakName := TempName;
    TempName := CONCAT (TempName, '.$$$');
    BakName  := CONCAT (BakName, '.BAK');
  END (* BuildTempName *);
    

BEGIN (* CopyFile *)
  BuildTempName;
  OpenSrcFile;
  OpenDestFile;
  TransferFile;
  CloseDestFile;
  RenameDestFile;
END (* CopyFile *);

MODEND.
