Releasing memory after enum on iads container

Can someone please tell me why I have a gigantic memory leak in the following code? I call this function after I have read the domain name and password from a database. After it sets up 50 or so the memory is at about 500 Meg. I suspect that the leak is in the piac and pev but when I try the _release on these objects it throws an access violation.

Any help is greatly appreciated.

Sorry the code is so long. But I did not want to leave something out.

John Lindsly

Function CreateWebsite(DomainName,Password:string):String;
var
oNameSpace   : OleVariant;
piac         : IADSContainer;
oService     : OleVariant;
oWebsite     : OleVariant;
oServer      : OleVariant;
ONewDir      : OleVariant;
OVirtDir     :OleVariant;
OwebDir      :OleVariant;
pev          : IEnumVariant;
s           :String;
i           :integer;
binds       :variant;
Bind        :String;
Bind1       :variant;
Bind2       :String;
Bind3       :String;
Bind4       :String;
Thirdlevel  :String;
Done        :Boolean;
Index       :integer;
ContentPath :String;
DirectoryName : String;
FPAdminCommand : String;
Username       : string;
CommandResult  :tstringlist;
f              :textfile;
OldFiles       : String;
return         : integer;

begin
  Username:=createusername(DomainName);
  Thirdlevel:=DomainName;
  delete(ThirdLevel,pos('.',Thirdlevel),1);
  ThirdLevel:=ThirdLevel+'.isgcomm.com';
  Bind1:=':80:'+DomainName;
  Bind2:=':80:'+'www.'+DomainName;
  Bind3:=':80:'+'ftp.'+DomainName;
  Bind4:=':80:'+Thirdlevel;
  Try
    CoInitialize(nil);
    oNameSpace:=CreateOleObject('IISNamespace');
    oService:=oNameSpace.GetObject('IIsWebService', 'localhost/w3svc');
    IDispatch(oService).QueryInterface(IADSContainer, piac);
    if piac.get__NewEnum(pev) = S_OK then
      begin
        pev.Reset;
        while pev.Next(1, oServer, nil) = S_OK do
          begin
            s:=oServer.Class;
            if CompareText(s, 'IIsWebServer') = 0 then
              begin
                Binds:=oserver.serverbindings;
                For i:=0 to  VarArrayHighBound(binds,1) do
                  begin
                    Bind:=binds[i];
                    If (LowerCase(bind) = LowerCase(Bind1)) or
                       (lowercase(bind) = LowerCase(Bind2)) or
                       (lowercase(bind) = LowerCase(Bind3)) or
                       (lowercase(bind) = LowerCase(Bind4)) then
                      begin
                        form1.memo1.lines.add(datetimetostr(now())+' - '+
                        'The server bindings you specified are duplicated in another virtual web server.');
                        OVirtDir :=null;
                        oserver := null;
                        oservice := null;
                        oNameSpace:= null;
                        owebsite:=null;
                        ONewDir:=null;
                        Exit;
                      end;
                  end;
              end;
          end;
      end;
    Done:=false;
    Index:=1;
    While not done do
      begin
        Try
          begin

            oWebsite:=GetObject('IIS://localhost/W3SVC/'+inttostr(index));
            inc(index);
          end;
        except on e:exception do
          begin
            Done:=true;
          end;
        end ;
      end;
  except on e:exception do
    begin
      form1.memo1.lines.add(datetimetostr(now)+' - '+e.message);
      OVirtDir :=null;
      oserver := null;
      oservice := null;
      oNameSpace:= null;
      owebsite:=null;
      ONewDir:=null;
      Result:=e.message;
      exit;
    end;
  end;
  OVirtDir :=null;
  oserver := null;
  oNameSpace:= null;
  owebsite:=null;
  ONewDir:=null;

    try
    begin
      DirectoryName:=trim(username);
      {delete(DirectoryName,pos('.',DirectoryName),1);}
      ContentPath:=form1.HtmlRootEdit.text+'\'+DirectoryName;
      if not DirectoryExists(ContentPath) then
        if not CreateDir(ContentPath) then
          raise Exception.Create('Cannot create '+ ContentPath);
      ContentPath:=ContentPath+'\html';
      if not DirectoryExists(ContentPath) then
        if not CreateDir(ContentPath) then
          raise Exception.Create('Cannot create '+ ContentPath);
      Form1.memo1.lines.add(datetimetostr(now)+' - '+'Directory '+Contentpath+' created.');
    end;
    except on e:exception do
      begin
        form1.memo1.lines.add(datetimetostr(now)+' - '+e.message);
        form1.memo1.lines.add(datetimetostr(now)+' - '+'Error Creating Website at Index '+inttostr(index));
        OVirtDir :=null;
        oserver := null;
        oservice := null;
        oNameSpace:= null;
        owebsite:=null;
        ONewDir:=null;
        Result:=e.message;
        exit;
      end;
    end;
    try
      begin
        form1.memo1.lines.add(datetimetostr(now)+' - '+'Adding Website At Index '+inttostr(index));
        owebsite:= oservice.Create('IIsWebServer', Index);
        owebsite.SetInfo;
        form1.memo1.lines.add(datetimetostr(now)+' - '+'Added Website At Index '+inttostr(index));
        OVirtDir :=null;
        oserver := null;
        oservice := null;
        oNameSpace:= null;
        owebsite:=null;
        ONewDir:=null;
      end;
    except on e:exception do
      begin
        form1.memo1.lines.add(datetimetostr(now)+' - '+e.message);
        form1.memo1.lines.add(datetimetostr(now)+' - '+'Error Creating Website at Index '+inttostr(index));
        OVirtDir :=null;
        oserver := null;
        oservice := null;
        oNameSpace:= null;
        owebsite:=null;
        ONewDir:=null;
        Result:=e.message;
        exit;
      end;
    end;
    try
      begin
        form1.memo1.lines.add(datetimetostr(now)+' - '+'Setting Properties for website At Index '+inttostr(index));
        owebsite:=getobject('IIS://localhost/W3SVC/'+inttostr(index));
        owebsite.ServerBindings:=VarArrayOf([bind1, bind2, bind3, bind4]);
        owebsite.servercomment:=DomainName;
        owebsite.CpuLimitLogEvent := 10000;
        owebsite.CpuLimitPriority := 15000;
        owebsite.CpuLimitProcStop := 20000;
        owebsite.CpuLimitsEnabled := TRUE;
        owebsite.DefaultDoc := 'index.htm, index.html, index.cfm, '+
                               'default.htm, default.asp, 123Start.htm';
        owebsite.setinfo;
        form1.memo1.lines.add(datetimetostr(now)+' - '+'Done Setting Properties for website At Index '+inttostr(index));
      end;
      except on e:exception do
        begin
          form1.memo1.lines.add(datetimetostr(now)+' - '+e.message);
          form1.memo1.lines.add(datetimetostr(now)+' - '+'Error getting Object IIS://localhost/W3SVC/'+inttostr(index));
          OVirtDir :=null;
          oserver := null;
          oservice := null;
          oNameSpace:= null;
          owebsite:=null;
          ONewDir:=null;
          Result:=e.message;
          exit;
        end;
      end;
      try
        begin
          form1.memo1.lines.add(datetimetostr(now)+' - '+'Creating Virtual Directoy for website At Index '+inttostr(index));
          ONewDir:=oWebsite.Create('IIsWebVirtualDir', 'ROOT');
          ONewDir.Path := ContentPath;
          ONewDir.AccessRead := true;
          ONewDir.AppCreate(True);
          ONewDir.SetInfo ;
          ONewDir.AppFriendlyName := DomainName+ ' Application';
          ONewDir.AccessFlags:=515;
          ONewDir.AccessScript:=TRUE;
          ONewDir.AccessWrite:=TRUE;
          ONewDir.AppIsolated:=2;
          ONewDir.SetInfo;
          form1.memo1.lines.add(datetimetostr(now)+' - '+'Done Creating Virtual Directoy for website At Index '+inttostr(index));
          ONewDir:=null;
        end;
      except on e:exception do
        begin
          form1.memo1.lines.add(datetimetostr(now)+' - '+e.message);
          form1.memo1.lines.add(datetimetostr(now)+' - '+'Error setting root directory');
          OVirtDir :=null;
          oserver := null;
          oservice := null;
          oNameSpace:= null;
          owebsite:=null;
          ONewDir:=null;
          Result:=e.message;
          exit;
        end;
      end;
      try
        begin
          Owebsite.start;
          OVirtDir :=null;
          oserver := null;
          oservice := null;
          oNameSpace:= null;
          owebsite:=null;
          ONewDir:=null;
        end;
      except on e:exception do
        begin
          form1.memo1.lines.add(datetimetostr(now)+' - '+e.message);
          form1.memo1.lines.add(datetimetostr(now)+' - '+'Error Starting Website');
          OVirtDir :=null;
          oserver := null;
          oservice := null;
          oNameSpace:= null;
          owebsite:=null;
          ONewDir:=null;
          Result:=e.message;
          exit;
        end;
      end;
      Try
        begin
          try
            begin
              Form1.NetUser1.UserName:=UserName;
              Form1.NetUser1.GetLevel20Info;
            end;
          except on e:exception do
            begin
              form1.memo1.lines.add(datetimetostr(now)+' - '+e.message);
              Form1.memo1.lines.Add(datetimetostr(now)+' - '+'Creating User '+Username+'.');
              Form1.NetUser1.UserName:=UserName;
              Form1.Memo1.lines.add(Password);
              Form1.NetUser1.CreateAccount(Username,Password);
              Form1.NetUser1.AddToLocalGroup('users');
              Form1.NetUser1.Flags:=[ufPasswordCantChange,ufDontExpirePassword];
              Form1.memo1.lines.Add(datetimetostr(now)+' - '+'User '+Username+' Created.');
            end;
          end;
        end;
      except on e:exception do
        begin
          form1.memo1.lines.add(datetimetostr(now)+' - '+e.message);
          form1.memo1.lines.add(datetimetostr(now)+' - '+'Error creating user');
          OVirtDir :=null;
          oserver := null;
          oservice := null;
          oNameSpace:= null;
          owebsite:=null;
          ONewDir:=null;
          Result:=e.message;
          exit;
        end;
      end;
      try
        begin
          CommandResult:= tstringlist.Create;
          AssignFile(f,'c:\fpoutput.txt');
          rewrite(f);
          closefile(f);
          FPadminCommand:='C:\Program Files\Common Files\Microsoft Shared\'+
                            'Web Server Extensions\40\bin\';
          FPAdminCommand:=FPAdminCommand+'fpsrvadm.exe -o install -t msiis -m www.'+DomainName+' -u '+Username+
              ' -a authors > c:\fpoutput.txt';
          form1.memo1.lines.add(datetimetostr(now)+' - '+FPAdminCommand);
          Form1.zcRunProg1.CmdLine:=FPAdminCommand;
          Form1.memo1.lines.Add(datetimetostr(now)+' - '+'Installing FrontPage Extensions.');
          Form1.zcRunProg1.Run;
          CommandResult.Clear;
          CommandResult.LoadFromFile('c:\fpoutput.txt');
          Form1.memo1.lines.AddStrings(CommandResult);
          Form1.Memo1.lines.add(datetimetostr(now)+' - Return Code '+inttostr(Form1.zcRunProg1.returncode));
          Form1.memo1.lines.Add(datetimetostr(now)+' - '+'Done Installing FrontPage Extensions.');
          Form1.memo1.lines.add(' ');
          CommandResult.free;
        end;
      except on e:exception do
        begin
          form1.memo1.lines.add(datetimetostr(now)+' - '+e.message);
          form1.memo1.lines.add(datetimetostr(now)+' - '+'Error Installing FrontPage Extensions');
          OVirtDir :=null;
          oserver := null;
          oservice := null;
          oNameSpace:= null;
          owebsite:=null;
          ONewDir:=null;
          Result:=e.message;
          exit;
        end;
      end;

        {Configure _vti_bin}
      try
        begin
          form1.memo1.lines.add(datetimetostr(now)+' - '+'Setting _vti_bin Auth');
          OvirtDir := null;
          OvirtDir:=getobject('IIS://localhost/W3SVC/'+inttostr(index)+
                                '/root/_vti_bin');
          OvirtDir.AuthAnonymous := FALSE;
          OvirtDir.AuthFlags := 4;
          OvirtDir.AccessExecute := False;
          OvirtDir.AuthBasic := TRUE ;
          OvirtDir.AccessFlags := 517 ;
          OvirtDir.SetInfo;
          form1.memo1.lines.add(datetimetostr(now)+' - '+'Done Configuring _vti_bin For '+DomainName+
                            ' Index- '+inttostr(index));
        end;
      except on e:exception do
        begin
          form1.memo1.lines.add(datetimetostr(now)+' - '+e.message);
          form1.memo1.lines.add(datetimetostr(now)+' - '+'Error Connecting To _vti_bin');
          OVirtDir :=null;
          oserver := null;
          oservice := null;
          oNameSpace:= null;
          owebsite:=null;
          ONewDir:=null;
          Result:=e.message;
          exit;
        end;
      end;



