Go Premium for a chance to win a PS4. Enter to Win

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 2260
  • Last Modified:

How can one clear the message queue in Delphi

In an app I have a background thread sending messages to the main-thread and I want to assure there is not any message left in the message queue at app terminate. Every now and then I get memory leakage caused by left over message object sent from the background thread.
0
staffanbergbom
Asked:
staffanbergbom
  • 9
  • 5
1 Solution
 
2266180Commented:
when applicaiton terminates, first stop the thread so that it does not send any more messages, then call application.processmessages.that's about it.
0
 
staffanbergbomAuthor Commented:
EurekaLog which is used in the app, tracks down the memory leakage to the message object that is used to transfer data between threads and that why I think the app must get hokd of these from messages in the queue.

My message object is like:
type
  TThreadCommandObject = class(TObject)
    Command : String;
    Params : WideString;
    memStream : TMemoryStream;
    constructor Create(const InitialCommand, InitialParams : string); overload;
    destructor Destroy; override;
  end;

implementation

constructor TThreadCommandObject.Create(const InitialCommand, InitialParams : string);
begin
  inherited Create;

  Command := InitialCommand;
  Params := InitialParams;
  memStream := TMemoryStream.Create;
end;

destructor TThreadCommandObject.Destroy;
begin
  FreeAndNil(memStream);
 
  inherited;
end;
0
 
2266180Commented:
I figured that much. the code looks ok, but still the object is not destroyed which means that the thread created the ibject but the app did not get it.
so, next question: how do you send the objects to the main trhead and how doe sthe main thread read them?
0
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
staffanbergbomAuthor Commented:
Actually the message object is sent from the main thread to the background thread and not freed properly.

Sending from the main thread:
// send alarm to server
    ThreadOutCommandObject := TThreadCommandObject.Create('SendAlarm', '');
    ThreadOutCommandObject.Params := mobitexAlarm^;
    PostThreadMessage(BackGroundThread.ThreadID, wm_user + 1,
      integer(ThreadOutCommandObject),0);
-----------------------------------------------------------------------------------------------------------------

In main.FormDestroy:
  if FBackGroundThread <> nil then
  begin
    if FBackGroundThread.Suspended then
      FMetriaRescueThread.Resume;

    try
      delayEvent := TEvent.Create(nil, false, false, '');
      FBackGroundThread.Terminate;
      PostThreadMessage(FBackGroundThread.ThreadID, wm_user + 1, 0, 0);
      while not FBackGroundThread.LeftExecutionLoop do
        delayEvent.WaitFor(100);
    finally
      FreeAndNil(delayEvent);
    end;
    FreeAndNil(FBackGroundThread);
  end;
......
-----------------------------------------------------------------------------------------------------------------

BackGroundThread with a try to delete all left over message objects in the Exceute-finally-section:
unit BackGroundThread;

interface

uses
  Windows, Messages, SysUtils, Classes, SyncObjs, ExtCtrls, ActiveX,
  IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP,
  IdException, INetGDAP, FastStrings,
  ThreadCommandObject;

type
  TBackGroundThread = class(TThread)
  private
    { Private declarations }
    FTimer : TTimer;
    FLeftExecutionLoop: boolean;
    FReady: boolean;
    FINetGDAP: TINetGDAP;
    procedure SetLeftExecutionLoop(const Value: boolean);
    procedure SetReady(const Value: boolean);
    procedure SetINetGDAP(const Value: TINetGDAP);
  protected
    procedure Execute; override;
    procedure Timer1Timer(Sender:TObject);
  public
    constructor Create(Suspended : boolean);

    property INetGDAP : TINetGDAP read FINetGDAP write SetINetGDAP;
    property LeftExecutionLoop : boolean read FLeftExecutionLoop write SetLeftExecutionLoop;
    property Ready : boolean read FReady write SetReady;
  end;

implementation

