导航

心动吧DELPHI网络书

自发研究:须要多维思想而且要想不可能为可能的人才能做到

« [原创]明生小记之delphi错误处理Delphi 替换和安装新svchost服务 »

Delphi清理释放本程序内存的代码

在WinXp,Win2K中应用此方法,不显示主窗体一直运行的程序最佳。以前程序占用11M内存,我用动态创建窗口的方法只能减少不到100K,应用此方法后内存占用只有496K。把下面的过程放到一个Timer中,每隔一段时间执行一次,如30秒。

{

************************************

* Clear Memory

* From Muse2008

************************************

}


procedure ClearMemory;

begin

        if Win32Platform = VER_PLATFORM_WIN32_NT then

        begin

                SetProcessWorkingSetSize(GetCurrentProcess, $FFFFFFFF, $FFFFFFFF);

                Application.ProcessMessages;

        end;

end;

 

procedure DefragMemory(MemoryLimit:Integer);

var

Pointers : Array [0..1024] of Pointer;

Limit ,

I2,

I : Integer;

P : Pointer;

Step : Integer;

Steps : Integer;

begin

FAbort := False;

If FWorking then Exit;

FWorking:=True;

Limit:=MemoryLimit;

If Limit>1024 then Limit:=1024;

If Assigned(FOnBeforeDefrag) then FOnBeforeDefrag(Self);

{ Calculating how many steps...}

Steps:=(MemoryLimit*2);



Step:=0;



{ Clean pointer...}

For I:= 0 to Limit do Pointers[I]:=nil;



{ Allocating Memory }

For I:=0 to Limit-1 do

Begin

P:=VirtualAlloc(nil, 1024*1024, MEM_COMMIT, PAGE_READWRITE + PAGE_NOCACHE);

Pointers[I]:=p;

asm

pushad

pushfd

mov edi, p

mov ecx, 1024*1024/4

xor eax, eax

cld

repz stosd

popfd

popad

end;

Inc(Step);

If Assigned(FOnProgress) then OnProgress(Self,Round((Step/Steps)*100));

If FAbort then

Begin

For I2:=0 to I do

Begin

VirtualFree(Pointers[I2], 0, MEM_RELEASE);

End;

Step:=(MemoryLimit*2);

FWorking:=False;

If Assigned(FOnAfterDefrag) then FOnAfterDefrag(Self);

Exit;

End;

end;



{ DeAllocating Memory }



For I:=0 to Limit-1 do

Begin

VirtualFree(Pointers[i], 0, MEM_RELEASE);

Inc(Step);

If Assigned(FOnProgress) then OnProgress(Self,Round((Step/Steps)*100));

If FAbort then

Begin

{ Warning! : Force abort, w/o de-allocating memory }

Step:=(MemoryLimit*2);

FWorking:=False;

If Assigned(FOnAfterDefrag) then FOnAfterDefrag(Self);

Exit;

End;

End;



FWorking:=False;



If Assigned(FOnAfterDefrag) then FOnAfterDefrag(Self);

End;

 

原创文章如转载,请注明:转载自心动吧DELPHI网络书 [ http://www.abcxd.com/delphi/ ]

本文链接地址:http://www.abcxd.com/delphi/abcxddelphi/delphiMemo/385.html

发表评论:

◎欢迎参与讨论,请在这里发表您的看法、交流您的观点。

热文排行使用

本年排行使用

本月排行使用

网站分类

搜索内容

最新评论及回复

最近发表

所属分类下的文章

日历

Copyright ⊙ 2004-2009 心动吧 UrL:ABCXD.CoM All RiGhts Reserved