Link to home
Start Free TrialLog in
Avatar of Kifah Najem
Kifah Najem

asked on

ADO Memory leak with DELPHI 2007

Hi,

I have a simple process with ADOquery running on a timer event, but I keep losing memory, memory keep increasing, in about 12 hours increased from 35MB to 75MB

The code
Type
  TNotifyPolicy = record
    ID: String;
    Title: String;
    EmpID: String;
    EmpName: String;
    DeptName: String;
    DeptID: String;
    OrgID: String;
    OrgName: String;
    Email: String;
    ReportedTo: String;
    DeptEmail: String;
    ShowBeginLate: Boolean;
    ShowOutEarly: Boolean;
    ShowGap: Boolean;
    ShowAbsentTime: Boolean;
    ShowAbsent: Boolean;
    ShowMissPunch: Boolean;
    ShowErrorPunch: Boolean;
    ShowContAbsent: Boolean;
    AbsentCntToNotify: Integer; 
    CAResetOnOffDay: Boolean; 
    SendEmail: Boolean;
    SendEndOfShift: Boolean;
    SendFrom: String;
    SendTo: String;
    SendCC: String;
    SendBCC: String;
    EmailSubject: String;
    EmailMsgText: String;
    SMTP: String;
    SMTPPORT: Integer;
    SMTPTYPE: Integer;
    SMTPUSERID: String;
    SMTPPWD: String;
    TranslateTXT: String;
  end;
 
Function TemxNotify.GetNotifyPolicy(EmpID: String): TNotifyPolicy;
begin
  try
    try
      {get notify policy for employee}
      qryNotifyPolicy.Close;
      qryNotifyPolicy.SQL.Text := Format('SELECT * FROM VEMPNOTIFYLST WHERE NPEMID = ''%s''', [EmpID]);
      qryNotifyPolicy.Open;

      {if not found get default notify policy}
      if qryNotifyPolicy.IsEmpty then begin
        qryNotifyPolicy.Close;
        qryNotifyPolicy.SQL.Text := Format('select NOTIFYPOLICY.*, REPEMPFILE.*  from NOTIFYPOLICY , REPEMPFILE ' +
                                           'where NOTIFYPOLICY.NPISDEFAULT=1 and REPEMPFILE.emid = ''%s''', [EmpID]);
        qryNotifyPolicy.Open;
      end;

      if qryNotifyPolicy.RecordCount > 0 then begin
        if not qryNotifyPolicy.FieldByName('NPID').IsNull then begin
          With Result do begin
            ID := qryNotifyPolicy.FieldByName('NPID').AsString;
            EmpID := EmpID;
            EmpName := qryNotifyPolicy.FieldByName('EMNAME').AsString;
            DeptName := qryNotifyPolicy.FieldByName('DMNAME').AsString;
            DeptID := qryNotifyPolicy.FieldByName('DMID').AsString;
            OrgID := qryNotifyPolicy.FieldByName('OCID').AsString;
            OrgName := qryNotifyPolicy.FieldByName('OCNAME').AsString;
            Email := qryNotifyPolicy.FieldByName('EMEMAIL').AsString;
            ReportedTo := qryNotifyPolicy.FieldByName('EMREPORTEDTO').AsString;
            DeptEmail := qryNotifyPolicy.FieldByName('DMEMAIL').AsString;
            Title := qryNotifyPolicy.FieldByName('NPTITLE').AsString;
            ShowBeginLate := qryNotifyPolicy.FieldByName('SHOWBEGINLATE').AsInteger = 1;
            ShowOutEarly := qryNotifyPolicy.FieldByName('SHOWOUTEARLY').AsInteger = 1;
            ShowGap := qryNotifyPolicy.FieldByName('SHOWGAP').AsInteger = 1;
            ShowAbsentTime := qryNotifyPolicy.FieldByName('SHOWABSENTTIME').AsInteger = 1;
            ShowAbsent := qryNotifyPolicy.FieldByName('SHOWABSENT').AsInteger = 1;
            ShowMissPunch := qryNotifyPolicy.FieldByName('SHOWMISSPUNCH').AsInteger = 1;
            ShowErrorPunch := qryNotifyPolicy.FieldByName('SHOWERRORPUNCH').AsInteger = 1;
            ShowContAbsent := qryNotifyPolicy.FieldByName('SHOWCONTABSENT').AsInteger = 1;
            AbsentCntToNotify := qryNotifyPolicy.FieldByName('ABSENTCNTTONOTIFY').AsInteger;
            CAResetOnOffDay := qryNotifyPolicy.FieldByName('CARESETONOFFDAY').AsInteger = 1;
            SendEmail := qryNotifyPolicy.FieldByName('SENDEMAIL').AsInteger = 1;
            SendEndOfShift := qryNotifyPolicy.FieldByName('SENDENDOFSHIFT').AsInteger = 1;
            SendFrom := qryNotifyPolicy.FieldByName('SENDFROM').AsString;
            SendTo := qryNotifyPolicy.FieldByName('SENDTO').AsString;
            SendCC := qryNotifyPolicy.FieldByName('SENDCC').AsString;
            SendBCC := qryNotifyPolicy.FieldByName('SENDBCC').AsString;
            EmailSubject := qryNotifyPolicy.FieldByName('EMAILSUBJECT').AsString;
            EmailMsgText := qryNotifyPolicy.FieldByName('EMAILMSGTEXT').AsString;
            {SMTP := qryNotifyPolicy.FieldByName('NPSMTP').AsString;
            SMTPPORT := qryNotifyPolicy.FieldByName('NPSMTPPORT').AsInteger;
            SMTPTYPE := qryNotifyPolicy.FieldByName('NPSMTPTYPE').AsInteger;
            SMTPUSERID := qryNotifyPolicy.FieldByName('NPSMTPUSERID').AsString;
            SMTPPWD := qryNotifyPolicy.FieldByName('NPSMTPPWD').AsString;}
            TranslateTXT := qryNotifyPolicy.FieldByName('NPTRANSLATE').AsString;
          end;
        end else Result.ID := '-1';
      end else Result.ID := '-1';
    except
      on E: Exception do begin
        LogError('GetNotifyPolicy: ' + E.Message);
      end;
    end;
  finally
    qryNotifyPolicy.Close;
  end;
