Где исходный текст программы, которая "уже есть"?

[code h=200]program lab1;
uses
crt;

Type
p=^element;
element=record
bukv: 'a'..'z';
next:p;
end;

Ar=array [1..26] of 'a'..'z';
mnozh=record
A:Ar;
mow:Integer;
end;

label l1,l2,l3;
Var
n1,n2,n3, i: Integer;

A,B,C:Ar;
vvod:boolean;
wiborka:'a'..'z';

Procedure Sort(var A:Ar; var n: Integer);
Var
i,j,min: Integer;
t:'a'..'b';
Begin
for i:=1 to n do
begin
min:=i;
for j:=i+1 to n do
if A[j]<A[min] then min:=j;
if A[min]< A[i] then
begin
t:=A[i];
A[i]:=A[min];
A[min]:=t;
End
end;
for i:=1 to n-1 do
while (A[i]=A[i+1]) and (n>i) do
begin
for j:=i+1 to n-1 do
A[j]:=A[j+1];
dec(n);
end;

end;

function Include:Boolean;
var i,j:integer;
Begin
{/ Вход: Два упорядоченных множества A и B (массивы).
//Выход: да или нет (1 или 0, true или false).}

i:=1; j:=1; {// указатели на начало множеств}
while (i<=n1) and (j<=n2) do
if A[i] < B[j] then begin Include:=false; exit end {// элемент A отсутствует в B}
else if A[i] > B[j] then j:=j+1{ // переход к след. элементу B}
else {// элементы совпали – перейти к следующим}
begin
i:=i+1;
j:=j+1;
end;

if i=n1+1 then Include:=true else Include:=false;
End;

Procedure Union;{//объединение множеств}
var i,j,k:integer;
Begin
{// Вход: Два упорядоченных множества A и B (массивы).
//Выход: упорядоченное множество С.}

i:=1; j:=1; {// указатели на начало множеств}
k:=0;
while (i<=n1) and (j<=n2) do
if A[i] < B[j] then
begin
Inc(k);
C[k]:=A[i];
Inc(i);
end {// элемент A отсутствует в B; включаем в C элемент из A}
else if A[i] > B[j] then
begin
Inc(k);
C[k]:=B[j];
Inc(j);
end
else {// элементы совпали}
begin
Inc(k);
C[k]:=B[j];
i:=i+1; j:=j+1;
end;
while i<=n1 do
begin
Inc(k);
C[k]:=A[i];
Inc(i);
end;
while j<=n2 do
begin
Inc(k);
C[k]:=B[j];
Inc(j);
end;
n3:=k;
End;

Procedure Intersect;{//пересечение множеств}
var i,j,k:integer;
Begin
{// Вход: Два упорядоченных множества A и B (массивы).
//Выход: упорядоченное множество С.}

i:=1; j:=1; {// указатели на начало множеств}
k:=0;
while (i<=n1) and (j<=n2) do
if A[i] < B[j] then
Inc(i) {// элемент A отсутствует в B; не включаем в C элемент из A}
else if A[i] > B[j] then
Inc(j)
else {// элементы совпали}
begin
Inc(k);
C[k]:=B[j];
i:=i+1; j:=j+1;
end;
n3:=k;
End;

Procedure AminusB;{//объединение множеств}
var i,j,k:integer;
Begin
{// Вход: Два упорядоченных множества A и B (массивы).
//Выход: упорядоченное множество С разность множеств A\B.}

i:=1; j:=1; {// указатели на начало множеств}
k:=0;
while (i<=n1) and (j<=n2) do
if A[i] < B[j] then
begin
Inc(k);
C[k]:=A[i];
Inc(i)
end {// элемент A отсутствует в B; включаем в C элемент из A}
else if A[i] > B[j] then
begin
Inc(j); {// элемент B отсутствует в A; не включаем в C элемент из A}
end
else {// элементы совпали}
begin
i:=i+1; j:=j+1; {// элемент A присутствует в B; не включаем в C элемент из A}
end;
while i<=n1 do
begin
Inc(k);
C[k]:=A[i];
Inc(i);
end;
n3:=k;
End;

Procedure BminusA;{//объединение множеств}
var i,j,k:integer;
Begin
{// Вход: Два упорядоченных множества A и B (массивы).
//Выход: упорядоченное множество С.}

i:=1; j:=1; {// указатели на начало множеств}
k:=0;
while (i<=n1) and (j<=n2) do
if A[i] < B[j] then
begin
Inc(i);
end {// элемент A отсутствует в B; не включаем в C элемент из A}
else if A[i] > B[j] then
begin
Inc(k);
C[k]:=B[j];
Inc(j); {// элемент B отсутствует в A; включаем в C элемент из A}
end
else {// элементы совпали}
begin
i:=i+1; j:=j+1; {// элемент A присутствует в B; не включаем в C элемент из A}
end;
while j<=n2 do
begin
Inc(k);
C[k]:=B[j];
Inc(j);
end;
n3:=k;
End;

Procedure SymSubtract;{//объединение множеств}
var i,j,k:integer;
Begin
{// Вход: Два упорядоченных множества A и B (массивы).
//Выход: упорядоченное множество С.}

i:=1; j:=1; {// указатели на начало множеств}
k:=0;
while (i<=n1) and (j<=n2) do
if A[i] < B[j] then
begin
Inc(k);
C[k]:=A[i];
Inc(i);
end {// элемент A отсутствует в B; включаем в C элемент из A}
else if A[i] > B[j] then
begin
Inc(k);
C[k]:=B[j];
Inc(j); {// элемент B отсутствует в A; включаем в C элемент из A}
end
else {// элементы совпали}
begin
i:=i+1; j:=j+1; {// элемент A присутствует в B; не включаем в C элемент из A}
end;
while i<=n1 do
begin
Inc(k);
C[k]:=A[i];
Inc(i);
end;
while j<=n2 do
begin
Inc(k);
C[k]:=B[j];
Inc(j);
end;
while i<=n1 do
begin
Inc(k);
C[k]:=A[i];
Inc(i);
end;
while j<=n2 do
begin
Inc(k);
C[k]:=B[j];
Inc(j);
end;
n3:=k;
End;

begin
l1: vvod:=false;
Writeln ('Vvedite kolichestvo elementov pervogo mnozhestva: ');
while not vvod do
begin
Readln (n1);
if n1>26 then
Writeln ('Kolichestvo elementov pervogo mnozhestva dolzhno byt menshe 26: ')
else vvod:=true;
end;
Writeln('Vvedite elementy, razdelyaya enter');
For i:=1 To n1 Do
Begin
l2:
Readln(A[i]);
if (A[i]<'a') or (A[i]>'z') then
begin
Writeln('Nepravilno!');
goto l2;
end
end;
vvod:=false;

Writeln ('Vvedite kolichestvo elementov vtorogo mnozhestva: ');
while not vvod do
begin
Readln (n2);
if n2>26 then
Writeln ('Kolichestvo elementov vtorogo mnozhestva dolzhno byt menshe 26: ')
else vvod:=true;
end;

Writeln('Vvedite elementy, razdelyaya enter');
For i:=1 To n2 Do
Begin
l3:
Readln(B[i]);
if (B[i]<'a') or (B[i]>'z') then
begin
Writeln('Nepravilno!');
goto l3;
end;
end;

Sort(A,n1);
Sort(B,n2);
while true do
begin
writeln ('Vvetide symvol operacii:');
writeln ('p->>A vhodit d B');
writeln ('u->>Obedinenie');
writeln ('i->>Peresechenie');
writeln ('a->>Raznost A\B');
writeln ('b->>Raznost B\A');
writeln ('s->>Simmetricheska raznost');
writeln ('n->>Vvesti novye mnozhestva');
writeln ('v->>Vyhod');
readln (wiborka);
case wiborka of
'p': if Include then Writeln('A C B') else Writeln('A ne vhodit v B');
'u': Union;
'i': Intersect;
'a': AminusB;
'b': BminusA;
's': SymSubtract;
'n': goto l1;
'v': exit;
end;
Write('Set A: ');
For i:=1 To n1 Do
Begin
Write(a[i],' ');
end;
Writeln;
Write('Set B: ');
For i:=1 To n2 Do
Begin
Write(b[i],' ');
end;
Writeln;
case wiborka of
'u': Write('Union C=A U B= ');
'i': Write('Intersection C=AB= ');
'a': Write('C=A\B= ');
'b': Write('C=B\A= ');
's': Write('C=A/\B= ');
end;
if wiborka<>'p' then
For i:=1 To n3 Do
Begin
Write(c[i],' ');
end;
Writeln;
if (n3=0) and (wiborka<>'p') then Writeln('pustoe mnozhestvo');
Writeln;
Writeln('nazhmite dlya prodolzheniya');
readln;
end;

end.[/code]