Solved

Releasing memory after enum on iads container

Posted on 2001-09-02
33
510 Views
Last Modified: 2010-04-06
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;


0
Comment
Question by:jtl12
  • 18
  • 12
  • 2
  • +1
33 Comments
 
LVL 14

Expert Comment

by:DragonSlayer
ID: 6449448
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
 
LVL 12

Expert Comment

by:rwilson032697
ID: 6449485
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
 
LVL 20

Expert Comment

by:Madshi
ID: 6449989
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
 

Author Comment

by:jtl12
ID: 6453797
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
 

Author Comment

by:jtl12
ID: 6455475
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
 

Author Comment

by:jtl12
ID: 6455482
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
 
LVL 20

Expert Comment

by:Madshi
ID: 6455867
>> 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
 

Author Comment

by:jtl12
ID: 6456838
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
 

Author Comment

by:jtl12
ID: 6456876
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
 
LVL 20

Expert Comment

by:Madshi
ID: 6457077
As I said in my previous comment, minimize your program and restore it again. Does the memory usage go back?
0
 

Author Comment

by:jtl12
ID: 6459364
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
 

Author Comment

by:jtl12
ID: 6459367
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
 
LVL 20

Expert Comment

by:Madshi
ID: 6459690
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
 
LVL 20

Expert Comment

by:Madshi
ID: 6459692
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
 

Author Comment

by:jtl12
ID: 6471366
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
 
LVL 20

Expert Comment

by:Madshi
ID: 6473316
I don't think so.
0
What Security Threats Are You Missing?

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

 

Author Comment

by:jtl12
ID: 6475640
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
 
LVL 20

Expert Comment

by:Madshi
ID: 6475845
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
 

Author Comment

by:jtl12
ID: 6476456
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
 
LVL 20

Expert Comment

by:Madshi
ID: 6476737
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
 

Author Comment

by:jtl12
ID: 6477219
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
 

Author Comment

by:jtl12
ID: 6477223
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
 

Author Comment

by:jtl12
ID: 6477254
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
 
LVL 12

Expert Comment

by:rwilson032697
ID: 6477900
You should assign nil to it rather than calling _Release. Interfaces are reference counted so it will be destroyed automatically.

Cheers,

Raymond.
0
 

Author Comment

by:jtl12
ID: 6478109
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
 
LVL 20

Expert Comment

by:Madshi
ID: 6478577
>> 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
 
LVL 20

Expert Comment

by:Madshi
ID: 6478578
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
 

Author Comment

by:jtl12
ID: 6480734
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
 

Author Comment

by:jtl12
ID: 6480743
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
 

Author Comment

by:jtl12
ID: 6480745
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
 
LVL 20

Expert Comment

by:Madshi
ID: 6481748
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
 
LVL 20

Accepted Solution

by:
Madshi earned 200 total points
ID: 6481750
P.S: On which OS are you testing your procedure? NT4? Can you try it under win2k? Or even better under winXP?
0
 

Author Comment

by:jtl12
ID: 6482559
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

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…
When you create an app prototype with Adobe XD, you can insert system screens -- sharing or Control Center, for example -- with just a few clicks. This video shows you how. You can take the full course on Experts Exchange at http://bit.ly/XDcourse.

707 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

17 Experts available now in Live!

Get 1:1 Help Now