end;

Function ProcessData
var
  NotifyPolicy: TNotifyPolicy;
begin
try
    qryEmpList.Close;    
    qryEmpList.SQL.Text := 'SELECT DISTINCT EAMEMID from EMPATTNMST where (EAMCALCSTATUS = 1) AND ' +
                           'NOT (EAMEMID IN (SELECT EMID FROM VSRVCEMPLIST)) order by EAMEMID';
    qryEmpList.DisableControls;
    qryEmpList.Open;
    
    while not qryEmpList.EOF and not (StopLoop) do begin
      qryATTMST.Close;
      qryATTMST.DisableControls;
      qryATTMST.SQL.Text := 'SELECT * FROM EMPATTNMST WHERE (EAMEMID = :EAMEMID) AND (EAMDATE <= :EAMDATE) ' +
	 		    'AND (EAMATTNSTATUS <> :EAMATTNSTATUS) AND ' +
	  		    '(EAMCALCSTATUS = 1) ORDER BY EAMEMID, EAMDATE';
      qryATTMST.Parameters.ParamByName('EAMDATE').DataType := ftDateTime;
      qryATTMST.Parameters.ParamByName('EAMATTNSTATUS').DataType := ftFloat;
      qryATTMST.Parameters.ParamByName('EAMEMID').DataType := ftString;

      qryATTMST.Parameters.ParamByName('EAMDATE').Value := DateOf(prmToDate);
      qryATTMST.Parameters.ParamByName('EAMATTNSTATUS').Value := 99;
      qryATTMST.Parameters.ParamByName('EAMEMID').Value := prmEMID;
      qryATTMST.Open;
    
      NotifyPolicy := GetNotifyPolicy(EMID);
    
      qryEmpList.Next
    end;
    
Finally
  qryEmpList.Close;
  qryATTMST.Close;
End;
end;

Open in new window

This function run from the timer event every 1 minute
I am using Delphi 2007
Backbend Database Oracle 12g
Oracle client it is ODAC 12g
Project type Windows service

Note: when I comment this line "NotifyPolicy := GetNotifyPolicy(EMID);", the leak decrease too much
Avatar of Kifah Najem
Kifah Najem

ASKER

Note:
I have EurekaLog and it did not report any memory leak
Avatar of ste5an
Use ReportMemoryLeaksOnShutdown := (DebugHook <> 0); in your .dpr.

But should be you ProcessData method. You are creating new records, but you're not disposing them. Also you don't use that record anywhere.
I used the ReportMemoryLeaksOnShutdown = True, but nothing shown, as well I used EurekaLog to report any memory leak, but again it did not report anything.
as my test I notice the following

