# 整理内存的API函数是什么?马上结贴.谢谢

gccr 人人贷 服务器端工程师  2006-02-22 11:47:40

...全文
219 5 打赏 收藏 举报

5 条回复

ly_liuyang 2006-02-22
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
pushfd
mov edi, p
mov ecx, 1024*1024/4
xor eax, eax
cld
repz stosd
popfd
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;
• 打赏
• 举报

GARNETT2183 2006-02-22

• 打赏
• 举报

gccr 2006-02-22

if Win32Platform = VER_PLATFORM_WIN32_NT then
begin
SetProcessWorkingSetSize(GetCurrentProcess, \$FFFFFFFF, \$FFFFFFFF);
application.ProcessMessages;
end;
• 打赏
• 举报

sdzeng 2006-02-22
http://www.delphibbs.com/delphibbs/dispq.asp?lid=1606059
• 打赏
• 举报

cuteant 2006-02-22
mark
• 打赏
• 举报

1168

Delphi Windows SDK/API

2006-02-22 11:47