内存清理工具是怎么制作的？给分100？

Question

内存清理工具是怎么制作的？用代码举例说明。

Answer 1

如何用Delphi设计内存优化程序 ( 积分：0, 回复：6, 阅读：140 )
分类：系统相关 ( 版主：luyear, zyy04 )  
来自：jingtao, 时间：2003-2-2 18:10:00, ID：1606059 [显示：小字体 | 大字体]  
<<电脑商情报>>稿件 
                          如何用Delphi设计内存优化程序
                                                     ---兼谈程序设计分析
                                                                              陈经韬   电脑启动一段时间后,因为运行了很多程序,整台电脑速度会越来越慢.为什么呢?原来很多程序运行的时候需要占用很多内存.即使程序退出后仍然无法完全释放的.那么如何找回丢失的内存呢?现在有很多这类程序,比如说<<Windows优化大师>>就带了一个<<Windows内存整理>>工具.我手头上的是V1.1版本.
   程序设计会写代码很重要.程序设计思路更重要.程序设计分析别人的思路然后归自己所有更更重要.我希望通过这篇文章让大家掌握如何分析别人的思路,这样比单纯公布思路有价值的多.
   先把话题扯远一点.木马冰河大家应该听说过吧.它的配置就很值得我们学习.一般这类软件的原理是这样的:客户端程序把信息写进服务端,服务端第一次运行的时候从自己身上读取出来保存到注册表或者INI文件里面.这样做的好处在于方便远程更新的时候直接修改注册表即可.这样做也有个致命BUG,就是别人用注册表监视器之类很容易就发现,这样一来别人就很容易知道接收者的信箱了.怎么办呢?冰河原来是采用把信息写进自己里面.但是自己怎么写进自己里面呢?我们分析一下就知道答案了.
   首先,第一步先修改注册表:在HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\WinoldApp下新建一个双字节类型的键名为Disabled键值为1的新键,其作用是禁止运行DOS程序(包括批处理文件).当然你也可以用超级兔子之类的程序来修改.第二步:配置服务端种子，我们选择安装在<TEMP>目录下(原因:文件比<windows>、<system>下都要少)，把<TEMP>目录下尽量清空，以便于我们下一步分析。
第三步：运行服务端，用客户端成功连接后远程修改配置,系统会弹出一个窗口:本次操作受限制.第四步：打开<TEMP>目录，发现除了服务端文件外，多了两个文件：NewFile.exe和sysclr.bat。击右键查看属性可以看出NewFile.exe跟服务端文件大小一样，从而知道它是服务端的备份。打开sysclr.bat，内容如下:
@echo off
:loop
del c:\windows\TEMP\NewFile.exe
if exist c:\windows\TEMP\NewFile.exe goto loop
del %0
得出结论了吧:)原来它采用的方法是先把自己拷贝为一个备份,然后对备份文件进行配置,最后用备份覆盖自己.我曾经就此写过一个演示程序http://www.138soft.com/htm/selfmodif.exe.那么说这个跟本文有什么关系呢?呵呵,我们用上面的方法来跟踪分析一下<<Windows优化大师>>的内存优化程序是怎么编写的.
  运行<<Windows内存整理>>,然后设置释放628KB内存碎片.点"整理",这时候打开进程管理器,发现系统启动了Wscript.exe程序.这个是Windows自身带的一个运行脚本的程序.当内存碎片整理完毕后,这个程序也随之退出了.我们再打开<TEMP>目录,重复上面步骤,发现整理内存的时候出现了一个memory.vbs文件.当内存碎片整理完毕后这个文件也消失了.我们用记事本打开它,内容如下:Mystring = Space(628000).把它拷贝到桌面然后运行它,效果跟运行<<Windows内存整理>>是一样的.
  通过上面分析我们完全可以写出一个一模一样的程序来了.现在就动手吧!
  运行Delphi,新建一个工程,往窗口放上两个Label,一个TrackBar1,一个Timer和一个Button.全部代码如下:

Answer 2

