Where is the memory leak in this Delphi code? [closed]

Question

I tried to ask this on Stack Overflow, but it got closed. Someone recommended I ask her, so ...

This is not a code review about style or maintainability - what you will see is less than 5% of my app, but the part where the memory leak is - this is a code review to find a single bug. Can someone please help? I have been looking for leaks.

Here's the previous question ... (I offered a 500 point bounty there, but I don't have 500 points here; time to get active, I guess)

---

I have been looking and looking and looking and I just cannot find it!

By process of elimination I have thrown out 95% of my code and I still can't find it in the remaining lines. Obviously I have a blind-spot or knowledge gap, can you please help?

I have a very simple client/server setup using Indy 10 (and XE2 starter) and have narrowed it down to the handling of a TCP “heartbeat” (every second).

After six or seven hundred iterations, I get an exception. I have seen a few different ones, just by randomness, but 95% of the time it is “out of memory” (as an aside, I just got thread creation error, with this stack dump, but that is just the symptom, not the cause)

:773eb9bc KERNELBASE.RaiseException + 0x58
System.Classes.TThread.Create(???)
IdThread.TIdThread.Create(True,True,'IdCmdTCPServer1Scheduler User')
IdThread.TIdThreadWithTask.Create(nil,'IdCmdTCPServer1Scheduler User')
IdSchedulerOfThread.TIdSchedulerOfThread.NewThread
IdSchedulerOfThreadDefault.TIdSchedulerOfThreadDefault.NewThread
IdSchedulerOfThreadDefault.TIdSchedulerOfThreadDefault.AcquireYarn
IdCustomTCPServer.TIdListenerThread.Run
IdThread.TIdThread.Execute
:004bee25 HookedTThreadExecute + $2D
System.Classes.ThreadProc($92D8F7C)
System.ThreadWrapper($92D4FF8)
:004bed07 CallThreadProcSafe + $F
:004bed74 ThreadExceptFrame + $3C
:76a1339a kernel32.BaseThreadInitThunk + 0x12
:77d79ef2 ntdll.RtlInitializeExceptionChain + 0x63
:77d79ec5 ntdll.RtlInitializeExceptionChain + 0x36

I will post the server code below, but both projects can be downloaded from https://www.opendrive.com by logging in as user out_of_memory with password 12345.

A few points:

• I have no calls to .Create() in my code. Indy does, of course
• I have no threads
• The code will look bad mostly because I threw out so much of it that what remains might not make sense
• I am using GExperts debug tracing, but you can rip that out if you want to
• The timer in real life is 30 seconds, but I jacked it up to 1 second, just to get it to crash faster
• I am using real world IP addresses of 10.21.18.206 for client and 10.18.21.211 for server
• Feel free to change any of the above and generally remove code until it works. That is what I will be doing until someone beats me to it

Final thought, maybe there is something I don’t know about the Indy TCP command Handler? Maybe I am supposed to free something? Or maybe it’s not in the code, but in a setting of the object inspector?

Here is the horrible server code for any code readers, or d/l both projects. Please help; I am at my wit’s end

unit fmainForm;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls, IdContext,
  IdAntiFreezeBase, Vcl.IdAntiFreeze, IdBaseComponent, IdComponent,
  IdCustomTCPServer, IdTCPServer, IdCmdTCPServer, IdCommandHandlers, Vcl.Grids;

const UM_HEART_BEAT = WM_USER + 1;

type
  TForm2 = class(TForm)
    Edit1: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Edit3: TEdit;
    Edit4: TEdit;
    Label3: TLabel;
    IdCmdTCPServer1: TIdCmdTCPServer;
    IdAntiFreeze1: TIdAntiFreeze;
    ToolsStringGrid: TStringGrid;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure IdCmdTCPServer1CommandHandlers0Command(ASender: TIdCommand);
    procedure Timer1Timer(Sender: TObject);
    procedure IdCmdTCPServer1AfterBind(Sender: TObject);
  private
    function  GetToolNumberFromContext(const Context : TIdContext) : Integer;
    procedure ToolOnLine(toolNumber : Integer);

  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

uses debug_utils;

const
  // Sets UNIX_START_DATE to TDateTime of 01/01/1970
  UNIX_START_DATE: TDateTime = 25569.0;

// +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
function DateTimeToUnix(ConvDate: TDateTime): Longint;
begin
  Result := Round((ConvDate - UNIX_START_DATE) * 86400);
end;

// +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
function GetCurrentUnixTimeStamp() : LongInt;
begin
   Result := DateTimeToUnix( Now() );
end;

// +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
procedure TForm2.FormCreate(Sender: TObject);
   var i : Integer;
begin
   IntializeDebugTrace(3);
   TraceShowMilliSeconds(True);
   TraceClear();
   TracePause();

   ReportMemoryLeaksOnShutdown := True;
   Edit3.Text := FormatDateTime('hh:mm:ss' ,Now());

   for i := 0 to 3 do
      ToolsStringGrid.Cells[0, i] := '10.21.18.206';
end;

// +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
function  TForm2.GetToolNumberFromContext(const Context : TIdContext) : Integer;
   var IP: String;
       i : Integer;
begin
   IP := Context.Binding.PeerIP;

   // 3 : skip header row & two store rooms, start at first tool
   for i := 3 to Pred(ToolsStringGrid.RowCount) do
   begin
      if IP = ToolsStringGrid.Cells[0, i] then
      begin
         Result := i - 3;  // We number tools zer0 internally in the code, so subtract the start index (3)
         Exit;
      end;
   end;

   TraceError('Communication received from unknown PC (' + IP + ')');

   MessageDlg('Fatal error. '+#13+#10+''+#13+#10+'Communication received from unknown PC (' + IP + ')'+#13+#10+''+#13+#10+'Please remove the machine from the network', mtError, [mbOK], 0);
   Result := 0;
   Halt;
end;  // GetToolNumberFromContext()


// +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
procedure TForm2.IdCmdTCPServer1AfterBind(Sender: TObject);
begin

end;

// +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
procedure TForm2.IdCmdTCPServer1CommandHandlers0Command(ASender: TIdCommand);
   var toolNumber : Integer;
begin
   toolNumber := GetToolNumberFromContext(ASender.Context);

   TraceInfo('Server: ' + ASender.Context.Binding.PeerIP + ']' + 'Received "HEART_BEAT from tool #' + IntToStr(toolNumber + 1) + '"');
   ToolOnLine(toolNumber);

   Edit1.Text := IntToStr(StrToInt(Edit1.Text) + 1);
   Edit4.Text := FormatDateTime('hh:mm:ss' ,Now());

   ASender.Reply.SetReply(200, IntToStr(42));
end;


// +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
procedure TForm2.Timer1Timer(Sender: TObject);
begin
   Edit4.Text := FormatDateTime('hh:mm:ss' ,Now());
end;

// +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
procedure TForm2.ToolOnLine(toolNumber : Integer);
begin

TraceInfo('Server:  tool online at ' + IntToStr(GetCurrentUnixTimeStamp()));
end;   // ToolOnLine();


end.