Turbo Toolbox/Turbo_Toolbox.iso/1991/07_08/tricks/tr.pas

Pascal/Delphi Source File | 1991-02-21 | 9.0 KB | 365 lines

(* ------------------------------------------------------ *)
(*                       TR.PAS                           *)
(*    Löschen oder Ersetzen von Strings in ASCII-Files    *)
(* ------------------------------------------------------ *)
(*  Aufruf: TR [-g] -d IstString File(s)                  *)
(*          TR [-g] -c IstString SollString Files(s)      *)
(*                                                        *)
(*   Option  -g Global (alle Strings)                     *)
(*              ohne -g wird nur der erste gefundene      *)
(*              String bearbeitet                         *)
(*           -d der IstString wird gelöscht               *)
(*           -c der IstString wird durch SollString       *)
(*              ersetzt                                   *)
(*                                                        *)
(*     (c) 1991  Dipl.-Ing. Janus Niedoba  & TOOLBOX      *)
(* ------------------------------------------------------ *)
{$D-,I-,R-,S-,V-}

PROGRAM TR;

USES Crt, Dos;

CONST
  MaxChBuf     = 16384;
  MaxFiles     = 100;
  ReadBufMax   = 8192;
  CopyAnzahl   = 256;
  MaxParam     = 10;

TYPE
  BufTyp = RECORD
             Buf      : ARRAY [1..MaxChBuf] OF CHAR;
             Count    : WORD;
           END;
  PosTyp = RECORD
             Position : ARRAY [1..ReadBufMax] OF WORD;
             Idx      : WORD;
           END;
  DatStr = STRING [20];
  ExtStr = STRING [3];