Open and ADOConnection will reserve memory, closing it again, will not free those memory
after open the ADOConnection, running a ADODataSet or ADOQuery, will consume memory, some of this memory will return and some others will not,
So in a Windows Service application, I need to run some ADODataset every 5 minutes to check and process some data, so the service started with 35MB, within less than 12 hours it reaches to 85MB.

So I think that the ADOQuery\ADODataset it reserve memory when I run the query, but all those reserved memory are not freed until the application terminate, and that's why memory leak reporting tool not reporting any leak, because on application terminate all those memory are freed.
How to dispose those records, what I have a simple record type, which is set of variables, and in the loop I fill this type record to do some calculation and store it in the database.
The problem is: your code snippet is not sufficient to diagnose a mem leak. the entire code is necessary.
Hi,

simply run the following code, and watch the memory dropping

procedure TForm2.Button2Click(Sender: TObject);
var
  I: Integer;
  J: Integer;
  Max: Integer;
  dd: TNotifyPolicy;
  myADOConn: TADOConnection;
  myDataSet1: TADOQuery;
  myDataSet2: TADODataSet;
begin
  try
    myADOConn  := TADOConnection.Create(nil);
    myDataSet1 := TADOQuery.Create(nil);
    myDataSet2 := TADODataSet.Create(nil);

    myDataSet1.Connection := myADOConn;
    myDataSet2.Connection := myADOConn;

    myADOConn.ConnectionString := IVMTDBConn.ConnectionString;
    myADOConn.CursorLocation := clUseServer;
    myADOConn.LoginPrompt := False;
    myADOConn.Open;


    Max := StrToIntDef(Memo1.Text, 1);
    ProgressBar1.Max := Max;
    ProgressBar1.Position := 0;
    for I := 0 to Max do begin
      myDataSet1.Close;
      myDataSet1.Sql.Text := 'select * from VDAYOFFEMPPOLICY WHERE ADOSTATUS = 1222';
      myDataSet1.Open;
      //qryEmpList.Open;
       //Application.ProcessMessages;


      for J := 0 to myDataSet1.FieldCount-1 do begin
        Caption := myDataSet1.FieldByName( myDataSet1.Fields[J].FieldName ).AsString;
        Caption := myDataSet1.FieldByName( 'EMID' ).AsString;
        dd := Getdd;
      end;


      myDataSet2.Close;
      myDataSet2.CommandText := 'SELECT * FROM EMPATTNMST WHERE (EAMEMID >= :EAMEMID) and ' +
                               '(EAMDATE = :FROMDATE) ORDER BY EAMDATE';
      myDataSet2.Parameters.ParamByName('EAMEMID').DataType := ftString;
      myDataSet2.Parameters.ParamByName('FROMDATE').DataType := ftDateTime;
      myDataSet2.Parameters.ParamByName('EAMEMID').Value := '91323';
      myDataSet2.Parameters.ParamByName('FROMDATE').Value := DateOf(date-100);
      myDataSet2.Open;

      //qryEmpAtt.Open;

      ProgressBar1.Position := ProgressBar1.Position +1;
    end;

  finally

    myDataSet1.Close;
    myDataSet2.Close;
    myADOConn.Close;



    FreeAndNil(myDataSet1);
    FreeAndNil(myDataSet2);
    FreeAndNil(myADOConn);
    //CoUninitialize;
  end;
end;

Open in new window

well yes, your function is creating a TNotifyPolicy for every call
that's expected behaviour

i don't see any freeing of that resource
I'd modify to using an object, which you can instantiate and free as needed
i've got some dislexia in my fingers and didn't test this, so you might get a typo ...

Wow ... replacement instead of bind variables ???
use bind variables if you want performance
hasn't your dba come knocking on your door for bad queries yet ?

Type
  TNotifyPolicy = TObject
    ID: String;
    Title: String;
    EmpID: String;
    EmpName: String;
    DeptName: String;
    DeptID: String;
    OrgID: String;
    OrgName: String;
    Email: String;
    ReportedTo: String;
    DeptEmail: String;
    ShowBeginLate: Boolean;
    ShowOutEarly: Boolean;
    ShowGap: Boolean;
    ShowAbsentTime: Boolean;
    ShowAbsent: Boolean;
    ShowMissPunch: Boolean;
    ShowErrorPunch: Boolean;
    ShowContAbsent: Boolean;
    AbsentCntToNotify: Integer; 
    CAResetOnOffDay: Boolean; 
    SendEmail: Boolean;
    SendEndOfShift: Boolean;
    SendFrom: String;
    SendTo: String;
    SendCC: String;
    SendBCC: String;
    EmailSubject: String;
    EmailMsgText: String;
    SMTP: String;
    SMTPPORT: Integer;
    SMTPTYPE: Integer;
    SMTPUSERID: String;
    SMTPPWD: String;
    TranslateTXT: String;
  end;
 
