Delphi 7 WMI - Memory Leak

[NotNil]

I am experimenting with the use of WMI from within Delphi. Appears quite simple really however I am running into a problem where the amount of memory used by my application keeps growing. In my sample code below the SendPing() function is executed once every second by a TTimer.... each time SendPing is called between 30KB and 100KB is consumed by the application and not released.

Has anyone seen this happen before. Am I doing something wrong in my code??

Any ideas would be great :)

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, ActiveX, WbemScripting_TLB;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    txtServerName: TLabeledEdit;
    txtResponse: TLabeledEdit;
    CheckBox1: TCheckBox;
    procedure Timer1Timer(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
  private
    { Private declarations }
    FPingDNSName: string;
    function SendPing: integer;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function TForm1.SendPing: integer;
var  // WMI Query Variables
  Locator:  ISWbemLocator;
  Services: ISWbemServices;
  SObject:  ISWbemObject;
  ObjSet:   ISWbemObjectSet;
  SProp:    ISWbemProperty;
  Enum:     IEnumVariant;
  Value:    Cardinal;
  TempObj:  OleVariant;

  KN: string;
  WMI_PROPERTIES: string;
  WMI_CLASS: string;
begin
  WMI_PROPERTIES := 'ResponseTime';
  WMI_CLASS := 'Win32_PingStatus';

  try
    //CoInitializeEx(nil, COINIT_APARTMENTTHREADED);
    CoInitialize(nil);
    Locator := CoSWbemLocator.Create;
    Services :=  Locator.ConnectServer('.', 'root\cimv2', '', '', '','', 0, nil);
    ObjSet := Services.ExecQuery('SELECT ' + WMI_PROPERTIES + ' FROM ' + WMI_CLASS + ' WHERE ADDRESS=''' + FPingDNSName + '''', 'WQL', wbemFlagReturnImmediately and wbemFlagForwardOnly , nil);
    Enum := (ObjSet._NewEnum) as IEnumVariant;

    while (Enum.Next(1, TempObj, Value) = S_OK) do
    begin
      SObject := IUnknown(tempObj) as ISWBemObject;
      KN := 'ResponseTime';
      SProp := SObject.Properties_.Item(KN, 0);

      if VarIsNull(SProp.Get_Value) then
        Result := 99999
      else
        Result := Integer(SProp.Get_Value);
    end;
    CoUninitialize;
  except // Trap any exceptions
    on exception do
    begin
      Result := 99999;
      CoUninitialize;
    end;
  end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  ResponseTime: integer;
begin
  Timer1.Enabled := false;
  FPingDNSName := Trim(txtServerName.text);
  ResponseTime := SendPing;
  txtResponse.Text := inttostr(ResponseTime);
  Timer1.Enabled := true;
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  if CheckBox1.Checked then
    Timer1.Enabled := true
  else
    Timer1.Enabled := false;
end;

end.

[pritaeas]

CoInitialize(nil); need only be called once. I suggest you move it to the initialization section.

You create a new locator everytime, but it is not free'd. Perhaps creating it once will suffice.

[NotNil]

Just for interest sake I tried the same WMI query using Visual Basic and also C#

I get the same memory leak from both these languages as well - maybe the issue is with Microsoft WMI??

I am running 32Bit Windows 7 professional and have also tested on Windows XP Professional SP3 - same problem for both Operating Systems

[NotNil]

Many thanks for the tip :)

So I tried it and the result is better I now only have a constant 24KB leak on each call to SendPing.

Is still leaking however..... is there anything else you can tell me?

CoInitialize(nil); need only be called once. I suggest you move it to the initialization section.

You create a new locator everytime, but it is not free'd. Perhaps creating it once will suffice.

[pritaeas]

Do you free ObjSet too ?

[NotNil]

Cheers pritaeus

My modified code is as below:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, ActiveX, WbemScripting_TLB;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    txtServerName: TLabeledEdit;
    txtResponse: TLabeledEdit;
    CheckBox1: TCheckBox;
    procedure Timer1Timer(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    Locator:  ISWbemLocator;
    Services: ISWbemServices;
    LocatorExists: boolean;

    FPingDNSName: string;
    function SendPing: integer;
    procedure CreateLocator;
  public
    { Public declarations }

  end;

var
  Form1: TForm1;

implementation


{$R *.dfm}

function TForm1.SendPing: integer;
var  // WMI Query Variables
  SObject:  ISWbemObject;
  ObjSet:   ISWbemObjectSet;
  SProp:    ISWbemProperty;
  Enum:     IEnumVariant;
  Value:    Cardinal;
  TempObj:  OleVariant;

  KN: string;
  WMI_PROPERTIES: string;
  WMI_CLASS: string;
begin
  WMI_PROPERTIES := 'ResponseTime';
  WMI_CLASS := 'Win32_PingStatus';

  try
    if not LocatorExists then
      CreateLocator;

    ObjSet := Services.ExecQuery('SELECT ' + WMI_PROPERTIES + ' FROM ' + WMI_CLASS + ' WHERE ADDRESS=''' + FPingDNSName + '''', 'WQL', wbemFlagReturnImmediately and wbemFlagForwardOnly , nil);
    Enum := (ObjSet._NewEnum) as IEnumVariant;

    while (Enum.Next(1, TempObj, Value) = S_OK) do
    begin
      SObject := IUnknown(tempObj) as ISWBemObject;
      KN := 'ResponseTime';
      SProp := SObject.Properties_.Item(KN, 0);

      if VarIsNull(SProp.Get_Value) then
        Result := 99999
      else
        Result := Integer(SProp.Get_Value);
    end;

    Locator._Release;
  except // Trap any exceptions
    on exception do
    begin
      Result := 99999;
    end;
  end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  ResponseTime: integer;
begin
  Timer1.Enabled := false;
  FPingDNSName := Trim(txtServerName.text);
  ResponseTime := SendPing;
  txtResponse.Text := inttostr(ResponseTime);
  Timer1.Enabled := true;
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  if CheckBox1.Checked then
    Timer1.Enabled := true
  else
    Timer1.Enabled := false;
end;

procedure TForm1.CreateLocator;
begin
  Locator := CoSWbemLocator.Create;
  Services :=  Locator.ConnectServer('.', 'root\cimv2', '', '', '','', 0, nil);
  LocatorExists := true;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  LocatorExists := false;
end;

initialization
 CoInitialize(nil);

finalization
 CoUninitialize;

end.

CoInitialize(nil); need only be called once. I suggest you move it to the initialization section.

You create a new locator everytime, but it is not free'd. Perhaps creating it once will suffice.

[NotNil]

Hmmm..... no.....

Based on my code... assuming it is ok.... would you be able to given me an example of freeing ObjSet.

I have tryed ObjSet._Release; after while loop in SendPing function. This has no obvious effect.

Do you free ObjSet too ?

[pritaeas]

ObjSet := nil; may do it.

[NotNil]

Cheers Pritaeas

I still have the memory leak but will continue looking

Thanks for you replies

ObjSet := nil; may do it.