VAR
  B            : BufTyp;
  IstStr,
  SollStr      : STRING;
  All,
  SchonDa,
  FileDa,
  Umbruch,
  Chg          : BOOLEAN;
  ParaS        : ARRAY [1..MaxParam] OF STRING [80];
  Q, Z         : FILE;
  P            : PosTyp;
  DatName      : ARRAY [1..MaxFiles] OF DatStr;
  AktAnzFiles  : BYTE;
  i            : BYTE;
  NeuDatName   : DatStr;
  Akt          : WORD;
  DirInfo      : SearchRec;


  FUNCTION Cmp(s: STRING; L : WORD) : BOOLEAN;
  VAR
    Strg : STRING;
  BEGIN
    Delete(s, 1, 1);
    Move(B.Buf[L+1], Strg[1], Length(s));
    Strg[0] := Chr(Length(s));
    Cmp := (Strg = s);
  END;

  FUNCTION BufPos(s : STRING) : BOOLEAN;
  VAR
    Lauf      : WORD;
    Gef,
    IstDa,
    Verlassen : BOOLEAN;
  BEGIN
    P.Idx      := 0;
    Lauf       := 1;
    Gef        := FALSE;
    IstDa      := FALSE;
    Verlassen  := FALSE;
    Umbruch    := FALSE;
    IF Length(s) <= B.Count THEN BEGIN
      WHILE (Lauf <= B.Count) AND NOT Verlassen DO BEGIN
        WHILE (B.Buf [Lauf] <> s[1]) AND
              (Lauf <= B.Count) DO Inc(Lauf);
        IF (Lauf <= B.Count) AND
           (Length(s) - 1 <= B.Count - Lauf) THEN BEGIN
          Gef := Cmp(s, Lauf);
          IF Gef THEN BEGIN
            Inc(P.Idx);
            P.Position[P.Idx]  := Lauf;
            Inc(Lauf);
            IstDa := TRUE;
          END ELSE Inc (Lauf);
        END ELSE BEGIN
          IF B.Count < ReadBufMax THEN
            Verlassen := TRUE
          ELSE BEGIN
            IF Lauf <= B.Count THEN BEGIN
              Umbruch   := TRUE;
              Verlassen := TRUE;
            END;
          END;
        END;
      END;
    END;
    BufPos := IstDa;
  END;

  PROCEDURE Ende;
  BEGIN
    WriteLn;
    WriteLn('Aufruf: TR [-g] -d IstStr File(s)');
    WriteLn('        TR [-g] -c IstStr SollStr File(s)');
    Halt(1);
  END;

  PROCEDURE SteuerZchn(VAR s : STRING);
  VAR
    Lauf  : BYTE;
    Zahl,
    Ctrl  : INTEGER;
    Str,
    Str2  : STRING [3];
  BEGIN
    Lauf := 1;
    WHILE Lauf <= Length(s) DO BEGIN
      IF s[Lauf] = '\' THEN BEGIN
        Move(s[Lauf + 1], Str[1], 3);
        Str[0] := #3;
        Val(Str, Zahl, Ctrl);
        IF Ctrl <> 0 THEN Ende;
        Str2[1] := Chr(Zahl);
        Str2[0] := #1;
        Delete(s, Lauf, 4);
        Insert(Str2, s, Lauf);
      END ELSE Inc(Lauf);
    END;
  END;

  PROCEDURE MkParamStr(VAR s : STRING; Count : BYTE);
  BEGIN
    s := ParaS[Count];
    SteuerZchn(s);
  END;

  PROCEDURE MkDatNamen(x : BYTE);
  VAR
    L  : BYTE;
  BEGIN
    L := 1;
    FindFirst(ParaS[x], Archive, DirInfo);
    WHILE DosError = 0 DO BEGIN
      DatName[L] := DirInfo.Name;
      FindNext(DirInfo);
      Inc(L);
    END;
    AktAnzFiles := (L - 1);
  END;

  PROCEDURE MkParameter;
  VAR
    Lauf : BYTE;
  BEGIN
    IF ParaS[1] <> '-g' THEN BEGIN
      IF ParaS[1] = '-d' THEN BEGIN
        MkParamStr(IstStr, 2);
        MkDatNamen(3);
      END ELSE IF ParaS[1] = '-c' THEN BEGIN
        MkParamStr(IstStr, 2);
        MkParamStr(SollStr, 3);
        MkDatNamen(4);
        Chg := TRUE;
      END ELSE BEGIN
        Ende;
      END;
      All := FALSE;
    END ELSE BEGIN
      IF ParaS[2] = '-d' THEN BEGIN
        MkParamStr(IstStr, 3);
        MkDatNamen(4);
      END ELSE IF ParaS[2] = '-c' THEN BEGIN
        MkParamStr(IstStr, 3);
        MkParamStr(SollStr, 4);
        MkDatNamen(5);
        Chg := TRUE;
      END ELSE BEGIN
        Ende;
      END;
      All := TRUE;
    END;
  END;

  PROCEDURE FileOpen(VAR f : FILE; DatName : DatStr;
                     Neu : BOOLEAN);
  BEGIN
   Assign(f, DatName);
   IF Neu THEN
     Rewrite(f, 1)
   ELSE
   {$I-}
     Reset(f, 1);
   {$I+}
   IF IOResult <> 0 THEN BEGIN
     WriteLn('Datei ', DatName, ' existiert nicht');
     FileDa := FALSE;
   END ELSE
     FileDa := TRUE;
  END;

  PROCEDURE MkNeuName(AltName : DatStr; VAR NeuName: DatStr;
                      Ext : ExtStr);
  BEGIN
    Delete(AltName, Length(AltName) - 2, 3);
    NeuName := AltName + Ext;
  END;

  PROCEDURE DelInBuf(s : STRING; Posi : WORD);
  VAR
    Laenge : INTEGER;
    L      : WORD;
  BEGIN
    Laenge := Length(s);
    Move(B.Buf[Posi + Laenge], B.Buf[Posi],
         B.Count - Posi + Laenge + 1);
    B.Count := B.Count - Laenge;
  END;

  PROCEDURE InsInBuf(s : STRING; Posi : WORD);
  VAR
    Laenge : INTEGER;
  BEGIN
    Laenge := Length(s);
    Move(B.Buf[Posi], B.Buf[Posi + Laenge],
         B.Count - Posi + 1);
    Move(s[1], B.Buf[Posi], Laenge);
    B.Count := B.Count + Laenge;
  END;

  PROCEDURE ChgPosition(s1, s2 : STRING; Lauf : WORD);
  VAR
    L      : WORD;
    Lang1,
    Lang2  : INTEGER;
  BEGIN
    Lang1 := Length(s1);
    Lang2 := Length(s2);
    FOR L := Lauf TO P.Idx DO
      P.Position[L] := P.Position[L] + (Lang1 - Lang2);
  END;

  PROCEDURE Change;
  VAR
    Lauf : WORD;
  BEGIN
    IF BufPos(IstStr) THEN BEGIN
      IF All THEN BEGIN
        FOR Lauf := 1 TO P.Idx DO BEGIN
          DelInBuf(IstStr, P.Position[Lauf]);
          IF Chg THEN
            InsInBuf(SollStr, P.Position[Lauf]);
          IF Length(IstStr) <> Length(SollStr) THEN
            ChgPosition(SollStr, IstStr, Lauf + 1);
        END;
      END ELSE BEGIN
        DelInBuf(IstStr, P.Position[1]);
        InsInBuf(SollStr, P.Position[1]);
        SchonDa := TRUE;
      END;
    END;
  END;

  PROCEDURE ChgFile;
  VAR
    Gelesen : WORD;
  BEGIN
    Akt     := 1;
    SchonDa := FALSE;
    Umbruch := FALSE;
    REPEAT
      IF Umbruch THEN
        BlockRead(Q, B.Buf[Akt], ReadBufMax - CopyAnzahl,
                  B.Count)
      ELSE
        BlockRead(Q, B.Buf[Akt], ReadBufMax, B.Count);
      Gelesen := B.Count;
      IF NOT SchonDa THEN BEGIN
        IF Umbruch THEN
          B.Count := B.Count + CopyAnzahl;
        Change;
      END;
      IF Umbruch THEN BEGIN
        B.Count := B.Count - CopyAnzahl;
        BlockWrite(Z, B.Buf, B.Count);
        Move(B.Buf[B.Count + 1], B.Buf[1], CopyAnzahl);
        Akt := CopyAnzahl + 1;
      END ELSE BEGIN
        BlockWrite(Z, B.Buf, B.Count);
        Akt := 1;
      END;
    UNTIL Gelesen = 0;
  END;

  PROCEDURE ChgFileName(DatNam1, DatNam2 : DatStr);
  VAR
    NeuNam : DatStr;
    f      : FILE;
    Ext    : ExtStr;
    L      : BYTE;
  BEGIN
    MkNeuName(DatNam1, NeuNam, 'BAK');
    Assign(f, NeuNam);
    {$I-}
    Reset(f);
    {$I+}
    IF IOResult <> 0 THEN BEGIN
      Assign(f, DatNam1);
      Rename(f, NeuNam);
    END ELSE BEGIN
      Close(f);
      Erase(f);
      Ext := Copy(DatNam1, Length(DatNam1) - 2, 3);
      FOR L := 1 TO Length(Ext) DO
        Ext[L] := UpCase(Ext[L]);
      IF Ext <> 'BAK' THEN BEGIN
        Assign(f, DatNam1);
        Rename(f, NeuNam);
      END;
    END;
    Assign(f, DatNam2);
    Rename(f, DatNam1);
  END;

BEGIN
  Chg     := FALSE;
  SollStr := '';
  IF ParamCount < 3 THEN
    Ende
  ELSE BEGIN
    FOR i := 1 TO ParamCount DO
      ParaS[i] := ParamStr(i);
    MkParameter;
  END;
  FOR i := 1 TO AktAnzFiles DO BEGIN
    FileOpen(Q, DatName[i], FALSE);
    IF FileDa THEN BEGIN
      WriteLn('Datei ', DatName[i], ' wird bearbeitet...');
      MkNeuName(DatName[i], NeuDatName, 'NEU');
      FileOpen(Z, NeuDatName, TRUE);
      ChgFile;
      Close(Q);
      Close(Z);
      ChgFileName(DatName[i], NeuDatName);
    END;
  END;
  WriteLn ('------------------------');
  WriteLn ('Konvertierung beendet...');
END.
(* ------------------------------------------------------ *)
(*                  Ende von TR.PAS                       *)