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.

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.

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

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.

Do you free ObjSet too ?

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.

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 ?

ObjSet := nil; may do it.

Cheers Pritaeas

I still have the memory leak but will continue looking

Thanks for you replies

ObjSet := nil; may do it.

Be a part of the DaniWeb community

We're a friendly, industry-focused community of developers, IT pros, digital marketers, and technology enthusiasts meeting, networking, learning, and sharing knowledge.