Function TemxNotify.GetNotifyPolicy(EmpID: String; NP: TNotifyPolicy): Boolean;
begin
  result := false;
  try
    try
      {get notify policy for employee}
      qryNotifyPolicy.Close;
      qryNotifyPolicy.SQL.Text := 'SELECT * FROM VEMPNOTIFYLST WHERE NPEMID = :EMPID';
      qryNotifyPolicy.ParamByName('EMPID').AsString := EmpID;
      qryNotifyPolicy.Open;

      {if not found get default notify policy}
      if qryNotifyPolicy.IsEmpty then 
      begin
        qryNotifyPolicy.Close;
        qryNotifyPolicy.SQL.Text := 
          'select NOTIFYPOLICY.*, REPEMPFILE.*  from NOTIFYPOLICY , REPEMPFILE ' +
          'where NOTIFYPOLICY.NPISDEFAULT=1 and REPEMPFILE.emid = :EMPID';
        qryNotifyPolicy.ParamByName('EMPID').AsString := EmpID;
        qryNotifyPolicy.Open;
      end;

      if qryNotifyPolicy.RecordCount > 0 then 
      begin
        if not qryNotifyPolicy.FieldByName('NPID').IsNull then 
        begin
          Result := True; // indicate a found policy
          With NP do 
          begin
            ID := qryNotifyPolicy.FieldByName('NPID').AsString;
            EmpID := EmpID;
            EmpName := qryNotifyPolicy.FieldByName('EMNAME').AsString;
            DeptName := qryNotifyPolicy.FieldByName('DMNAME').AsString;
            DeptID := qryNotifyPolicy.FieldByName('DMID').AsString;
            OrgID := qryNotifyPolicy.FieldByName('OCID').AsString;
            OrgName := qryNotifyPolicy.FieldByName('OCNAME').AsString;
            Email := qryNotifyPolicy.FieldByName('EMEMAIL').AsString;
            ReportedTo := qryNotifyPolicy.FieldByName('EMREPORTEDTO').AsString;
            DeptEmail := qryNotifyPolicy.FieldByName('DMEMAIL').AsString;
            Title := qryNotifyPolicy.FieldByName('NPTITLE').AsString;
            ShowBeginLate := qryNotifyPolicy.FieldByName('SHOWBEGINLATE').AsInteger = 1;
            ShowOutEarly := qryNotifyPolicy.FieldByName('SHOWOUTEARLY').AsInteger = 1;
            ShowGap := qryNotifyPolicy.FieldByName('SHOWGAP').AsInteger = 1;
            ShowAbsentTime := qryNotifyPolicy.FieldByName('SHOWABSENTTIME').AsInteger = 1;
            ShowAbsent := qryNotifyPolicy.FieldByName('SHOWABSENT').AsInteger = 1;
            ShowMissPunch := qryNotifyPolicy.FieldByName('SHOWMISSPUNCH').AsInteger = 1;
            ShowErrorPunch := qryNotifyPolicy.FieldByName('SHOWERRORPUNCH').AsInteger = 1;
            ShowContAbsent := qryNotifyPolicy.FieldByName('SHOWCONTABSENT').AsInteger = 1;
            AbsentCntToNotify := qryNotifyPolicy.FieldByName('ABSENTCNTTONOTIFY').AsInteger;
            CAResetOnOffDay := qryNotifyPolicy.FieldByName('CARESETONOFFDAY').AsInteger = 1;
            SendEmail := qryNotifyPolicy.FieldByName('SENDEMAIL').AsInteger = 1;
            SendEndOfShift := qryNotifyPolicy.FieldByName('SENDENDOFSHIFT').AsInteger = 1;
            SendFrom := qryNotifyPolicy.FieldByName('SENDFROM').AsString;
            SendTo := qryNotifyPolicy.FieldByName('SENDTO').AsString;
            SendCC := qryNotifyPolicy.FieldByName('SENDCC').AsString;
            SendBCC := qryNotifyPolicy.FieldByName('SENDBCC').AsString;
            EmailSubject := qryNotifyPolicy.FieldByName('EMAILSUBJECT').AsString;
            EmailMsgText := qryNotifyPolicy.FieldByName('EMAILMSGTEXT').AsString;
            {SMTP := qryNotifyPolicy.FieldByName('NPSMTP').AsString;
            SMTPPORT := qryNotifyPolicy.FieldByName('NPSMTPPORT').AsInteger;
            SMTPTYPE := qryNotifyPolicy.FieldByName('NPSMTPTYPE').AsInteger;
            SMTPUSERID := qryNotifyPolicy.FieldByName('NPSMTPUSERID').AsString;
            SMTPPWD := qryNotifyPolicy.FieldByName('NPSMTPPWD').AsString;}
            TranslateTXT := qryNotifyPolicy.FieldByName('NPTRANSLATE').AsString;
          end;
        end else NP.ID := '-1';
      end else NP.ID := '-1';
    except
      on E: Exception do 
      begin
        LogError('GetNotifyPolicy: ' + E.Message);
      end;
    end;
  finally
    qryNotifyPolicy.Close;
  end;
