PROGRAM PCQTrans;

{
    Konvertiert PCQ-Fehlerdateien für MegaEd
    von Wurzelsepp, 100% PD
}

{$I "include:exec/memory.i" }
{$I "include:libraries/dosextens.i" }
{$I "include:utils/Stringlib.i" }

CONST
    file1   :   String  =   "T:MegaEdMake-ErrFile";
    file2   :   String  =   "T:MegaEdMake-Errors";
    pc      :   String  =   "PCQ complete";
    error   :   String  =   "E";
    back    :   String  =   "/";
    ret     :   Char    =   CHR(10);

    ver_text : String = "\0$VER: MegaEd-TransPCQ V1.01 (16.03.95)";

VAR
    fileh       :   FileHandle;
    meldung     :   BOOLEAN;
    las,
    len,
    dummy       :   INTEGER;
    old         :   Address;
    off         :   ^Char;

PROCEDURE TickleOn;

BEGIN
 Inc(las);
 off:=Address(Integer(off)+1);
END;

BEGIN

 IF DeleteFile(file2) THEN ;

 meldung:=FALSE;
 fileh:=DOSOpen (file1,MODE_OLDFILE);
 IF fileh<>NIL THEN
 BEGIN
  dummy:=Seek(fileh,0,OFFSET_END);
  len:=Seek(fileh,0,OFFSET_BEGINNING);
  if len>0 THEN
  BEGIN
   old:=AllocMem (len,MEMF_PUBLIC+MEMF_CLEAR);
   IF old=NIL THEN
   BEGIN
    DOSClose (fileh);
    Exit;
   END;
   IF DOSRead(fileh,old,len)<>len THEN
   BEGIN
    FreeMem(old,len);
    DOSClose(fileh);
    Exit;
   END;
  END;
  DOSClose(fileh);
  IF (len=0) THEN Exit;

  fileh:=DOSOpen (file2,MODE_NEWFILE);
  IF fileh<>NIL THEN
  BEGIN

   las:=0;
   off:=old;
   WHILE las<len DO
   BEGIN
    WHILE (off^<>'"') AND (las<len) DO
     TickleOn;
    IF las<len THEN
    BEGIN
     meldung:=TRUE;
     TickleOn;
     { Filename überlesen }
     WHILE (off^<>'"') AND (las<len) DO
      TickleOn;
     IF las<len THEN
     BEGIN
      { 5 Zeichen (' " At ') überspringen }
      FOR dummy:=1 TO 5 DO
       TickleOn;
      IF las<len THEN
      BEGIN
       dummy:=DOSWrite (fileh,error,StrLen(error));
       WHILE (off^<>',') AND (las<len) DO
       BEGIN
        dummy:=DOSWrite (fileh,off,1);
        TickleOn;
       END;
       IF las<len THEN
       BEGIN
        dummy:=DOSWrite (fileh,back,StrLen(back));
        TickleOn;
        WHILE (off^<>' ') AND (las<len) DO
        BEGIN
         dummy:=DOSWrite (fileh,off,1);
         TickleOn;
        END;
        IF las<len THEN
        BEGIN
         dummy:=DOSWrite (fileh,Adr(ret),1);
         { 3 Zeichen (' : ') überspringen }
         FOR dummy:=1 TO 3 DO
          TickleOn;
         IF las<len THEN
         BEGIN
          WHILE (off^<>ret) AND (las<len) DO
          BEGIN
           dummy:=DOSWrite (fileh,off,1);
           TickleOn;
          END;
          dummy:=DOSWrite (fileh,Adr(ret),1);
          IF las<len THEN
           TickleOn;
         END;
        END;
       END;
      END;
     END;
    END;
   END;
   DOSClose (fileh);
  END;

  FreeMem(old,len);

 END;

 IF meldung=FALSE THEN
  IF DeleteFile(file2) THEN ;

END.