Program Lab;
var f1,f2,f3,f4 : text;
st, nd : array[1..100] of string[20];
i, j, k : byte;
maxa, maxb : byte;
ch : char;

BEGIN
i:=1;
assign(f1,'File_1.txt');
reset(f1);

While not EOF(f1) do
begin
  read(f1,ch);
  if (ch <> #13) and (ch <> ' ') then
  begin
     if ch<>#10 then
     st[i]:=st[i]+ch
  end
  else if st[i]<>'' then
  begin
     maxa:=i;
     inc(i);
  end;
end;

If (ch<>#13) and (ch<>' ') and (ch<>#10) then maxa:=i;
close(f1);
i:=1;
assign(f2,'File_2.txt');
reset(f2);

While not EOF(f2) do
begin
  read(f2,ch);
  if (ch<>#13) and (ch<>' ') then
  begin
     if ch<>#10 then
     nd[i]:=nd[i]+ch
  end
  else if nd[i]<>'' then
  begin
     maxb:=i;
     inc(i);
  end;
end;
If (ch<>#13) and (ch<>' ') and (ch<>#10) then maxb:=i;
close(f2);

For i:=1 to maxa do
For j:=i to maxa do
If (j<>i) and (st[i]=st[j]) then st[j]:='';

For i:=1 to maxb do
For j:=i to maxb do
If (j<>i) and (nd[i]=nd[j]) then nd[j]:='';
assign(f3,'File_3.txt');
rewrite(f3);
ch:=' ';
For i:=1 to maxa do
For j:=1 to maxb do
If (st[i]=nd[j]) and (st[i]<>'') then
begin
  for k:=1 to length(st[i]) do
  write(f3,st[i][k]);
  write(f3,ch);
  st[i]:='';
  nd[j]:='';
end;
close(f3);
assign(f4,'File_4.txt');
rewrite(f4);
For i:=1 to maxa do
if st[i]<>'' then
begin
  for k:=1 to length(st[i]) do
  write(f4,st[i][k]);
  write(f4,ch);
end;
For i:=1 to maxb do
if nd[i]<>'' then
begin
  for k:=1 to length(nd[i]) do
  write(f4,nd[i][k]);
  write(f4,ch);
end;
close(f4);
END.

Program Lab;
uses crt;

type
 char_file = file of char;
const
 first_file  = '01.txt';
 second_file = '02.txt';
 third_file  = '03.txt';
 fourth_file = '04.txt';


function get_word(var f: char_file): string;
 const
   chars = ['A' .. 'Z', '0' .. '9']; {добавь сюда еще символы которые могут входить в слова}
 var
   s: string;
   ch: char;
   more: boolean;
 begin
   get_word := '';

   s := ''; more := true;
   while (not eof(f)) and more do
     begin
       read(f, ch);
       if upcase(ch) in chars
         then s := s + ch
       else
         if s <> '' then
           more := not more
     end;
   get_word := s;
 end;

function write_file(var f: text; s: string): byte;
 begin
   writeln(f, s);
   write_file := 1
 end;


var f_first, f_second: char_file;
   f_third, f_fourth: text;
   yes_count, no_count: integer;
   s_one, s_two: string;

BEGIN
 assign(f_first, first_file);
 reset(f_first);

 assign(f_second, second_file);
 reset(f_second);

 assign(f_third, third_file);
 rewrite(f_third);
 assign(f_fourth, fourth_file);
 rewrite(f_fourth);

 yes_count := 0;
 no_count := 0;

 while not(eof(f_first)) or not(eof(f_second)) do
   begin
     s_one := get_word(f_first); s_two := get_word(f_second);
     if s_one = s_two then
       inc(yes_count, write_file(f_third, s_one))
     else
       inc(no_count, write_file(f_fourth, s_one + ' ' + s_two))
   end;

 if eof(f_first) then
   while not eof(f_second) do
     inc(no_count, write_file(f_third, get_word(f_second)))
 else
   while not eof(f_first) do
     inc(no_count, write_file(f_third, get_word(f_first)));

 writeln('совпадающих слов: ', yes_count);
 writeln('несовпадающих слов: ', no_count);

 close(f_fourth);
 close(f_third);
 close(f_second);
 close(f_first)
END.

Program Lab;
uses crt;

type
 char_file = file of char;
const
 first_file:string  = '02345.txt';
 second_file:string = '02346.txt';
 third_file  = '03.txt';
 fourth_file = '04.txt';


function get_word(var f: char_file): string;
 const
   chars = ['A' .. 'Z', '0' .. '9'];
 var
   s: string;
   ch: char;
   more: boolean;
 begin
   get_word := '';

   s := ''; more := true;
   while (not eof(f)) and more do
     begin
       read(f, ch);
       if upcase(ch) in chars
         then s := s + ch
       else
         if s <> '' then
           more := not more
     end;
   get_word := s;
 end;

function write_file(var f: text; s: string): byte;
 begin
   write(f, s + ' ');
   write_file := 1
 end;


var f_first, f_second: char_file;
   f_third, f_fourth: text;
   yes_count, no_count: integer;
   s_one, s_two: string;

   exists: boolean;
   sz_1, sz_2: longint;

BEGIN
 assign(f_first, first_file);
 reset(f_first); sz_1 := filesize(f_first);

 assign(f_second, second_file);
 reset(f_second); sz_2 := filesize(f_second);

 if sz_1 < sz_2 then
   begin
     close(f_first);
     close(f_second);

     assign(f_first, second_file); reset(f_first);
     assign(f_second, first_file); reset(f_second);
   end;

 assign(f_third, third_file);
 rewrite(f_third);
 assign(f_fourth, fourth_file);
 rewrite(f_fourth);

 yes_count := 0;
 no_count := 0;

 while not eof(f_first) do
   begin
     s_one := get_word(f_first);
     reset(f_second); exists := false;

     while (not eof(f_second)) and (not exists) do
       begin
         s_two := get_word(f_second);
         exists := (s_one = s_two);
       end;

     if exists then
       inc(yes_count, write_file(f_third, s_one))
     else
       inc(no_count, write_file(f_fourth, s_one))

   end;

 writeln('совпадающих слов: ', yes_count);
 writeln('несовпадающих слов: ', no_count);

 close(f_fourth);
 close(f_third);
 close(f_second);
 close(f_first)
END.

While no eof(f)
begin
readln(f,st);
st:= st + ' ';
for i := 1 to length(st) do
if st[i] <> ' '
then buf:=buf+st[i]