Solved

How can one clear the message queue in Delphi

Posted on 2008-10-22
15
1,961 Views
Last Modified: 2013-11-23
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
Comment
Question by:staffanbergbom
  • 9
  • 5
15 Comments
 
LVL 28

Expert Comment

by:ciuly
Comment Utility
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
 

Author Comment

by:staffanbergbom
Comment Utility
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
 
LVL 28

Expert Comment

by:ciuly
Comment Utility
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
 

Author Comment

by:staffanbergbom
Comment Utility
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
 
LVL 28

Expert Comment

by:ciuly
Comment Utility
are you sure TThreadCommandObject is the only thing that leaks?
0
 

Author Comment

by:staffanbergbom
Comment Utility
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
 
LVL 28

Expert Comment

by:ciuly
Comment Utility
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
Do You Know the 4 Main Threat Actor Types?

Do you know the main threat actor types? Most attackers fall into one of four categories, each with their own favored tactics, techniques, and procedures.

 
LVL 28

Expert Comment

by:ciuly
Comment Utility
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
 

Author Comment

by:staffanbergbom
Comment Utility
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
 
LVL 28

Expert Comment

by:ciuly
Comment Utility
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
 

Author Comment

by:staffanbergbom
Comment Utility
Thank you very much for all help.
You sure helped med for more than 125 points
0
 
LVL 28

Accepted Solution

by:
ciuly earned 125 total points
Comment Utility
so that was the problem? glad it got fixed :)

PS: I don't look at the points :)
0
 
LVL 28

Expert Comment

by:ciuly
Comment Utility
>> 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
 
LVL 28

Expert Comment

by:ciuly
Comment Utility
thank you modus_operandi
0

Featured Post

Enabling OSINT in Activity Based Intelligence

Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

Join & Write a Comment

Programmer's Notepad is, one of the best free text editing tools available, simply because the developers appear to have second-guessed every weird problem or issue a programmer is likely to run into. One of these problems is selecting and deleti…
Jaspersoft Studio is a plugin for Eclipse that lets you create reports from a datasource.  In this article, we'll go over creating a report from a default template and setting up a datasource that connects to your database.
The viewer will learn how to use NetBeans IDE 8.0 for Windows to connect to a MySQL database. Open Services Panel: Create a new connection using New Connection Wizard: Create a test database called eetutorial: Create a new test tabel called ee…
The viewer will learn how to use and create keystrokes in Netbeans IDE 8.0 for Windows.

762 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

9 Experts available now in Live!

Get 1:1 Help Now