Сравнить два файла с точностью до слов, Помогите Опции

[FENIX]

Боюсь (знаю, что нарушаю - извините ) праведного гнева модераторов, но мне СРОЧНО нужно сделать эту лабу...
Она - последняя, и если я завтра ее сдам, поставят зачет, а вот если не сдам - начнется геморрой и т.п.
Самое смешное - друг мне помог, и я ее сделал, используя массивы. Но в чертовой методичке указано, что все слова строки хранить в массиве нельзя - можно только отдельные. Как быть?

А задача вот какая:
сравнить два файла с точностью до слов (без учета неотображаемых символов и пробелов между словами). Совпадающие слова вывести в третий файл, несовпадающие слова в четвертый, а их количества на экран.

Вот текст проги, который есть на данный момент (которая работает, но могут быть траблы при сдаче):

Код

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.

[volvo]

FENIX
По-моему, сравнение надо делать вот так:

Код

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.