Другие языки программирования и технологии

файлы паскаль плиииз

Создать три файла: А,В,С из целых чисел. Создать новый файл D из чисел, которые встречаются во всех трех файлах. В файле D числа не должны повторяться.
program Project1;

{$APPTYPE CONSOLE}

uses
SysUtils;

const
Length: word = 10;
MinRange: integer = -25;
MaxRange: integer = 25;
MaxLength = 255;

type
TArray = array [1..MaxLength] of integer;

procedure RandomIntToFile(wLength: word; iMin, iMax: integer; var fOut: Text);
var
i: integer;
begin
Randomize();
for i := 1 to wLength do
writeln(fOut, Random(iMax - iMin + 1) + iMin);
end;

procedure FileToArray(var aArray: TArray; wLength: word; var fIn: Text);
var
i: integer;
begin
for i := 1 to wLength do
readln(fIn, aArray[ i ]);
end;

procedure ArrayToFile(aArray: TArray; wLength: word; var fOut: Text);
var
i: integer;
begin
for i := 1 to wLength do
writeln(fOut, aArray[ i ]);
end;

procedure ArrayPrint(aArray: TArray; wLength: word);
var
i: integer;
begin
if (wLength = 0) then
writeln('empty')
else begin
for i := 1 to wLength do
write(aArray[ i ]:3, ' ');
writeln;
end;
end;

procedure ArrayUnion(a1, a2, a3: TArray; wLength: word; var aOut: TArray; var wOutLength: word);
var
i1, i2, i3, i4: word;
b1, b2, b4: boolean;
begin
wOutLength := 0;
for i1 := 1 to wLength do
begin
b1 := False;
b2 := False;
for i2 := 1 to wLength do
begin
if (a1[i1] = a2[i2]) then
begin
b1 := True;
Break;
end;
end;
for i3 := 1 to wLength do
begin
if (a1[i1] = a3[i3]) then
begin
b2 := True;
Break;
end;
end;
b4 := False;
if (b1 and b2) then
begin
for i4 := 1 to wOutLength do
begin
if (a1[i1] = aOut[i4]) then
begin
b4 := True;
Break;
end;
end;
if (not b4) then
begin
Inc(wOutLength);
aOut[wOutLength] := a1[i1];
end;
end;
end;
end;

var
fA, fB, fC, fD: Text;
aA, aB, aC, aD: TArray;
waDLength: word;
begin
Assign(fA, 'a.dat');
Rewrite(fA);
Assign(fB, 'b.dat');
Rewrite(fB);
Assign(fC, 'c.dat');
Rewrite(fC);
Assign(fD, 'd.dat');
Rewrite(fD);
RandomIntToFile(Length, MinRange, MaxRange, fA);
RandomIntToFile(Length, MinRange, MaxRange, fB);
RandomIntToFile(Length, MinRange, MaxRange, fC);
Close(fA);
Close(fB);
Close(fC);
Reset(fA);
Reset(fB);
Reset(fC);
FileToArray(aA, Length, fA);
FileToArray(aB, Length, fB);
FileToArray(aC, Length, fC);
writeln('A:');
ArrayPrint(aA, Length);
writeln('B:');
ArrayPrint(aB, Length);
writeln('C:');
ArrayPrint(aC, Length);
ArrayUnion(aA, aB, aC, Length, aD, waDLength);
writeln('AxBxC:');
ArrayPrint(aD, waDLength);
ArrayToFile(aD, waDLength, fD);
Close(fD);
readln;
end.
Артем--------- ------------==========
Артем--------- ------------==========
5 082
Лучший ответ
Евгений Жуков Отпиши пожалуйста в асю 48754848 срочно надо буду оч благодарен
Евгений Жуков Могу даже денег на телефон кинуть если надо
За ваши деньги - любой каприз)
Евгений Жуков если бы были деньги у меня бы уже давно все было готово )
Евгений Жуков не хочешь не помогай дело в принципе добровольное, не хочешь не верь доказывать ничего ни кому не собираюсь
Во-ВО! А то много вас развелось таких!
Евгений Жуков хочешь я тебе на мыло кину скан справки ?)))