Помогите пожалуйста написать программу

[gamer123]

Помогите пожалуйста написать программу на паскале, можно консольную. Программа должна делать следующее:
Загружать 20 текстовых документов и записывать в текстовый файл те строки, которые присутствуют во всех 20ти документах. Пример:
1.txt:
proga
admin
super
forum

2.txt:
admin
site
yandex
rambler

3.txt:
google
aport
admin
pc
xbox

...20.txt...

Программа в данном случае выберет только слово admin и запишет его в файл, например ok.txt

p.s. Очень нужно, надеюсь на Вашу помощь.

[OCTAGRAM]

program EveryWh;

type
  PCharTree = ^TCharTree;
  TCharTree = record
    Leaf : Boolean;
    Next : array[Char] of PCharTree;
  end;

function NewT : PCharTree;
var
  R : PCharTree;
  C : Char;
begin
  New(R);
  R^.Leaf := False;
  for C := #0 to #255 do
    R^.Next[C] := nil;
  NewT := R;
end;

function CopyT(T : PCharTree) : PCharTree;
var
  R, Tmp : PCharTree;
  C : Char;
begin
  R := nil;
  if T <> nil then
  begin
    if T^.Leaf then
    begin
      R := NewT;
      R^.Leaf := True;
    end;
    for C := #0 to #255 do
    begin
      Tmp := CopyT(T^.Next[C]);
      if Tmp <> nil then
      begin
        if R = nil then R := NewT;
        R^.Next[C] := Tmp;
      end;
    end;
  end;
  CopyT := R;
end;

procedure DeleteT(T : PCharTree);
var
  C : Char;
begin
  if T <> nil then
  begin
    for C := #0 to #255 do
      DeleteT(T^.Next[C]);
    Dispose(T);
  end;
end;

function MergeT(Left, Right : PCharTree) : PCharTree;
var
  R, Tmp : PCharTree;
  C : Char;
begin
  if Left = nil then
  begin
    MergeT := nil;
    Exit;
  end else
  if Right = nil then
  begin
    MergeT := nil;
    Exit;
  end;

  R := nil;
  if Left^.Leaf and Right^.Leaf then
  begin
    R := NewT;
    R^.Leaf := True;
  end;
  for C := #0 to #255 do
  begin
    Tmp := MergeT(Left^.Next[C], Right^.Next[C]);
    if Tmp <> nil then
    begin
      if R = nil then R := NewT;
      R^.Next[C] := Tmp;
    end;
  end;
  MergeT := R;
end;

procedure AddLeaf(var T : PCharTree; S : String);
var
  C : Char;
  Tail : String;
begin
  if T = nil then
    T := NewT;
  if S = '' then
    T^.Leaf := True
  else
  begin
    C := S[1];
    Tail := Copy(S, 2, Length(S) - 1);
    AddLeaf(T^.Next[C], Tail);
  end;
end;

function ReadTree(Name : String) : PCharTree;
var
  F : Text;
  S : String;
  R : PCharTree;
begin
  R := nil;
  Assign(F, Name);
  ReSet(F);
  while not EOF(F) do
  begin
    ReadLn(F, S);
    AddLeaf(R, S);
  end;
  Close(F);
  ReadTree := R;
end;

procedure WriteSubTree(var F : Text; Head : String; T : PCharTree);
var
  C : Char;
begin
  if T <> nil then
  begin
    if T^.Leaf then
      WriteLn(F, Head);
    for C := #0 to #255 do
      WriteSubTree(F, Head + C, T^.Next[C]);
  end;
end;

procedure WriteTree(Name : String; T : PCharTree);
var
  F : Text;
begin
  Assign(F, Name);
  ReWrite(F);
  WriteSubTree(F, '', T);
  Close(F);
end;

var
  A, B, C : PCharTree;

begin
  A := ReadTree('1.txt');
  B := ReadTree('2.txt');
  C := MergeT(A, B);
  DeleteT(A); DeleteT(B);

  A := C;
  B := ReadTree('3.txt');
  C := MergeT(A, B);
  DeleteT(A); DeleteT(B);

  A := C;
  B := ReadTree('4.txt');
  C := MergeT(A, B);
  DeleteT(A); DeleteT(B);

  A := C;
  B := ReadTree('5.txt');
  C := MergeT(A, B);
  DeleteT(A); DeleteT(B);

  { и так до 20.txt... }

  WriteTree('ok.txt', C);
  DeleteT(C);
end.