Учитывая вхождение заданного символа преобразовать последовательность

Const C = '*';
 
Function Decod(S : String) : String;
Begin
  While Pos(C,S)>0 do Delete(S,Pos(C,S)-1,2);
  Decod:=S;
end;
 
Begin
  Writeln(Decod('Цукпц****оыва***йц*    ***жоп**ивап***вы*!'));
end.

uses
  crt;
type
  tInf  = char;
 
  pNode = ^tNode;
  tNode = record
  Inf       : tInf;
  Next,Prev : pNode;
  end;
 
  tList = record
  First, Last : pNode;
  end;
 
procedure InitList(var aL : tList);
begin
   aL.First := nil; aL.Last := nil;
end;
 
procedure AddToList(var aL : tList; aData : tInf);
var tmp : tList;
begin
  if aL.First = nil then begin
     New(aL.First);
     aL.First^.Inf := aData;
     aL.First^.Prev := nil; aL.First^.Next := nil;
     aL.Last := aL.First;
  end else begin
     InitList(tmp);
     AddToList(tmp,aData);
     tmp.First^.Prev := aL.Last;
     aL.Last^.Next := tmp.First;
     aL.Last := tmp.Last;
  end;
end;
 
procedure CreateList(var aL : tList; var sc : char);
var c : char;
begin
   InitList(aL);
   repeat
   write('Input special symbol :'); sc := readkey;
   writeln(sc);
   until not (sc in [#65..#90,#97..#122,#46]);
   writeln('End of input list - key Enter.');
   write('Input list:');
   repeat
      c := readkey;
      If c in [#65..#90,#97..#122,sc] then begin
         AddToList(aL,c);
         write(c);
      end else if c <> #13 then
         write(#10,#13,'ERROR: "',c,'" is not latin latter.',#10,#13,'Continue input:');
   until c = #13;
   AddToList(aL,'.');
   writeln;
end;
procedure PrintLst(aL : tList);
begin
  If aL.First = nil then writeln
  else begin
    write(aL.First^.Inf,' ');
    aL.First := aL.First^.Next;
    PrintLst(aL);
  end;
end;
 
procedure DelElem(var aL : tList;beg : pNode; k : integer);
var p : pNode;
begin
   while (k > 0) and (beg <> nil) do begin
      p := beg;
      beg := beg^.Prev;
      If (p^.Prev <> nil) and (p^.Next <> nil) then begin
         beg^.Next := p^.Next;
         p^.Next^.Prev := beg;
      end else if (p^.Prev = nil) and (p^.Next <> nil) then begin
         p^.Next^.Prev := nil;
         aL.First := p^.Next;
      end else if (p^.Prev <> nil) and (p^.Next = nil) then
         p^.Prev^.Next := nil;
      dispose(p);
      dec(k);
   end;
end;
 
procedure LenOrder(var cur : pNode;c : char;var k : integer);
begin
  while cur^.Inf = c do begin
     inc(k);
     cur := cur^.Next;
     if cur = nil then break;
  end;
end;
 
procedure ChangeLst(var aL : tList;c : char);
var p, pp : pNode; k, kk : integer;
begin
  p := aL.First;
  kk := 0;
  while p <> nil do begin
     if p^.Inf = c then begin
       pp := p^.Prev;
       LenOrder(p,c,k);
       if k > kk then k := kk;
       kk := 0;
       DelElem(aL,pp,k);
     end else begin
       p := p^.Next;
       inc(kk);
       k := 0;
     end;
  end;
end;
 
var
  L : tList;
  p : pNode;
  k : integer;
  c : char;
begin
  clrscr;
  InitList(L);
  CreateList(L,c);
  writeln('List:');
  PrintLst(L);
  ChangeLst(L,c);
  writeln('Result List:');
  PrintLst(L);
  readln;
end.

procedure PrintLst(aL : tList);
begin
  If aL.First = nil then writeln
  else begin
    write(aL.First^.Inf);
    aL.First := aL.First^.Next;
    PrintLst(aL);
  end;
end;