unit dynmas;

interface
   type PWord=^Word;
        PMyArray=^TMyArray;
        TMyArray=Array[0..35000] of word;
   type TDynaMac=record
        length:longint;
        data_array:pointer;
        end;

procedure AddItem(var dyn:TDynaMac; item:word);
function GetItem(var dyn:TDynaMac;index:longint):word;
procedure DelItem(var dyn:TDynaMac;index:longint);
procedure FreeDynamac(var dyn:TDynaMac);

implementation

procedure AddItem(var dyn:TDynaMac; item:word);
var tmpStorage:pointer;
    tmpData:Pword;
begin
     GetMem(tmpStorage,dyn.length*sizeof(Word)+sizeof(Word));
     if dyn.length>0 then
     begin
          move(dyn.data_array^,tmpStorage^,dyn.length*sizeof(Word));
          FreeMem(dyn.data_array,dyn.length* sizeof(Word));
     end;
     dyn.data_array:=tmpStorage;
     dyn.length:=dyn.length+1;
     tmpData:=dyn.data_array;
     inc(tmpData,dyn.length-1);
     tmpData^:=item;
end;

procedure FreeDynamac(var dyn:TDynaMac);
begin
     FreeMem(dyn.data_array,dyn.length*sizeof(word));
     dyn.length:=0;
end;
function GetItem(var dyn:TDynaMac;index:longint):word;
var
    tmpData:Pword;
begin
     if index>(dyn.length-1) then
     begin
          GetItem:=0;
          exit;
     end;
     tmpData:=dyn.data_array;
     inc(tmpData,index);
     GetItem:=tmpData^;
end;
procedure DelItem(var dyn:TDynaMac;index:longint);
var tmpStorage1:pointer;
    tmpPointer1,tmpPointer2:Pword;
begin
     if index>(dyn.length-1) then exit;
     GetMem(tmpStorage1,dyn.length-1);
     move(dyn.data_array^,tmpStorage1^,index*sizeof(word));
     tmpPointer1:=dyn.data_array;
     tmpPointer2:=tmpStorage1;
     inc(tmpPointer1,(index+1));
     inc(tmpPointer2,(index));
     move(tmpPointer1^,tmpPointer2^,(dyn.length-index)*sizeof(word));
     FreeMem(dyn.data_array,dyn.length*sizeof(word));
     dyn.data_array:=tmpStorage1;
     dec(dyn.length)
end;

end.

program dyntest;

uses  dynmas ;
var T:TDynaMac;
    i:longint;
begin
     for i:=1 to 100 do
     begin
          AddItem(t,i);
     end;
     writeln('Length of dynamic array is ',t.length,#$0a#$0d);
     writeln('GetItem with index 5 = ',GetItem(t,5));
     writeln('GetItem with index 56 = ',GetItem(t,56),#$0a#$0d);
     writeln('Deleting item with index 56');
     DelItem(t,56);
     writeln('Item with Index 56 now is = ',GetItem(t,56),#$0a#$0d);
     writeln('Length of dynamic array is ',t.length);
     readln;
     FreeDynamac(T);
end.

Uses Crt,DOS;
Const Con=2;
Var l,j,x,xx:longint;

Function Drug(n1:longint):longint;
Var i,k,Sq : longint;
Begin
 k:=3+(n1 div 2); Sq:=Trunc(Sqrt(n1));
 For i:=3 To Sq-1 Do
  IF n1 mod i = 0 Then
    Inc(k,(n1 div i)+i);
 IF n1 mod Sq = 0 Then
  If (n1 div Sq)<>Sq then Inc(k,(n1 div Sq)+Sq)
                     else Inc(k,Sq);
Drug:=k;
End;

Function Drug1(n1:longint):longint;
Var i,k,NSq : longint;
Begin
 k:=1; i:=3;
 NSq:=Trunc(Sqrt(n1));
 Repeat
  IF n1 mod i = 0 Then
    Inc(k,(n1 div i)+i);
  Inc(i,2);
 Until i>NSq-1;
 IF n1 mod NSq = 0 Then
  If (n1 div NSq)<>NSq then Inc(k,(n1 div NSq)+NSq)
                       else Inc(k,NSq);
Drug1:=k;
End;
                 { -> }
Begin
Clrscr;
Repeat
 Write('Введите число, до которого искать : ');
 ReadLn(l);
 If l<=9 then ClrScr;
 Until l>=9;
 WriteLn('Дружественные числа : ');
{чётные}
 j:=Con;
 While j<=l do
  begin
   x:=drug(j);
   if j<x then Begin
    if x mod 2 = 0 then xx:=drug(x) else xx:=drug1(x);
    if j=xx then Write('{',j,',',x,'} ');
   end;
   inc(j,2);
  end;
{нечётные}
 j:=Con+1;
 While j<=l do
  begin
   x:=drug1(j);
   if j<x then Begin
    if x mod 2 = 0 then xx:=drug(x) else xx:=drug1(x);
    if j=xx then Write('{',j,',',x,'} ');
   end;
   inc(j,2);
  end;
End.