{ Important: Methods and properties of objects in visual components can only be
  used in a method called using Synchronize, for example,

      Synchronize(UpdateCaption);

  and UpdateCaption could look like,

    procedure TBackGroundThread.UpdateCaption;
    begin
      Form1.Caption := 'Updated in a thread';
    end; }

{ TBackGroundThread }

constructor TBackGroundThread.Create(Suspended: boolean);
begin
  inherited Create(suspended);

  FreeOnTerminate := false;
end;

procedure TBackGroundThread.Timer1Timer(Sender:TObject); // required as dummy
begin
end;

procedure TBackGroundThread.Execute;
var
  msg : TMsg;
  mgsAvailable : longbool;
  pMobitexAlarm : pWideString;
  mobitexAlarm, clientIdsList : TStringList;
  URL, MapOptions, RescueDbURL, temp, SID : string;
  clientId, datum, tid, x, y, alarmMessage, missionId: string;
  update : boolean;
  i, timeIndex : integer;
  threadInCommand : TThreadCommandObject;

  function AuthenticateById : string;
  var
    temp : string;
    IdHTTP1: TIdHTTP;
    AuthenticationParameters : TStringList;
  begin
    try
      Result := 'Access denied';

      SID := '';

      AuthenticationParameters := TStringList.Create;
      AuthenticationParameters.Add('ClientId=' + clientId);

      IdHTTP1 := TIdHTTP.Create(nil);

      try
        AuthenticationParameters.Text :=
          StringReplace(IdHTTP1.Post(FINetGDAP.PosDbZURL + '/AuthenticateById', AuthenticationParameters),
            ';', FINetGDAP.CRLF, [rfReplaceAll]);
      except
        on E: EIdException  do
        begin
          Result := E.Message;
          Exit;
        end;
      end;

      SID := AuthenticationParameters.Values['SID'];
      if Pos(';', SID) <> 0 then
        SID := Copy(SID, 1, Pos(';', SID) - 1);
    finally
      FreeAndNil(IdHTTP1);
      FreeAndNil(AuthenticationParameters);
    end;
  end;

  function SaveAlarmMessage : string;
  var
    request : TStringList;
    IdHTTP1: TIdHTTP;
  begin
    try
      request := TStringList.Create;

      IdHTTP1 := TIdHTTP.Create(nil);
      IdHTTP1.ReadTimeout := 20000;

      if SID = '' then
        AuthenticateById;

      URL := RescueDbURL + '/' + 'AddAlarmMessage';

      request.Add('SID=' + SID);
      request.Add('ClientId=' +
        FastReplace(clientIdsList.Text, FINetGDAP.CRLF, ';'));
      request.Add('Datum=' + datum);
      request.Add('Tid=' + tid);
      request.Add('X=' + x);
      request.Add('Y=' + y);
      request.Add('MissionId=' + missionId);
      if update then
        request.Add('Update=Yes');
      request.Add('AlarmMessage=' + alarmMessage);

      try
        Result := IdHTTP1.Post(URL, request);
        if (Result <> 'Done') and
           (Pos('DUPLICATE', UpperCase(Result)) <> 0) then
// alarm update and error caused by already registered data
          Result := 'OK';
      except
        on E:Exception do
          Result := E.Message;
      end;
    finally
      FreeAndNil(request);
      FreeAndNil(IdHTTP1);
    end;
  end;

begin
  try
    CoInitialize(nil); // <-- manually call CoInitialize()

    FTimer := TTimer.create(nil);
    FTimer.Interval := 500;
    FTimer.enabled := true;

    PeekMessage(msg, 0, wm_user, wm_user, PM_NOREMOVE); // force message queue

    FReady := true;

    repeat
      WaitMessage;
      mgsAvailable := GetMessage(msg,0,0,0);
      if Terminated then Break;

      if msg.message = wm_user + 1 then
      begin
        try
          mobitexAlarm := TStringList.Create;
          clientIdsList := TStringList.Create;

          threadInCommand := TThreadCommandObject(msg.WParam);
          mobitexAlarm.Text := threadInCommand.Params;