end;

Function ProcessData
var
  NotifyPolicy: TNotifyPolicy;
begin
try
    qryEmpList.Close;    
    qryEmpList.SQL.Text := 'SELECT DISTINCT EAMEMID from EMPATTNMST where (EAMCALCSTATUS = 1) AND ' +
                           'NOT (EAMEMID IN (SELECT EMID FROM VSRVCEMPLIST)) order by EAMEMID';
    qryEmpList.DisableControls;
    qryEmpList.Open;
    
    while not qryEmpList.EOF and not (StopLoop) do begin
      qryATTMST.Close;
      qryATTMST.DisableControls;
      qryATTMST.SQL.Text := 'SELECT * FROM EMPATTNMST WHERE (EAMEMID = :EAMEMID) AND (EAMDATE <= :EAMDATE) ' +
	 		    'AND (EAMATTNSTATUS <> :EAMATTNSTATUS) AND ' +
	  		    '(EAMCALCSTATUS = 1) ORDER BY EAMEMID, EAMDATE';
      qryATTMST.Parameters.ParamByName('EAMDATE').DataType := ftDateTime;
      qryATTMST.Parameters.ParamByName('EAMATTNSTATUS').DataType := ftFloat;
      qryATTMST.Parameters.ParamByName('EAMEMID').DataType := ftString;

      qryATTMST.Parameters.ParamByName('EAMDATE').Value := DateOf(prmToDate);
      qryATTMST.Parameters.ParamByName('EAMATTNSTATUS').Value := 99;
      qryATTMST.Parameters.ParamByName('EAMEMID').Value := prmEMID;
      qryATTMST.Open;
    
      NotifyPolicy := TNotifyPolicy.Create;
      try 
        GetNotifyPolicy(EMID, NotifyPolicy);

        // do something else with notifypolicy ???
      finally
        NotifyPolicy.Free;
      end;
    
      qryEmpList.Next
    end;
    
Finally
  qryEmpList.Close;
  qryATTMST.Close;
End;
end;

Open in new window

Hi,
the TObject as a type is not supported in Delphi 2007, instead I used Class...
but even I removed the code which calls the TNotifyPolicy.
This code was removed in my test
NotifyPolicy := TNotifyPolicy.Create;
      try 
        GetNotifyPolicy(EMID, NotifyPolicy);

        // do something else with notifypolicy ???
      finally
        NotifyPolicy.Free;
      end;

Open in new window


memory problem still exists.

This what I find out today with my test
I used the ReportMemoryLeaksOnShutdown = True, but nothing shown, as well I used EurekaLog to report any memory leak, but again it did not report anything.
as my test I notice the following

Open and ADOConnection will reserve memory, closing it again, will not free those memory
after open the ADOConnection, running a ADODataSet or ADOQuery, will consume memory, some of this memory will return and some others will not,
So in a Windows Service application, I need to run some ADODataset every 5 minutes to check and process some data, so the service started with 35MB, within less than 12 hours it reaches to 85MB.

So I think that the ADOQuery\ADODataset it reserve memory when I run the query, but all those reserved memory are not freed until the application terminate, and that's why memory leak reporting tool not reporting any leak, because on application terminate all those memory are freed.


Small question please, what you mean by "bind variables"

No he did not knock the door yet ;)
i see some odd places of some code you have put.
you don't seem to understand EnableControls and DisableControls

i know this a sample, but this code has some holes in it

