Поиск однофамильцев(Delphi/записи/типизир. файлы)

[ZotikOsKC]

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

type S = record { Ученик }
N: String[20]; { Фамилия ученика }
C: 1..10; { Год обучения }
L: Char { Буква (от А до К) }
end;
Выяснить, имеются ли однофамильцы в каком-нибудь классе.
Исходный файл и
результаты распечатать

В принципе, у меня есть почти готовая прога, но она нифига не работает
Естественно, в моих ошибках никто копаться не будет, но на всякий случай http://ifolder.ru/17944023(ошибка или в процедуре compare, или в add)
Да, тут на форуме есть похожая тема, но там решают другим методом.
Помогите, если не трудно(я с психологического, поэтому с инфой нелады)

[ZotikOsKC]

unit Unit1;
interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Menus;

type
  Tff = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Button8: TButton;
    f: TLabel;
    Mem: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;



  type peb=^s;
  s = record
    N: string[20];
    C: 1..10;
    L: char;
end;
     type pel=^el;
  el=record
    d:s;
    next:pel;
  end;
var
  ff: Tff;
  p:^integer;
  l1,l2:integer;
  head:pel;
implementation


procedure addfirst(d:integer;e:string;f:char);
var t:pel;
begin
  new(t);
  t^.d.c:=d;
  t^.d.N:=e;
  t^.d.l:=f;
  t^.next:=head;
  head:=t;
end;
procedure addlast(d:integer;e:string;f:char);
var a:pel;
begin
  if head<>nil then begin
    a:=head;
   while a^.next<>nil do
    a:=a^.next;
    new(a^.next);
    a:=a^.next;
    a^.d.c:=d;
    a^.d.N:=e;
    a^.d.l:=f;
    a^.next:=nil;
  end
  else addfirst(d,e,f);
end;
procedure delfirst;
var t:pel;
begin;
if head<>nil then
  begin
    t:=head;
    head:=t^.next;
    dispose(t);
  end;
end;
procedure dellast;
var t:pel;
begin
  if head<>nil then begin
    if head^.next<>nil then begin
    t:=head;
    while t^.next^.next<>nil do
    t:=t^.next;
    dispose(t^.next);
    t^.next:=nil;
    end
    else delfirst;
    end;
  end;

procedure delall;
var t:pel;
begin
  t:=head;
  while t<>nil do begin
    t:=t^.next;
    dispose(head);
    head:=t;
  end;
end;


procedure savelist(fn:string);
var f:file of s;
t:pel;
begin
assign(f,fn);
rewrite(f);
t:=head;
while t<>nil do begin
  write(f,t^.d);
  t:=t^.next;
end;
close(f);
end;
procedure loadlist(fn:string);
var f:file of s;
t:pel;
begin
assign(f,fn);
reset(f);
delall;
if not Eof(f) then begin
new (head);
read(F,head^.d);
t:=head;
while not Eof(f) do begin
new (t^.next);
read(f,t^.next^.d);
t:=t^.next;
end;
t^.next:=nil;
end;
close(f);
end;
{$R *.dfm}

procedure add(m:pel);
var t,k:pel;
begin
  t:=m;
  while t<>nil do begin
  if (k^.d.N=t^.d.N) and (k^.d.l=t^.d.l) and(k^.d.c=t^.d.c) then exit;
  t:=t^.next;
  new(t);
  t^.next:=k;
  k:=t;
  t^.d:=m^.d;
  end;
end;

procedure compare(M:Tmemo);
var t,k:pel;
begin
t:=head;
  while t^.next<>nil do
  begin
    k:=t^.next;
    while k<>nil do
    begin
      if (k^.d.N=t^.d.N) and (k^.d.l=t^.d.l)
      and(k^.d.c=t^.d.c) then
      begin
        add(t);
        add(k);
      end;
      k:=k^.next
    end;
    t:=t^.next;
  end;
    with m.Lines do
begin
  add('Однофамильцы:   '+t^.d.n
  +'  '+inttostr(T^.d.c)+t^.d.l );
end
end;

procedure list(M:Tmemo);
var t:pel;
i:integer;
begin
i:=1;
t:=head;
with m.Lines do
begin
  add('Cписок');
  while t<>nil do
  begin
    add(inttostr(i)+'-> '+t^.d.n+'  '+inttostr(T^.d.c)
    +(t^.d.l));
    i:=i+1;
    t:=t^.next;
  end;
end;
end;
procedure Tff.Button1Click(Sender: TObject);
begin
addfirst(strtoint(edit1.text),edit3.text,edit4.text[1]);
end;

procedure Tff.Button2Click(Sender: TObject);
begin
list(mem);
end;

procedure Tff.Button3Click(Sender: TObject);
begin
addlast(strtoint(edit1.text),edit3.text,edit4.text[1]);
end;

procedure Tff.Button4Click(Sender: TObject);
begin
delfirst;
end;

procedure Tff.Button5Click(Sender: TObject);
begin
dellast;
end;

procedure Tff.Button6Click(Sender: TObject);
begin
savelist( Edit2.Text );
end;

procedure Tff.Button7Click(Sender: TObject);
begin
loadlist( Edit2.Text );
end;

procedure Tff.Button8Click(Sender: TObject);
begin
compare(mem)
end;

end.

[ZotikOsKC]

_________up____________

[ZotikOsKC]

__________________up_______________ _______

[Serge_Bliznykov]

Вы, чем два дня подряд "аппать" тему, лучше бы рассказали,
процедуру
procedure compare(M:Tmemo);
Вы самостоятельно писали?
Если - да, то распишите её алгоритм...
я, например, просмотрев её, не могу понять, почему в ней вызывается процедура add() (add(t); add(k); ) ?!

для поиска Однофамильцев, лично я бы использовал один из двух алгоритмов
Либо - отсортировал список по фамилиям и потом выводил только те фамилии, для которых следующая фамилия равна текущей, а предыдущая не равна....

Либо использовал такой алгоритм
Перебираем все фамилии по одной,
Для каждой фамилии ищем совпадение в списке,
если нашли совпадение раньше, чем текущий элемент, то ничего не делаем (значит эта фамилия уже была обработана ранее),
если же нашли совпадение после текущего элемента, то выводим фамилию, как имеющего однофамильцев (продолжать поиск или нет зависит от того, нужно ли выдать сколько однофамильцев имеется, или достаточно просто выдать фамилию и всё. если одной фамилии достаточно, то поиск текущей фамилии прерываем..)

всё. за часик легко сами напишете и отладите код.