Листинг 6.

Склейка символов таблиц.

program FixTab;

(******************************************)
(* Программа фиксирует внутренние пробелы *)
(* в строке, заменяя их двоичными  нулями *)
(******************************************)

type
      StringType = string [$FF];

const
      TempName = '$$$$$$$$.$$$';

var
      F, G                   : text;
      I                      : byte;
      Line, Head, Tail, Body : StringType;

begin
      LowVideo;

      if ParamCount <> 2
      then
           begin
                 WriteLn ('Укажите в параметре ввода имена входного и');
                 WriteLn ('выходного файлов, которые могут совпадать.');
                 Exit
           end;

      Assign (F, ParamStr (1));

      if Pos (':', ParamStr (2)) <> 2
      then Assign (G, TempName)
      else Assign (G, Copy (ParamStr (2), 1, 2) + TempName);

      Reset (F);
      Rewrite (G);

      while not Eof (F)
      do
         begin
               ReadLn (F, Line);
               I := 0;

               while (I < Length (Line)) and (Line [Succ (I)] <= ' ')
               do I := Succ (I);

               Head := Copy (Line, 1, I);
               I := Length (Line);

               while (I > 0) and (Line [I] <= ' ')
               do I := Pred (I);

               Tail := Copy (Line, Succ (I), Length (Line) - I);
               Body := Copy (Line, Succ (Length (Head)), I - Length (Head));

               for I := 1 to Length (Body)
               do
                  if Body [I] = ' '
                  then Body [I] := #00;

               Line := Head + Body + Tail;
               WriteLn (G, Line);
               WriteLn (Line)
         end;

      Close (F);
      Close (G);

      Assign (F, ParamStr (2));
(*$I-*)
      Erase (F);
(*$I+*)
      I := IoResult;
      Rename (G, ParamStr (2));

      if WhereX <> 1
      then WriteLn;

      WriteLn ('Ok!');
      Exit
end.