try
    qryEmpList.Close;    
    qryEmpList.SQL.Text := 'SELECT DISTINCT EAMEMID from EMPATTNMST where (EAMCALCSTATUS = 1) AND ' +
                           'NOT (EAMEMID IN (SELECT EMID FROM VSRVCEMPLIST)) order by EAMEMID';
    qryEmpList.DisableControls;

Open in new window


you close the query first, before using DisableControls
in a gui, the records will disappear in a dbgrid when the qry.close is run
because of that ... everything will also be slower in processing

typical code:
  query.disablecontrols;
  try
    query.close;
    query.sql.text := 'blablabla';
    query.open;
  finally
    query.enablecontrols;
  end;

Open in new window


when you use a query component which is also attached to a gui (TDatasource - TDBGrid ... etc)
be careful not to mess with the visual display too much

you might want to save a bookmark with the current position of the cursos of the query too
and restore it before enabling the controls
lol ... you removed the which will probably solve your memory problem
forgot the class word !

TNotifyPolicy = class(TObject)
off course Delphi 2007 supports TObject

TObject has been supported since Turbo Pascal 5.0
which is ... almost 3 decades ago
but after removing it, still the problem exists
if you run simply this code, a memory leek will happen, and will not return until I close the windows service.

procedure TForm2.Button2Click(Sender: TObject);
var
  I: Integer;
  J: Integer;
  Max: Integer;
  dd: TNotifyPolicy;
  myADOConn: TADOConnection;
  myDataSet1: TADOQuery;
  myDataSet2: TADODataSet;
begin
  try
    myADOConn  := TADOConnection.Create(nil);
    myDataSet1 := TADOQuery.Create(nil);
    myDataSet2 := TADODataSet.Create(nil);

    myDataSet1.Connection := myADOConn;
    myDataSet2.Connection := myADOConn;

    myADOConn.ConnectionString := IVMTDBConn.ConnectionString;
    myADOConn.CursorLocation := clUseServer;
    myADOConn.LoginPrompt := False;
    myADOConn.Open;


    Max := StrToIntDef(Memo1.Text, 1);
    ProgressBar1.Max := Max;
    ProgressBar1.Position := 0;
    for I := 0 to Max do begin
      myDataSet1.Close;
      myDataSet1.Sql.Text := 'select * from VDAYOFFEMPPOLICY WHERE ADOSTATUS = 1222';
      myDataSet1.Open;
      //qryEmpList.Open;
       //Application.ProcessMessages;


      for J := 0 to myDataSet1.FieldCount-1 do begin
        Caption := myDataSet1.FieldByName( myDataSet1.Fields[J].FieldName ).AsString;
        Caption := myDataSet1.FieldByName( 'EMID' ).AsString;
        //dd := Getdd;
      end;


      myDataSet2.Close;
      myDataSet2.CommandText := 'SELECT * FROM EMPATTNMST WHERE (EAMEMID >= :EAMEMID) and ' +
                               '(EAMDATE = :FROMDATE) ORDER BY EAMDATE';
      myDataSet2.Parameters.ParamByName('EAMEMID').DataType := ftString;
      myDataSet2.Parameters.ParamByName('FROMDATE').DataType := ftDateTime;
      myDataSet2.Parameters.ParamByName('EAMEMID').Value := '91323';
      myDataSet2.Parameters.ParamByName('FROMDATE').Value := DateOf(date-100);
      myDataSet2.Open;

      //qryEmpAtt.Open;

      ProgressBar1.Position := ProgressBar1.Position +1;
    end;

  finally

    myDataSet1.Close;
    myDataSet2.Close;
    myADOConn.Close;



    FreeAndNil(myDataSet1);
    FreeAndNil(myDataSet2);
    FreeAndNil(myADOConn);
  end;
end;

Open in new window


but as you know the windows service keep running all the time, so just keep losing more memory every time I run a query, I will run out of memory in couple of days.
oops ... TObject since Turbo Pascal 5.5
I knew i wasn't far off ...
https://en.wikipedia.org/wiki/Turbo_Pascal

I know because I wrote my first object oriented program with that version in 1991
A Nasi-Schneider-Mann schema generator using pascal source files as input
another thing ... misuse of try finally
you are creating TAdo component after the try ...
it should be before the try

conn := TAdoConnection.Create(nil);
try
  // do something with conn.
finally
  conn.Free;
end;

Open in new window

What is the point in maintaining progressbar inside a Service app ?
a service app doesn't have a gui ... so there is no point in that
YEs, I know.... in the service application it dose not exists.
but what I did, is copy the code from the service application to VCL application to have easier monitoring
I removed the ADO create, and I used TADOConnection. TADODataSet and TADOQurey direct place on the form
a service app shouldn't have forms ...
there is no point in that