{Configure fpcount.exe (this guy isn't in the Metabase until he is changed from his parent)
       The metabase only contains entries when they differ from the parent
      The following creates the metabase entry, not the file }

      try
        begin
          form1.memo1.lines.add(datetimetostr(now)+' - '+'Setting FPCount Auth');
          OwebDir := null;
          OwebDir := OvirtDir.Create('IISWebDirectory', 'fpcount.exe');
          OwebDir.AuthAnonymous := TRUE;
          OwebDir.AuthFlags := 5;
          OwebDir.SetInfo;
          form1.memo1.lines.add(datetimetostr(now)+' - '+'Done Configuring FPCount For '+DomainName+
                            ' Index- '+inttostr(index));
        end;
      except on e:exception do
        begin
          form1.memo1.lines.add(datetimetostr(now)+' - '+e.message);
          form1.memo1.lines.add(datetimetostr(now)+' - '+'Error Creating FPCount.exe');
          Owebdir:=null;
          OVirtDir :=null;
          oserver := null;
          oservice := null;
          oNameSpace:= null;
          owebsite:=null;
          ONewDir:=null;
          Result:=e.message;
          exit;
        end;
      end;


 {Configure shtml.dll }

      try
        begin
          form1.memo1.lines.add(datetimetostr(now)+' - '+'Setting shtml Auth');
          OwebDir := null;
          OwebDir := OvirtDir.Create('IISWebDirectory', 'shtml.dll');
          OwebDir.AuthAnonymous := TRUE;
          OwebDir.AuthFlags := 5;
          OwebDir.SetInfo;
          form1.memo1.lines.add(datetimetostr(now)+' - '+'Done Configuring shtml For '+DomainName+
                            ' Index- '+inttostr(index));
        end;
      except on e:exception do
        begin
          form1.memo1.lines.add(datetimetostr(now)+' - '+e.message);
          form1.memo1.lines.add(datetimetostr(now)+' - '+'Error Creating shtml.exe');
          Owebdir:=null;
          OVirtDir :=null;
          oserver := null;
          oservice := null;
          oNameSpace:= null;
          owebsite:=null;
          ONewDir:=null;
          Result:=e.message;
          exit;
        end;
      end;


{ Configure cgi-bin }
      try
        begin
          form1.memo1.lines.add(datetimetostr(now)+' - '+'Setting CGI_bin Auth');
          OvirtDir := null;
          OvirtDir:=getobject('IIS://localhost/W3SVC/'+inttostr(index)+
                                '/root');
          OwebDir := OvirtDir.Create('IISWebDirectory', 'cgi-bin');
          OwebDir.AccessExecute := TRUE;
          OwebDir.AccessFlags := 517;
          OwebDir.SetInfo;
          form1.memo1.lines.add(datetimetostr(now)+' - '+'Done Configuring CGI_bin For '+DomainName+
                            ' Index- '+inttostr(index));
          OvirtDir := null;
          OwebDir:= null;
          Result:='Success';
        end;
      except on e:exception do
        begin
          form1.memo1.lines.add(datetimetostr(now)+' - '+e.message);
          form1.memo1.lines.add(datetimetostr(now)+' - '+'Error Creating CGI_bin');
          Owebdir:=null;
          OVirtDir :=null;
          oserver := null;
          oservice := null;
          oNameSpace:= null;
          owebsite:=null;
          ONewDir:=null;
          Result:=e.message;
          exit;
        end;
      end;
      if Form1.CheckBox1.Checked then
        begin
          Try
            begin
              If Form1.OldFileEdit.text <> '' then
                begin
                  if Form1.CheckBox2.Checked then
                    OldFiles:=lowercase(Form1.oldfileEdit.text+'\'+
                                        CreateDirectoryname(Domainname)+'\html')
                  else
                    OldFiles:=lowercase(Form1.oldfileEdit.text+'\'+directoryname+'\html');
                  if DirectoryExists(OldFiles) then
                    begin
                      Form1.memo1.lines.add(datetimetostr(now)+' - Beginning file copy from '+
                                            OldFiles);
                      Form1.memo1.lines.add(inttostr(CopyTree(oldFiles,ContentPath)));
                      Form1.memo1.lines.add(datetimetostr(now)+' - Finished file copy from '+
                                            OldFiles);
                    end
                  Else
                    Raise Exception.Create('Old Files Directory Does Not Exist');
                end
              else
                Raise Exception.Create('No Path To Old Files Found');
            end;
          except on e:exception do
            begin
              Form1.memo1.lines.add(e.message);
            end;
          end;
        end;
  Owebdir:=null;
  OVirtDir :=null;
  oserver := null;
  oservice := null;
  oNameSpace:= null;
  owebsite:=null;
  ONewDir:=null;
  Result:='Success';

end;


jtl12Asked:
Who is Participating?

Improve company productivity with a Business Account.Sign Up

x
 
MadshiConnect With a Mentor Commented:
P.S: On which OS are you testing your procedure? NT4? Can you try it under win2k? Or even better under winXP?
0
 
DragonSlayerCommented:
hi jtl12,

While I'm not providing a solution to your problem, I'd like to comment a bit on your setting of OLEObjects to null in your try .. except clauses. IMHO, it is always a better idea to put it in a try .. finally clause, so that regardless of whether or not there is an exception, the code will be executed.


DragonSlayer.
0
 
rwilson032697Commented:
As your objects are all defined locally you shouldn't need to assign null to them at all, they will be destroyed when they go out of scope at the end of the function. This may make the code a lot easier to read.

Oen quick point: CoInitialize() only needs to be called once per thread (so I assume this function is called only once in the lifetime of the thread?) You should also call COUninitialise() when you have done with it.

Cheers,

Raymond.
0
Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

 
MadshiCommented:
Wow, what a big code. I've no time to check it over. Can't you split it in smaller parts to find out which part is responsible for the leak? BTW, I agree with Raymond.

Regards, Madshi.
0
 
jtl12Author Commented:
Thanks guys. I will break the code down and try to narrow the problem down. I believe though that it is because i am unable to release the Iadscontainer object,piac and the pev object.


Thanks again

John Lindsly
0
 
jtl12Author Commented:
Ok guys. I narrowed it down to this function. When I call this function over and over again with a new domainname, the memory  starts climbing and does not stop. I suspect that I need to do a piac._release. But when I do, I get an access violation.

Function CheckForDup(DomainName:string):String;
var
oNameSpace   : OleVariant;
piac         : IADSContainer;
oService     : OleVariant;
oServer      : OleVariant;
pev          : IEnumVariant;
S            : string;
Binds        : Variant;
i            : integer;
bind         : String;
Bind1        : string;
Bind2        : String;
Bind3        : String;
Bind4        : String;
ThirdLevel   : string;
begin
  Thirdlevel:=DomainName;
  delete(ThirdLevel,pos('.',Thirdlevel),1);
  ThirdLevel:=ThirdLevel+'.isgcomm.com';
  Bind1:=':80:'+DomainName;
  Bind2:=':80:'+'www.'+DomainName;
  Bind3:=':80:'+'ftp.'+DomainName;
  Bind4:=':80:'+Thirdlevel;
  Try
    CoInitialize(nil);
    oNameSpace:=CreateOleObject('IISNamespace');
    oService:=oNameSpace.GetObject('IIsWebService', 'localhost/w3svc');
    IDispatch(oService).QueryInterface(IADSContainer, piac);
    if piac.get__NewEnum(pev) = S_OK then
      begin
        pev.Reset;
        while pev.Next(1, oServer, nil) = S_OK do
          begin
            s:=oServer.Class;
            if CompareText(s, 'IIsWebServer') = 0 then
              begin
                Binds:=oserver.serverbindings;
                For i:=0 to  VarArrayHighBound(binds,1) do
                  begin
                    Bind:=binds[i];
                    If (LowerCase(bind) = LowerCase(Bind1)) or
                       (lowercase(bind) = LowerCase(Bind2)) or
                       (lowercase(bind) = LowerCase(Bind3)) or
                       (lowercase(bind) = LowerCase(Bind4)) then
                      begin
                        form1.memo1.lines.add(datetimetostr(now())+' - '+
                        'The server bindings you specified are duplicated in another virtual web server.');
                        Exception.Create('The server bindings you specified are '+
                                         'duplicated in another virtual web server.');
                        Exit;
                      end;
                  end;
              end;
          end;
      end;
  except on e:exception do
    begin
      form1.memo1.lines.add(datetimetostr(now)+' -                            '+e.message);
      Result:=e.message;
      CoUninitialize;
      exit;
    end;
  end;
  CoUninitialize;

end;
0
 
jtl12Author Commented:
Ok guys. I narrowed it down to this function. When I call this function over and over again with a new domainname, the memory  starts climbing and does not stop. I suspect that I need to do a piac._release. But when I do, I get an access violation.

Function CheckForDup(DomainName:string):String;
var
oNameSpace   : OleVariant;
piac         : IADSContainer;
oService     : OleVariant;
oServer      : OleVariant;
pev          : IEnumVariant;
S            : string;
Binds        : Variant;
i            : integer;
bind         : String;
Bind1        : string;
Bind2        : String;
Bind3        : String;
Bind4        : String;
ThirdLevel   : string;
begin
  Thirdlevel:=DomainName;
  delete(ThirdLevel,pos('.',Thirdlevel),1);
  ThirdLevel:=ThirdLevel+'.isgcomm.com';
  Bind1:=':80:'+DomainName;
  Bind2:=':80:'+'www.'+DomainName;
  Bind3:=':80:'+'ftp.'+DomainName;
  Bind4:=':80:'+Thirdlevel;
  Try
    CoInitialize(nil);
    oNameSpace:=CreateOleObject('IISNamespace');
    oService:=oNameSpace.GetObject('IIsWebService', 'localhost/w3svc');
    IDispatch(oService).QueryInterface(IADSContainer, piac);
    if piac.get__NewEnum(pev) = S_OK then
      begin
        pev.Reset;
        while pev.Next(1, oServer, nil) = S_OK do
          begin
            s:=oServer.Class;
            if CompareText(s, 'IIsWebServer') = 0 then
              begin
                Binds:=oserver.serverbindings;
                For i:=0 to  VarArrayHighBound(binds,1) do
                  begin
                    Bind:=binds[i];
                    If (LowerCase(bind) = LowerCase(Bind1)) or
                       (lowercase(bind) = LowerCase(Bind2)) or
                       (lowercase(bind) = LowerCase(Bind3)) or
                       (lowercase(bind) = LowerCase(Bind4)) then
                      begin
                        form1.memo1.lines.add(datetimetostr(now())+' - '+
                        'The server bindings you specified are duplicated in another virtual web server.');
                        Exception.Create('The server bindings you specified are '+
                                         'duplicated in another virtual web server.');
                        Exit;
                      end;
                  end;
              end;
          end;
      end;
  except on e:exception do
    begin
      form1.memo1.lines.add(datetimetostr(now)+' -                            '+e.message);
      Result:=e.message;
      CoUninitialize;
      exit;
    end;
  end;
  CoUninitialize;

end;
0
 
MadshiCommented:
>> I suspect that I need to do a piac._release.

No, you don't. Delphi does that for you automatically...

I'm not sure about this line:

  IDispatch(oService).QueryInterface(IADSContainer, piac);

Probably it's correct, I just never saw anything like that.

Are you sure that the memory usage *really* increases? How do you see that? In the NT/2k/XP task manager? Then please minimize your Delphi application and restore it again. Perhaps the memory comes back. Ask "AllocMemSize", does it increase, too?

Regards, Madshi.
0
 
jtl12Author Commented:
Do you mena call AllocMemSize from the code?
and I am checking the mem usage in the processes tab in task manager. I am sure it is increasing because it will eventually get to over a gig and bring the server to its knees. However, I will try to use the AllocMemSize to get you a more accurate representation of what is happening.

0
 
jtl12Author Commented:
I put an allocmemsize int the code right after the counitialize and then in the calling function after it returns. This is what I got after letting it run a few times.

In Function26900
After Function 26360
 
In Function26792
After Function 26288
 
In Function26796
After Function 26292
 
In Function26912
After Function 26300
 
In Function26792
After Function 26288
 
It appears to not be climbing. Meanwhile however, the process in task man is steady climing past 30 meg.

0
 
MadshiCommented:
As I said in my previous comment, minimize your program and restore it again. Does the memory usage go back?
0
 
jtl12Author Commented:
Yes when I min and restore the memory goes back to roughly where it was. However, I no longer think that it is climbing without bounds in that function anymore. I am going to let it do some more tasks and see what happens. I think you may have solved my problem by making me break the code up into smaller section. If so I am very embarrassed because I learned that back in college quite a while ago.
0
 
jtl12Author Commented:
I am sorry. I must correct my self. It appears that when i minamize and then restore the app it comes back using quite a bit less mem.
0
 
MadshiCommented:
Yeah, this minimize/restore thingy is quite strange, I can't explain it myself. I guess, someone cleans up all the memory stuff when you minimize/restore your application. I don't know whether it's Windows or Delphi, I guess it's Windows.
So you should do this:
(1) Start your app, minimize and restore it. Look at task manager. Write down the memory usage.
(2) Call your memory leak function several times.
(3) Go to step (1).

Repeat that until you're sure whether your memory leak function really has a memory leak. If it does not, then the question remains: How can we force that memory cleaning without having to minimize/restore the application. Do you agree with that?

Regards, Madshi.
0
 
MadshiCommented:
Ehm, revised steps:

(1) Start your app.
(2) Minimize and restore it. Look at task manager. Write down the memory usage.
(3) Call your memory leak function several times.
(4) Go to step (2).
0
 
jtl12Author Commented:
Madshi

I was going to ask you. Do you think that since I am calling this function from a timer, it could be causing the memory to not be released?

JT
0
 
MadshiCommented:
I don't think so.
0
 
jtl12Author Commented:
I was just about to get on and tell you that the answer to my question was no. I called the function by pushing a button intead of with the timer and it did the same thing. I have further verified that when you minimize the app it gives the memory back. However, if you let it run minimized, the memory still adds up. It appears to be the transition to minimized that releases the memory.

JT
0
 
MadshiCommented:
To make sure whether it's Delphi's fault or Windows' fault, you could try the following unit, it's written by AvonWyss, another expert here in the Delphi forum. It replaces Delphi's standard memory manager with pure Windows' APIs. This is NOT recommended on win9x and NT4, because there those Windows APIs were not quite optimized enough, so they didn't perform too well, especially in multithreaded application. However, in win2k Microsoft optimized them a lot, so under win2k it's a real alternative.

Regards, Madshi.

unit BSMemMgr;

interface

uses
 Windows;

implementation

function GetMem(Size: Integer): Pointer;
begin
 Result:=HeapAlloc(GetProcessHeap,0,Size);
end;

function FreeMem(P: Pointer): Integer;
begin
 Result:=1-Ord(HeapFree(GetProcessHeap,0,P));
end;

function ReallocMem(P: Pointer; Size: Integer): Pointer;
begin
 Result:=HeapRealloc(GetProcessHeap,0,P,Size);
end;

procedure Install;
var
 Mgr: TMemoryManager;
begin
 Mgr.GetMem:=GetMem;
 Mgr.FreeMem:=FreeMem;
 Mgr.ReallocMem:=ReallocMem;
 SetMemoryManager(Mgr);
end;

initialization
 Install;
finalization
end.
0
 
jtl12Author Commented:
I am sorry madshi, but I do not know how to use this unit. Do I just put it in my uses or do I need to call it somehow.

JT
0
 
MadshiCommented:
I'm sorry, I should have said that. You should put this unit into the uses clause of your project file (*.dpr) at the very first position.

Program BlaBla;

uses
  BSMemMgr,
  [...];

begin
  Application.Initialize;
  Application.CreateForm(...);
  [...];
  Application.Run;
end.

Regards, Madshi.
0
 
jtl12Author Commented:
When I do that it will run through the ide but when I try to run the app outside of the IDE I get an invalid pointer exception. Any Ideas.

JT
0
 
jtl12Author Commented:
By the way, do you know why I am unable to cal piac._release with out causing an access violation. I wanted to just try to force a release of the object but I can not.

JT
0
 
jtl12Author Commented:
By the way, do you know why I am unable to cal piac._release with out causing an access violation. I wanted to just try to force a release of the object but I can not.

JT
0
 
rwilson032697Commented:
You should assign nil to it rather than calling _Release. Interfaces are reference counted so it will be destroyed automatically.

Cheers,

Raymond.
0
 
jtl12Author Commented:
Madshi,
When I put BSMemMgr as the first unit in uses, it still only runs from indise the IDE. Outside the IDE I get an invalid pointer error.

rwilson,
Thank you for the help with the assigning nil to the piac var. That no longer caused an error but it still did not release the memory.

It still will only release the memory when I minimize the app. I can not figure out what happens when I minimize the app that would cause the memory to be returned.

JT
0
 
MadshiCommented:
>> When I do that it will run through the ide but when I try to run the app outside of the IDE I get an invalid pointer exception. Any Ideas.

Try this unit, I've worked over it a bit, maybe it runs better. At least it works fine for me.

If it still does not work properly, then please show me your project's (dpr file) full source code.

Regards, Madshi.
0
 
MadshiCommented:
unit winMM;

interface

{$Q-}{$R-}

implementation

uses Windows;

var MmHeap : dword;

function GetMem(size: integer) : pointer;
begin
  result := HeapAlloc(MmHeap, 0, size);
end;

function FreeMem(p: pointer) : integer;
begin
  if HeapFree(MmHeap, 0, p) then result := 0
  else                           result := 1;
end;

function ReallocMem(p: Pointer; size: integer) : pointer;
begin
  result := HeapRealloc(MmHeap, 0, p, size);
end;

var mm: TMemoryManager;
initialization
  MmHeap        := GetProcessHeap;
  mm.GetMem     := GetMem;
  mm.FreeMem    := FreeMem;
  mm.ReallocMem := ReallocMem;
  SetMemoryManager(mm);
end.
0
 
jtl12Author Commented:
Madshi

Thanks for al th help. That new unit did run fine. However, we have the same thing going on with the memory. I am going to post the function that I am running now just to make sure we are on the same page. I am just pushing this button over and over again and the memory keeps climbing. I will also post the dpr file to make sure I did what you wanted me to.

JT
0
 
jtl12Author Commented:
Function CheckForDup(DomainName:string):String;
var
{oNameSpace   : OleVariant;}
piac         : IADSContainer;
oService     : OleVariant;
oServer      : OleVariant;
pev          : IEnumVariant;
S            : string;
Binds        : Variant;
i            : integer;
bind         : String;
Bind1        : string;
Bind2        : String;
Bind3        : String;
Bind4        : String;
ThirdLevel   : string;
begin
  Thirdlevel:=DomainName;
  delete(ThirdLevel,pos('.',Thirdlevel),1);
  ThirdLevel:=ThirdLevel+'.isgcomm.com';
  Bind1:=':80:'+DomainName;
  Bind2:=':80:'+'www.'+DomainName;
  Bind3:=':80:'+'ftp.'+DomainName;
  Bind4:=':80:'+Thirdlevel;
  Try
    CoInitialize(nil);
    {oNameSpace:=CreateOleObject('IISNamespace');
    oService:=oNameSpace.GetObject('IIsWebService', 'localhost/w3svc');}
    oService:=GetObject('IIS://localhost/W3SVC');
    IDispatch(oService).QueryInterface(IADSContainer, piac);
    if piac.get__NewEnum(pev) = S_OK then
      begin
        pev.Reset;
        while pev.Next(1, oServer, nil) = S_OK do
          begin
            s:=oServer.Class;
            if CompareText(s, 'IIsWebServer') = 0 then
              begin
                Binds:=oserver.serverbindings;
                For i:=0 to  VarArrayHighBound(binds,1) do
                  begin
                    Bind:=binds[i];
                    If (LowerCase(bind) = LowerCase(Bind1)) or
                       (lowercase(bind) = LowerCase(Bind2)) or
                       (lowercase(bind) = LowerCase(Bind3)) or
                       (lowercase(bind) = LowerCase(Bind4)) then
                      begin
                        form1.memo1.lines.add(datetimetostr(now())+' - '+
                        'The server bindings you specified are duplicated in another virtual web server.');
                        Exception.Create('The server bindings you specified are '+
                                         'duplicated in another virtual web server.');
                        Result:='Failure';
                        Exit;
                      end;
                  end;
              end;
          end;
        Result:='Success';
      end;
  except on e:exception do
    begin
      form1.memo1.lines.add(datetimetostr(now)+' - '+e.message);
      Result:=e.message;
      pev:=nil;
      CoUninitialize;
      exit;
    end;
  end;
  CoUninitialize;
  {Form1.memo1.lines.add('In Function'+inttostr(allocmemsize));}
end;
0
 
jtl12Author Commented:
program IISSetup;

uses
  winmm,
  Forms,
  Unit1 in 'Unit1.pas' {Form1},
  ActiveDs_TLB in '..\..\..\..\Program Files\Borland\Delphi5\Imports\ActiveDs_TLB.pas';

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.
0
 
MadshiCommented:
So, finally we found out that Windows' memory manager itself is the guilty one. If I only knew how to fix this (I do not). The problem for me is that I can't run your procedure, cause I don't have those OLE objects on my machine...   :-(   Perhaps you could try further shorting your procedure. Maybe it's only the order of the allocations/deallocations that makes problems. Maybe you can make it all better by avoiding all those mega-automatic Delphi allocations (that happen all the time when using Delphi's dynamic strings). Please don't get me wrong. I'm very sure that this is no Delphi problem. But I guess you need a way to get around this Windows' problem, so maybe you have to play a bit with your code, change the order etc...

Regards, Madshi.
0
 
jtl12Author Commented:
I am testing it under win 2k on about 5 different machines. I have not tried it on 4.0 or xp but I will today and let you know.

Thank You
JT
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.