Считать текст и вывести сначала вопросительные, а затем восклицательные предложения

program y;
uses Crt;
const
znak = ['!','?'];
var
lol_file : text;
stroka : string;
k:integer;
fl:boolean;
begin
    ClrScr;
    Assign(lol_file, 'D:\lol.txt');
    reset(lol_file);
    while not Eof(lol_file) do
    begin
        fl:=false;
        ReadLn(lol_file, stroka);
        for k:=1 to length(stroka) do
        if (stroka[k] in znak)  then fl:=true;
        if fl=true then writeln(stroka);
    end;
end.

program y;
uses Crt;
var lol_file:text;
    stroka:string;
    k:integer;
begin
    ClrScr;
    Assign(lol_file, 'D:\lol.txt');
    reset(lol_file);
    while not Eof(lol_file) do
    begin
        ReadLn(lol_file, stroka);
        if stroka[length(stroka)]='?'
         then writeln(stroka);
    end;
    //close(lol_file);  возможно, что в ТР надо закрывать, в PABC работает и так
    reset(lol_file);
    while not Eof(lol_file) do
    begin
        ReadLn(lol_file, stroka);
        if stroka[length(stroka)]='!'
         then writeln(stroka);
    end;
    close(lol_file)
end.

program vv2;             {1624544}
const x=['.','!','?'];
var fdat,frez:text;
    s:string; c:char;
    k:integer;
begin
 cls;
 assign(fdat, 'dat2.txt'); reset(fdat);
 assign(frez, 'rez2.txt'); rewrite(frez);
 s:=''; read(fdat, c);
 while not(eof(fdat)) do
  begin
   while not(c in x) do
    begin
     s:=s+c;
     read(fdat, c);
    end;
   s:=s+c;
   writeln(frez,s);
   s:='';
   read(fdat, c);
  end;
  close(fdat); close(frez);
  assign(fdat, 'rez2.txt'); reset(fdat);
  while not(eof(fdat)) do
   begin
    readln(fdat,s);
    if s[length(s)]='?'
     then writeln(s);
   end;
  close(fdat);
  reset(fdat);
  while not(eof(fdat)) do
   begin
    readln(fdat,s);
    if s[length(s)]='!'
     then writeln(s);
   end;
 close(fdat);
end.

program vv3;            
const x=['.','!','?'];
var fdat,frez:text; i:integer;
    s:string; c:char;
begin
 cls;
 assign(fdat,'dat3.txt'); reset(fdat);
 assign(frez,'rez3.txt'); rewrite(frez);
 s:='';
 while not(eof(fdat)) do
  begin
   while not(eoln(fdat)) do
    begin
     read(fdat,c);
     if not(c in x)
      then s:=s+c
      else begin
            s:=s+c;
            while s[1]=' ' do
             delete(s,1,1);
            i:=1;
            while i<length(s) do
             begin
              if (s[i]=' ') and (s[i+1]=' ')
               then delete(s,i,1)
               else i:=i+1
             end;
            writeln(frez,s);
            s:=''
           end;
    end;
   s:=s+' ';
   readln(fdat);
  end;
  close(fdat); close(frez);
  assign(fdat, 'rez3.txt'); reset(fdat);
  while not(eof(fdat)) do
   begin
    readln(fdat,s);
    if s[length(s)]='?'
     then writeln(s);
   end;
  close(fdat);
  reset(fdat);
  while not(eof(fdat)) do
   begin
    readln(fdat,s);
    if s[length(s)]='!'
     then writeln(s);
   end;
 close(fdat);
end.

const
  fin = ['.','!','?'];
  f: array [1..2] of Char = ('?','!');
var
  s, t: String;
  i, k: Integer;
begin
  Assign(input,'in.txt');
  for k:=Low(f) to High(f) do begin
    Reset(input); WriteLn(f[k],' >');
    while not SeekEOF do begin
      ReadLn(t); t:=t+#0;
      while Length(t)>1 do begin
        i:=1; while t[i]=' ' do Inc(i); Delete(t,1,i-1);
        for i:=1 to Length(t) do if t[i] in fin+[#0] then Break;
        if t[i]='.' then while t[i+1]='.' do Inc(i);
        if t[i]=#0 then Dec(i);
        s:=s+Copy(t,1,i); Delete(t,1,i);
        if s[Length(s)] in fin then begin
          if s[Length(s)]=f[k] then WriteLn(s);
          s:='';
        end else s:=s+' ';
      end;
    end;
  end;
end.

program vv4_abc;
const
  fin = ['.','!','?'];
  f: array [1..2] of Char = ('?','!');
var
  s, t: String; fdat:text; i, k: Integer;
begin  cls;
  Assign(fdat,'in2.txt');
  for k:=1 to 2 do begin
    Reset(fdat); WriteLn(f[k],' >');
    while not(EOF(fdat)) do begin
      ReadLn(fdat,t); t:=t+#0;
      while Length(t)>1 do begin
        i:=1; while t[i]=' ' do Inc(i); Delete(t,1,i-1);
        for i:=1 to Length(t) do if t[i] in fin+[#0] then Break;
        if t[i]='.' then while t[i+1]='.' do Inc(i);
        if t[i]=#0 then Dec(i);
        s:=s+Copy(t,1,i); Delete(t,1,i);
        if s[Length(s)] in fin then begin
          if s[Length(s)]=f[k] then WriteLn(s);
          s:='';
        end else s:=s+' ';
      end;
    end;
  end;
  close(fdat);
end.