you should separate the processing from the visual forms

just some of the things which needn't/shouldn't be used in service apps:
query.disablecontrols
query.enablecontrols
forms
frames
any visual component

a service app is typically putting on a blindfold and program ...
as there is no visual feedback in a gui
> you need to write everything to a textfile and then examine the text files for the problem

you're still a very long way from converting a forms application to a service application ...
Yes, sure.... what I mean...
in the service application there is no visual control at all, since I do not need it.

but since debug the service application quiet take time...
I created a VCL application to do my testing.
in the application I past the code I used in the service with some modification  for progress and disabledcontrol
so this is actually your attempt at converting a normal app into a service app ?

> you need a task table
or something similar to feed tasks to the service app

example:
gui
> a user asks for a report
the gui inserts a record in the tasks tabel
or sends a message via a certain protocol to the service app

service app
> reads tasks from the task tabel
generates the report
> indicates status done in the task tabel

gui check for status done of report in tasks tabel
and show the user the report

see how there is a communication layer between the gui and the service app ?
you need such a layer
... logs ... logs ... logs
create a logging system

in every func/proc you'll have to be minimally write a try except handler to write the errors to the log
so you know which func has failed

you might want to write extra log to actually find the problem
writing a forms app is like playing football

writing a service app is similar ... except it's basketball ... and blindfolded
Services are more like Snooker: large table, small targets. Could only be won, when played with great precision.
No... ;)
I know all this...

OK...
I wrote a service which do the following
1. check the employee attendance
2. if there is an employee with missing working hours or missing punches will send an email as well will log this in another table

Sure in the service there is no GUI controls at all since it is not needed
but when I run the service, it works perfect, but I found that it is consuming memory by time, so every day it reserve about 30MB, and those 30MB never release...

so then I created a small test VCL application to see why the memory leek happened...
then after I create the application I found that using the ADO components will reserve memory, and those memory are released only when closing the application and not when I make ADOQuery.Close or ADOConnection.Close.

so I wrote some of the code which explain the problem.

Now, if you place 1 TADOConnection and 2 TADODataSet or TADOQuery on the form with 1 TButton and use this code

procedure TForm2.Button2Click(Sender: TObject);
var
  I: Integer;
  J: Integer;
  Max: Integer;
begin
  try
    Max := 20;
    ProgressBar1.Max := Max;
    ProgressBar1.Position := 0;
    for I := 0 to Max do begin
      qryEmpList.Close;
      qryEmpList.Sql.Text := 'select * from VDAYOFFEMPPOLICY WHERE ADOSTATUS = 1222';
      qryEmpList.Open;



      for J := 0 to qryEmpList.FieldCount-1 do begin
        Caption := qryEmpList.FieldByName( qryEmpList.Fields[J].FieldName ).AsString;
        Caption := qryEmpList.FieldByName( 'EMID' ).AsString;
      end;


      qryEmpAtt.Close;
      qryEmpAtt.CommandText := 'SELECT * FROM EMPATTNMST WHERE (EAMEMID >= :EAMEMID) and ' +
                               '(EAMDATE = :FROMDATE) ORDER BY EAMDATE';
      qryEmpAtt.Parameters.ParamByName('EAMEMID').DataType := ftString;
      qryEmpAtt.Parameters.ParamByName('FROMDATE').DataType := ftDateTime;
      qryEmpAtt.Parameters.ParamByName('EAMEMID').Value := '91323';
      qryEmpAtt.Parameters.ParamByName('FROMDATE').Value := DateOf(date-100);
      qryEmpAtt.Open;

      ProgressBar1.Position := ProgressBar1.Position +1;
    end;

  finally

    myDataSet1.Close;
    myDataSet2.Close;
    myADOConn.Close;
  end;
end;

Open in new window


you will see that there is memory leak every time you click the button, and those reserved memory are not freed till you close the application
Yes, you are correct, I have logging mechanism in my service, which logs any error for every single function.

but this nothing to do with my memory problem ;)
the problem you encounter is not easy to be solved. the cause of increasing memory is that your ado components reserve contiguous memory in bigger pieces. these bigger pieces were freed with close but parts of the free space immediately was reused for some other variables. hence the next open wouldn't get the same big piece of contiguous memory for the ado component since free space is no longer big enough for the new request. so free space becomes more and more fragmented and the memory used by your program increases, since smaller free space units are still reserved for heap management and performance reasons. if you run in debug mode things go worse since the debugger also made allocations and uses the same heap management. another point is that the query would run asynchronously in another thread and even process context. since you don't evaluate the results but immediately repeat the query, the asynchronous task was cancelled while the new task was created. all that prevents the heap management to orderly reuse the former memory again and increases defragmentation.