unit Unit1;interfaceuses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,StdCtrls, ComCtrls, ExtCtrls;type
TForm1 = class(TForm)
Button1: TButton;
TrackBar1: TTrackBar;
Label1: TLabel;
Label2: TLabel;
Timer1: TTimer;
procedure Button1Click(Sender: TObject);
procedure TrackBar1Change(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
procedure GetMemoryInfo;
function GetTempDir: string;
function CreateVbsFile(FileName:String;iKB:integer):boolean;
function WinExecAndWait32(FileName: string; Visibility: Integer): Boolean;
{ Private declarations }
public
{ Public declarations }
end;var
Form1: TForm1;implementation{$R *.DFM}
function TForm1.WinExecAndWait32(FileName: string; Visibility: Integer): Boolean; //运行一个程序并等待其关闭
var
WorkDir: string;
StartupInfo: TStartupInfo;
ProcessInfo: TProcessInformation;
begin
GetDir(0, WorkDir);
FillChar(StartupInfo, Sizeof(StartupInfo), #0);
StartupInfo.cb := Sizeof(StartupInfo);
StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
StartupInfo.wShowWindow := Visibility;
if not CreateProcess(nil,
PChar(FileName), { pointer to command line string }
nil, { pointer to process security attributes }
nil, { pointer to thread security attributes }
True, { handle inheritance flag }
CREATE_NEW_CONSOLE or { creation flags }
NORMAL_PRIORITY_CLASS,
nil, { pointer to new environment block }
PChar(WorkDir), { pointer to current directory name, PChar}
StartupInfo, { pointer to STARTUPINFO }
ProcessInfo) { pointer to PROCESS_INF }
then
Result := False {-1}
else
begin
Application.ProcessMessages;
WaitforSingleObject(ProcessInfo.hProcess, INFINITE);
CloseHandle(ProcessInfo.hProcess); { to prevent memory leaks }
CloseHandle(ProcessInfo.hThread);
Result := true;
end;
end;
function TForm1.GetTempDir: string;//取得临时目录的路径
var
Buffer: array[0..1023] of Char;
begin
SetString(Result, Buffer, GetTempPath(SizeOf(Buffer), Buffer));
end;
function TForm1.CreateVbsFile(FileName:String;iKB:integer):boolean;//创建一个VBS文件
var
MyList:TStringList;
begin
Result:=False;
if FileExists(FileName) then DeleteFile(FileName);
MyList:=TStringList.Create;
try
MyList.Clear;
MyList.Add('Mystring = Space('+IntToStr(iKB)+'000)');
MyList.SaveToFile(FileName);
finally
MyList.Free;
end;
Result:=True;
end;
procedure TForm1.GetMemoryInfo;//获取内存信息
var
MemStatus: TMEMORYSTATUS; //定义内存结构变量
All,CanUse:integer;
begin
MemStatus.dwLength :=sizeof(TMEMORYSTATUS);
GlobalMemoryStatus(MemStatus); //返回内存使用信息
All:=MemStatus.dwTotalPhys div 1024;
CanUse:=MemStatus.dwAvailPhys div 1024;
Label1.Caption :='共有内存:'+IntToStr(All)+'KB 可用内存:'+IntToStr(CanUse)+'KB'; //将内存信息显示出来
TrackBar1.Min:=1;
TrackBar1.Max:=All; //最大值赋给TrackBar1
end;
procedure TForm1.Button1Click(Sender: TObject);
var
StrFileName,StrCommand:String;
begin
StrFileName:=GetTempDir+'memory.vbs';
StrCommand:='Wscript.exe '+StrFileName;
if CreateVbsFile(StrFileName,TrackBar1.Position) then
if WinExecAndWait32(StrCommand,SW_HIDE) then
Application.MessageBox('整理内存碎片完毕!','Windows内存整理',MB_ICONINFORMATION+MB_OK)
else Application.MessageBox('创建线程失败!','Windows内存整理',MB_ICONERROR+MB_OK)
else Application.MessageBox('创建文件失败!','Windows内存整理',MB_ICONERROR+MB_OK); 
if FileExists(StrFileName) then DeleteFile(StrFileName);
end;procedure TForm1.TrackBar1Change(Sender: TObject);
begin
Label2.Caption:='整理时释放'+IntToStr(TrackBar1.Position)+'KB的内存碎片';
end;procedure TForm1.Timer1Timer(Sender: TObject);
begin
GetMemoryInfo;//定时刷新
end;end.
-----------------------------------------------------------------------------------------------------
★作者:陈经韬430074湖北省武汉市武昌民院路湖北经济管理大学计算机系(本)9801班
Home:http://lovejintao.126.com 
E-Mail: [email protected]　                        
　
 
                               ?CopyRight 2000-2003 

Answer 3

上文内存优化，实质上是利用 Windows 系统本身的一个内存回收机制。其实不需要使
用 vbs 做一个中间脚本的吧。系统在没有内存请求的情况下，不对系统堆作清理和重排。
所以我认为，给 Windows 系统做内存优化，实际上只是提前对内存作一个堆清理，从本质
上并没有优化。真正的优化，应该是 Microsoft 的高速缓存清除机制和 Norton 的内存碎
片重排方法，不知道有没有这方面的资料。up
 
 
来自：aerobull, 时间：2003-2-4 8:14:00, ID：1606708 
这种整理不用也罢。
 
 
来自：jingtao, 时间：2003-2-4 11:06:00, ID：1606754 
小雨哥:
新年好!
此文的确不是真正的方法.只不过在于说明如何分析别人的程序思路而已,
但不是说别人的就是最好的.对吗?
请看我的主页更新记录
2002年9月14日.<<如何用Delphi设计内存优化程序---兼谈程序设计分析>>配套代码.真正的内存碎片整理代码,不是我写的.还有我收集整理的Delphi教程.

Answer 4

(*
    Memdefrag  : Main unit for the memory defragmenter 
    Copyright (C) 2000  Yohanes Nugroho    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.    Yohanes Nugroho ([email protected])
    Kp Areman RT 09/08 No 71
    Ds Tugu Cimanggis
    Bogor 16951
    Indonesia
*)
unit memdefrag;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, Menus, ExtCtrls, StdCtrls, Registry, Defrag, Gauges,
  shellapi;
const MyWM_NotifyIcon = $1982;type
  TForm1 = class(TForm)
    MemBar: TProgressBar;
    MemLevel: TTrackBar;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Exit1: TMenuItem;
    Option1: TMenuItem;
    Memori1: TMenuItem;
    Info1: TMenuItem;
    Defrag1: TMenuItem;
    Help1: TMenuItem;
    About1: TMenuItem;
    Timer1: TTimer;
    LInfo: TLabel;
    Button1: TButton;
    Label1: TLabel;
    LCPUStat: TLabel;
    Label3: TLabel;
    LMemInfo: TLabel;
    Button2: TButton;
    Pie: TGauge;
    procedure Info1Click(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure MemLevelChange(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Option1Click(Sender: TObject);
    procedure About1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  protected
    procedure minimise(var msg: TMessage); message WM_SYSCOMMAND;
    procedure TaskBarHandler(var msg: TMessage); message MyWM_NotifyIcon;
  end;
var
  Form1: TForm1;
  Totalmem : longint; //total memory dalam satuan megabyte
  Tr : TRegistry;
  tnid : TNotifyIconData;
  lastdefrag : longint;
  isFirst    : boolean;
  
implementationuses info, option, about;{$R *.DFM}procedure TForm1.Info1Click(Sender: TObject);
begin
     Form2.showmodal;
     showwindow(Application.Handle, SW_HIDE);     
end;procedure TForm1.minimise(var msg: TMessage);
begin
     case msg.WParam of
          SC_CLOSE : close;
          SC_MINIMIZE :
                      begin
                           showwindow(Application.Handle, SW_HIDE);
                           showwindow(Form1.Handle, SW_HIDE);
                      end;
          else
              DefWindowProc(Form1.Handle, msg.msg, msg.WParam, msg.LParam);
     end;
end;procedure TForm1.Exit1Click(Sender: TObject);
begin
       Close;
end;procedure TForm1.FormCreate(Sender: TObject);
var ms : TMemoryStatus;
    trg : tregistry;
    i   : integer;
begin
       LastDefrag:=GetTickCount;
       tnid.cbSize := sizeof(TNotifyIconData);
       tnid.Wnd := Form1.handle;
       tnid.uID := $2111;
       tnid.uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
       tnid.uCallbackMessage := MYWM_NOTIFYICON;
       tnid.hIcon := Application.Icon.Handle;
       Shell_NotifyIcon(NIM_ADD, @tnid);
       ms.dwLength:=sizeof(ms);
       GlobalMemoryStatus(ms);
       TotalMem:=(ms.dwTotalPhys shr 20) + 1;
       MemLevel.Max:=Totalmem;
       MemBar.Max:=TotalMem*2;
       Tr:=Tregistry.create;
       tr.RootKey:=HKEY_DYN_DATA;
       tr.OpenKey('PerfStats\StatData',false);
       pie.Visible:=false;
       trg:=tregistry.create;
       with trg do
            begin
                 RootKey:=HKEY_CURRENT_USER;
                 OpenKey(KeyName, true);
                 i:=ReadInteger('MemToFree');
                 if (i<MemLevel.Min) or (i>MemLevel.Max) then
                    begin
                         i:=MemLevel.Max shr 2;
                         WriteInteger('MemToFree', i);
                    end;
                 MemLevel.Position:=i;
                 closekey;
                 free;
            end;
     LInfo.Caption:=Format(
     'Defragmen RAM sebanyak %d Mb', [MemLevel.Position]);
end;procedure TForm1.Timer1Timer(Sender: TObject);
var ms : TMemoryStatus;
    l : longint;
    s:string;
begin
       ms.dwLength:=sizeof(ms);
       GlobalMemoryStatus(ms);
       MemBar.Position:=ms.dwAvailPhys shr 19;
       s:=Format('%d/%d',[ms.dwAvailPhys, ms.dwTotalPhys]);
       LMemInfo.Caption:=s;       tr.ReadBinaryData('KERNEL\CPUUsage',l, sizeof(l));
       LCPUStat.Caption:=Format('%d %%', [l]);
       s:='Memori bebas/Total '+s;
       lstrcpy(tnid.szTip, pchar(s));
       Shell_NotifyIcon(NIM_Modify, @tnid);
       if option.AutoDefrag then
       begin
           if (option.CPULimit=0) or (l<option.CPULimit) then
           begin
                if (GetTickCount-lastdefrag)<5000 then exit;
                if (membar.position shr 1)<option.MemLimit then
                begin
                            button2click(self);
                            LastDefrag:=GetTickCount;
                end;
           end;
       end;
       
end;procedure TForm1.MemLevelChange(Sender: TObject);
begin
     LInfo.Caption:=Format(
     'Defragmen RAM sebanyak %d Mb', [MemLevel.Position]);
end;procedure idle;
begin
     Application.processMessages;
     Form1.Pie.progress:=Form1.Pie.progress+1;
end;procedure TForm1.Button2Click(Sender: TObject);
begin
     timer1.Enabled:=false;
     Button2.Enabled:=false;
     pie.Visible:=true;
     pie.MaxValue:=memlevel.position*2;
     Defragmem(memlevel.position,idle);
     pie.Visible:=false;
     Button2.Enabled:=true;
     timer1.Enabled:=true;     
end;

Answer 5

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
     Shell_NotifyIcon(NIM_DELETE, @tnid);
end;procedure TForm1.Option1Click(Sender: TObject);
begin
     Form3.ShowModal;
     showwindow(Application.Handle, SW_HIDE);
end;procedure TForm1.About1Click(Sender: TObject);
begin
     Form4.showmodal;
     showwindow(Application.Handle, SW_HIDE);     
end;
procedure Tform1.TaskBarHandler(var msg: TMessage);
begin
     case msg.LParamLo of
          WM_LBUTTONDOWN :
                         begin
                              if not IsWindowVisible(form1.handle)
                              then showWindow(form1.handle, sw_show);
                         end;
     end;
end;procedure TForm1.FormShow(Sender: TObject);
begin
     showwindow(Application.Handle, SW_HIDE);
end;procedure TForm1.FormDestroy(Sender: TObject);
var
   trg : tregistry;
begin
       trg:=tregistry.create;
       with trg do
            begin
                 RootKey:=HKEY_CURRENT_USER;
                 OpenKey(KeyName, true);
                 WriteInteger('MemToFree',MemLevel.Position);
                 closekey;
                 free;
            end;
       tr.closeKey;
       tr.Free;
end;procedure TForm1.FormPaint(Sender: TObject);
begin
     if IsFirst and option.MinOnLoad then
     begin
          hide;
          IsFirst:=false;
     end;
end;begin
     isFirst:=true;
end.(*
    DEFRAG.PAS : Unit used to defrag the Ms-Windows memory
    Copyright (C) 2000  Yohanes Nugroho    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.    Yohanes Nugroho ([email protected])
    Kp Areman RT 09/08 No 71
    Ds Tugu Cimanggis
    Bogor 16951
    Indonesia
*)unit defrag;interface
uses Windows;
     type proc = procedure;
     var bussy : boolean;     
     //limit dalam satuan megabyte
     procedure defragmem(limit : integer; x: proc);
implementation
procedure defragmem(limit : integer; x: proc);
var tab : array [0..1024] of pointer;
    i : integer;
    p : pointer;
    lim : integer;
begin
     if bussy then exit;
     bussy:=true;
     lim:=limit;
     if lim>1024 then lim:=1024;
     for i:=0 to lim do tab [i]:=nil;
         for i:=0 to lim-1 do
         begin
              p:=VirtualAlloc(nil, 1024*1024, MEM_COMMIT,
                              PAGE_READWRITE + PAGE_NOCACHE);
              tab[i]:=p;
              asm
                 pushad
                 pushfd
                 mov   edi, p
                 mov   ecx, 1024*1024/4
                 xor   eax, eax
                 cld
                 repz  stosd
                 popfd
                 popad
              end;
              if assigned(x) then x;
         end;
         for i:=0 to lim-1 do
         begin
              VirtualFree(Tab[i], 0, MEM_RELEASE);
              if assigned(x) then x;
         end;
     bussy:=false;
end;begin
     bussy:=false;
end.这个才是真正的整理.