mORMot Open Source

I have written some code which adding and finding records on timer interval, but after some time i am getting an out of memory exception.
Sample Code:

type
  ppckt = ^TPacket;
  TPacket = packed record
    Source     : string;
    Destination: string;
    Sport      : string;
    Dport      : string;
  end;
  TPackDynArray = array of TPacket;
   APackt           : TDynArrayHashed;
    Packts           : TPackDynArray;
    PacktsCount : integer;
    Packt             : ppckt;

procedure TForm1.FormCreate(Sender: TObject);
var
   i :integer;
begin
    Try
      APackt.Init(TypeInfo(TPackDynArray),Packts,nil,nil,nil,@PacktsCount);
      for i := 0 to 1000000 do
      begin
        new(packt);
        Packt.Source      := 'Source:'+inttostr(i);
        Packt.Destination := 'Destination:'+inttostr(i);
        Packt.Sport       := 'Sport'+inttostr(i);
        Packt.Dport       := 'Dport'+inttostr(i);
        APackt.Add(Packt^);
      end;
      Timer1.Enabled := True;
    Except
    End;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  indx   : integer;
  SNumbr : String;
begin
    Randomize;
    SNumbr            :=  IntToStr(RandomRange(100000,10000000));
    Packt.Source   :=  'Source:'+SNumbr;
    APackt.ReHash;
    indx := APackt.FindHashedAndFill(Packt^);
    if indx < 0 then
    begin
      new(packt);
      Packt.Destination  := 'Destination:'+SNumbr;
      Packt.Sport            := 'Sport'+SNumbr;
      Packt.Dport            := 'Dport'+SNumbr;
      indx                         := APackt.Add(packt^);
      Memo1.Lines.Add('Updated :'+inttostr(indx));
    end
    else
      Memo1.Lines.Add('Existed :'+inttostr(indx));
end;

Is it anything wrong with this code? How can I Proceed?