it is not so easy to come out from this. you first should try whether the problem still exists in release mode. you also should have some wait time between two queries (what probably is more realistic than to repeat the same query immediately). and open and close should be in the same loop cycle what helps the compiler to optimize memory requirements.

if that doesn't help or still is not acceptable, probably the simplest way out is to start a new executable for each query and put the result set to shared memory such that the service could get access to it without using heap memory.

Sara
Hi Sara,
OK, what you says seem what is happening...
actually in the real service I am not repeating the same query, but this what I am doing..

1. Start the function by executing a query which get all employees need data processing
2. Start While Not EOF loop for employee query to process each employee
3. Within this loop I execute 3 queries, each one of them get deferent information for the employee
4. process the information and do the calculation then insert those calculated values in another table
5. Another function run then after the first one, which send a notification email contain the calculated data

That's all what I do in the service...

OK, during my search I found yesterday a function as following
procedure FreeingMemory;
var
  pmc: TProcessMemoryCounters;
  MemorySize : Cardinal;
begin
  pmc.cb := SizeOf(pmc) ;     //(SIZE_T)-1
  if GetProcessMemoryInfo(GetCurrentProcess, @pmc, SizeOf(pmc)) then
    SetProcessWorkingSetSize( GetCurrentProcess(), $ffffffff, $ffffffff);
end;

Open in new window

I test it in the test VCL form application (not the service), and this is the result
I run the EXE file = memory about 5.6MB
I clicked on the button which contain call to query execute and call to this function...
The test loop query run = memory about 6.3 MB
This function run the memory reduces to about 950KB (amazing)

keep the EXE running, I clicked again on the button to run the query, the memory during execution reach to about 15MB, then dropped bellow 1MB

so my question is there any effect on the service using this function... knowing as a service the speed is not much important than the memory.

another solution I think about, but I do not know if it solve the problem, which is
Create a thread, then excuse all my functions within the thread, then terminate and free the thread...
is this will solve the problem...

Any how, I will make the application as release and not debug and test what you says.
your using ADO with oracle ?
well yes, that does have issues.
the best components i have found: devart.com > odac component for delphi
hadn't noticed what you were using before.

besides that you have classic design issue performance problems

a database will just as happily handle simple queries as very complex queries
this is oracle ... the most potent database concerning complex queries !!!
why are you going to the database 3 times per employee ?

join all you need in 1 query and go the database once for all of this
i don't have your database so i can't test this

just a first attempt at joining your emplist with the notifylist :

with emp as (
  SELECT DISTINCT EAMEMID 
  from EMPATTNMST 
  where EAMCALCSTATUS = 1
     AND NOT EAMEMID IN (SELECT EMID FROM VSRVCEMPLIST)
  order by EAMEMID)
select emp.EAMEMID, count(nt.rowid) num_policyrecs
from emp, VEMPNOTIFYLST nt 
where emp.eamemid = nt.npemid(+)
group by emp.eamemid

Open in new window

my idea on how this should be done

oracle proc with  
1 merge statement to update a table with all the empid's which need to be sent a mail
for each of that table send mail
update status of record to indicate sent mail

ps: the merge statement might be a little complex
I tried to run the code from within thread, but again, it is giving me memory leak, so till now the function "FreeingMemory" which I mention before solving the problem and it is very nice, but I do not what is the side affect of it to my service.

dear Geert Gruwez
I make the join query, but again, the memory issue still exists.
I can not use ODAC... because my application can use both MS SQL server or oracle depend on client choice, and I can not maintain to code.

I tried the same code with XE8 and Firedac, as well it seems to have the same memory leak.

So I think it is about memory management and fragmentation of memory.
ASKER CERTIFIED SOLUTION
Avatar of sarabande
sarabande
Flag of Luxembourg image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
to find a memory leak, every line of code is important
you probably can't exactly post your code, i can understand

there are bugs in the code you post here
so it is very difficult to help
Dear Geert, actually I used the EurekaLog and ReportMemoryLeaksOnShutdown, and both of them they report nothing at all.
Actually once I stop the service or close the test application, the memory come back normal.
Thank all of you for your support