. Или предложи свою реализацию..))))
).
после твоего ответа я почуствовал себя тормозом.
такое я не проходил, мона небольшой пример
const
n = 10;
count = 200000;
Strings: array [0..n - 1] of String =
(
'mama', 'papa', 'dedushka', 'babushka', 'probabushka',
'sestra', 'brat', 'tesha', 'test', 'zat'
);
file_name = 'large.txt';
var
f: text;
i: LongInt;
begin
assign(f, file_name); rewrite(f);
randomize;
for i := 1 to count do writeln(f, Strings[Random(10)]);
writeln('Done'); close(f);
end.
uses crt;
const
file_name = 'large.txt';
type
PList = ^TList;
TList = record
data: String;
next: PList;
end;
var
f: Text;
head, T, H: PList;
s: String;
begin
assign(f, file_name); reset(f);
if not(eof(f)) then begin
readln(f, s);
new(T);
T^.data := s;
T^.next := nil;
head := T;
end;
while not(eof(f)) do begin
readln(f, s);
H := head;
while (head^.next <> nil) and (head^.data <> s) do head := head^.next;
if (head^.next = nil) and (head^.data <> s) then begin
new(T);
T^.data := s;
T^.next := nil;
head^.next := T;
end;
head := H;
end;
rewrite(f);
while (head <> nil) do begin
T := head;
writeln(f, head^.data);
head := head^.next;
dispose(T);
end;
close(f);
end.
uses list;
var
arr_list: array['A' .. 'Z'] of tlist;
function is_present(var lst: tlist; s: string): boolean;
var st: string;
begin
is_present := lst.present(s);
end;
var
f_in, f_out: text;
s: string;
T: dword;
count_n, count_unique: integer;
ch: char;
begin
for ch := 'A' to 'Z' do begin
arr_list[ch].init;
end;
assign(f_in, 'very_big.txt');
reset(f_in);
assign(f_out, 'very_dup.txt');
rewrite(f_out);
count_n := 0; count_unique := 0;
while not eof(f_in) do begin
readln(f_in, s);
inc(count_n);
if count_n mod 50 = 0 then writeln(':: read ', count_n);
if not is_present(arr_list[upcase(s[1])], s) then begin
writeln(f_out, s);
inc(count_unique);
arr_list[upcase(s[1])].append(s);
end;
end;
close(f_out);
close(f_in);
writeln('count = ', count_n, ' unique = ', count_unique);
for ch := 'A' to 'Z' do begin
arr_list[ch].done;
end;
end.
Uses Crt;
Var
s,st:string;
f1,f2:text;
x:INTEGER;
label a;
Begin
assign(f1,'C:\Pascal\zadachi\pere-ka\words2.txt');reset(f1);
assign(f2,'C:\Pascal\zadachi\pere-ka\words3.txt');
while not eof(f1) do
begin
while not eoln(f1) do
begin
read(f1,s);{Читаем слово из первого файла}
end;
readln(f1);
reset(f2);
while not eof(f2) do
begin
while not eoln(f2) do
begin
read(f2,st); {Читаем слова из второго файла}
if s=st then {Проверяем, есть ли совпадения}
begin
inc(x);
goto a;
end;
end;
readln(f2);
end;
a:
append(f2);
if x=0 then writeln(f2,s);{если совпадения не было,
записываем слово во второй файл (f2)}
x:=0;
end;
close(f1);
close(f2);
end.
а массив [А..Я] не работает 
{ Пишешь функцию, корректно работающую с кириллицей }
Function UpCase(ch: char): char;
Begin
UpCase := ch;
Case s[i] Of
'a' .. 'z': Upcase := Chr(Ord(s[i])-$20);
#160 .. #175: Upcase := Chr(Ord(s[i])-$20);
#224 .. #239: Upcase := Chr(Ord(s[i])-$50)
End;
End;
{ Перечисляешь весь алфавит }
const
alpha = 'АБВГД...'; { перечислен весь алфавит - 32 буквы }
var
arr_list: array[1 .. 32] of tlist;
...
for i := 1 to 32 do begin
arr_list[i].init;
end;
...
{ и работаешь вот в таком ключе: }
if not is_present(arr_list[pos(upcase(s[1]), s)], s) then begin ...