// Extract MissionId, Time, clientIds, x,  y and RescueDbURL from alarmmessage
          missionId := mobitexAlarm.Values['MissionId'];
          datum := DateToStr(StrToDateTime(mobitexAlarm.Values['Time']));
          tid := TimeToStr(StrToDateTime(mobitexAlarm.Values['Time']));
          clientIdsList.Text :=
            FastReplace(mobitexAlarm.Values['ClientIds'], ';', FINetGDAP.CRLF);
          x := mobitexAlarm.Values['x'];
          y := mobitexAlarm.Values['y'];

          RescueDbURL := mobitexAlarm.Values['RescueDbURL'];

// Remove MissionId, Time, clientIds, x,  y and RescueDbURL from alarmmessage
          timeIndex := mobitexAlarm.IndexOfName('Time');
          i := mobitexAlarm.Count - 1;
          while i >= timeIndex do
          begin
            if SmartPos('Knuten resurs', mobitexAlarm.Strings[i]) = 0 then
            begin
              mobitexAlarm.Delete(i);
              i := mobitexAlarm.Count - 1;
            end
            else
              i := i - 1;
          end;

          alarmMessage := Copy(mobitexAlarm.Text, 1,
            Length(mobitexAlarm.Text) - 2);

          update := false;

          SaveAlarmMessage;
        finally
          FreeAndNil(threadInCommand);
          FreeAndNil(mobitexAlarm);
          FreeAndNil(clientIdsList);
        end;
      end;

      dispatchmessage(msg);
    until Terminated;
  finally

// empty message queue
    mgsAvailable := PeekMessage(msg, 0, wm_user, wm_user + 1, PM_NOREMOVE);
    while mgsAvailable do
    begin
      mgsAvailable := GetMessage(msg,0,0,0);
      threadInCommand := TThreadCommandObject(msg.WParam);
      if threadInCommand = nil then Break;

      try
        FreeAndNil(threadInCommand);
      except
      end;
      mgsAvailable := PeekMessage(msg, 0, wm_user, wm_user + 1, PM_NOREMOVE);
    end;

    FTimer.Enabled:=false;
    FTimer.Free;

    CoUnInitialize; // <-- free memory

    FLeftExecutionLoop := true;
  end;
end;

0
 
2266180Commented:
are you sure TThreadCommandObject is the only thing that leaks?
0
 
staffanbergbomAuthor Commented:
Well, EurekLog point sout exactly line:
    ThreadOutCommandObject := TThreadCommandObject.Create('SendAlarm', '');

The strange thing is that leakage doesn't occur every time. That is why I try to delete every messageObject, left over in the background thread and in main thread Destroy-method calling:

procedure TForm1.EmptyMessageQueue;
var
  msg : TMsg;
  mgsAvailable : longbool;
  threadInCommand : TThreadCommandObject;
begin
  mgsAvailable := PeekMessage(msg, 0, wm_user, wm_user + 1, PM_NOREMOVE);
  while mgsAvailable do
  begin
    mgsAvailable := GetMessage(msg,0,0,0);
    threadInCommand := TThreadCommandObject(msg.WParam);

    try
      FreeAndNil(threadInCommand);
    except
    end;
    mgsAvailable := PeekMessage(msg, 0, wm_user, wm_user + 1, PM_NOREMOVE);
  end;
end;

procedure EmptyMessageQueue gives a compilation-error like:
[Error] Form1.pas(401): Incompatible types: 'tagMSG' and 'IXMLDocument' at code-line:
    mgsAvailable := GetMessage(msg,0,0,0);

0
 
2266180Commented:
that compilation erro is becaue your TMsg type is an IXMLDocument descendant. this usually happens when you add to the uses clause a unit in which TMsg is declared. to see what uit is that, move the mouse cursor over TMsg and it will tell you in which unit is defined. then just move that unit before windows in the uses clause.

as a side of precaution, do liek this (there are a lot of things I would change in yoru code, but for now lets just fix this aprticular leak):

change
    PostThreadMessage(BackGroundThread.ThreadID, wm_user + 1,
      integer(ThreadOutCommandObject),0);
to
    if not PostThreadMessage(BackGroundThread.ThreadID, wm_user + 1,
      integer(ThreadOutCommandObject),0) then
    begin
      freeandnil(ThreadOutCommandObject);
      exit;// or whatever you want to do in case the message cannot be posted to the thread.
    end;

let mne know if this reduces the number of leaked objects.

also, I asked if this object is the only one that leaks. you didn't answer that part. I haven't used eurekalog for years so I don't know what amount of information it returnes. I uses fastmm for memory leakage detection and that tells me all the leakages. I suspect eruakalog also tells you all the leakages.
looking at your code I think you have other leakages as well, since they are possible.
0
 
2266180Commented:
by the way, quite from MSDN:

Messages sent by PostThreadMessage are not associated with a window. As a general rule, messages that are not associated with a window cannot be dispatched by the DispatchMessage function.

;)
0
 
staffanbergbomAuthor Commented:
Only one leakage after making 175 posts to the background thread and at the same code-line.
// send alarm to server
    ThreadOutCommandObject := TThreadCommandObject.Create('SendAlarm', '');
 
About the compilation error I found out that using Delphi:s XML Data binding wizard I came out with code defining a procedure GetMessage. Changed that and compilation goes through without errors.

Still I have this leagage.

Would be nice to get some tips from you, about the other things you don't think are too good in my code.

Anyway thanks a lot for your assistance
0
 
2266180Commented:
does the leackage appear right before terminating the thread? since there are 175 posts with no issues, something changes around post 175. I am thinking it's the thread terminating. if not, can you asses what might change? maybe you have that line (ThreadOutCommandObject := TThreadCommandObject.Create('SendAlarm', '');) called from different scenarios and one of them is faulty?

did you make the change I suggested? do you still get the leakage in the same terms with the change? I would expect leakages to at least drop after that change if not dissapear.

beside the dispatchmessagebhint, here is another one:

        finally
          FreeAndNil(threadInCommand);
          FreeAndNil(mobitexAlarm);
          FreeAndNil(clientIdsList);
        end;

what happens when FreeAndNil(threadInCommand); causes an error? mobitexAlarm and clientIdsList do not get destroyed.

what I usually do is this:

create resource
try
  create resource
  try
    .. etc...
  finally
    destroy resource
  end;
finally
  destroy resource
end;

this way, I decrease the chances of un destroyed resources. which can still happen, like for example when you kill a trhead using the killthread api. but these are cases that cannot be controlled by the programmer anyway.

but all this is not the root of your problem.something else is. soemthing happens around post 175 which causes one object not to be destroyed. is it always 175 posts? can you identify something constant about this leackage?

btw, I just noticed this:

      mgsAvailable := GetMessage(msg,0,0,0);
      if Terminated then Break;

this will cause a leackage when the thread is terminating as I suspected initially in this comment. because the message is retrieved (getmessage returned), but the thread terminates execution so it doens't free the object. change those to lines to

      if Terminated then Break;
      mgsAvailable := GetMessage(msg,0,0,0);

and because your main trhead is clearing the message queue after terminating the trhead, this should fix it.
0
 
staffanbergbomAuthor Commented:
Thank you very much for all help.
You sure helped med for more than 125 points
0
 
2266180Commented:
so that was the problem? glad it got fixed :)

PS: I don't look at the points :)
0
 
2266180Commented:
>> PS: I don't look at the points :)

but I do look at the grade. so why a B grade? did you not read the grading tips: http://www.experts-exchange.com/help.jsp#hi403 ?
0
 
2266180Commented:
thank you modus_operandi
0

Featured Post

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 9
  • 5
Tackle projects and never again get stuck behind a technical roadblock.
Join Now