info.pas

内存自动整理源码》很明显就是有关于内存整理的软件源码

(*
    INFO.PAS : Unit to show the memory information
    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 ([e-mail])
    Kp Areman RT 09/08 No 71
    Ds Tugu Cimanggis
    Bogor 16951
    Indonesia


*)

unit info;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls,  Gauges, shellapi, ComCtrls;
  const MyWM_NotifyIcon = $1982;
type proc = procedure;
type
  TFormncyh = class(TForm)
    StatusBar1: TStatusBar;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    Label5: TLabel;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    LTotalRAM: TLabel;
    LFreeRAM: TLabel;
    LTotalPage: TLabel;
    LPageFree: TLabel;
    LTotalVirtual: TLabel;
    LFreeVirtual: TLabel;
    LMemoryLoad: TLabel;
    Pie: TGauge;
    Button1: TButton;
    Button2: TButton;
    Timer1: TTimer;
    TrackBar1: TTrackBar;
    CheckBox1: TCheckBox;
    Label9: TLabel;
    Label10: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Formncyh: TFormncyh;
  bussy : boolean;
  Totalmem : longint;
  lastdefrag : longint;
  isFirst    : boolean;
  procedure defragmem(limit : integer; x: proc);
  Function Memozl(AppHandle: THandle): Integer;
  Function Memozld(): Integer;
implementation

//uses Unitcpu;

{$R *.DFM}


procedure TFormncyh.Button1Click(Sender: TObject);
begin
     Close;
end;

procedure TFormncyh.FormShow(Sender: TObject);
const
  b = ' B';
var
  ms : TMemoryStatus;
begin
     //ShowWindow(application.handle, SW_HIDE);
     ms.dwLength:=sizeof(ms);
     GlobalMemoryStatus(ms);
     LTotalRam.Caption:=Format('%d'+b, [ms.dwTotalPhys]);
     LFreeRam.Caption:=Format('%d'+b,[ms.dwAvailPhys]);
     LTotalPage.Caption:=Format('%d'+b,[ms.dwTotalPageFile]);
     LPageFree.Caption:=Format('%d'+b, [ms.dwAvailPageFile]);
     LTotalVirtual.Caption:= Format('%d'+b, [ms.dwTotalVirtual]);
     LFreeVirtual.Caption:= Format('%d'+b,[ms.dwAvailVirtual]);
     LMemoryLoad.Caption:= Format('%d %%',[ms.dwMemoryLoad]);
     timer1.Enabled:=true;
end;

procedure TFormncyh.Timer1Timer(Sender: TObject);
const b = ' B';
var ms : TMemoryStatus;
begin
     ms.dwLength:=sizeof(ms);
     GlobalMemoryStatus(ms);
     LFreeRam.Caption:=Format('%d'+b,[ms.dwAvailPhys]);
     LPageFree.Caption:=Format('%d'+b, [ms.dwAvailPageFile]);
     LFreeVirtual.Caption:= Format('%d'+b,[ms.dwAvailVirtual]);
     LMemoryLoad.Caption:= Format('%d %%',[ms.dwMemoryLoad]);
     CollectCPUData;
     StatusBar1.Panels.Items[0].Text:=' CPU使用率：'+Format('%5.2f%%',[GetCPUUsage(0)*100]);
     if CheckBox1.Checked and (ms.dwMemoryLoad>TrackBar1.Position) then
       Button2Click(nil);
     
end;

procedure TFormncyh.FormCreate(Sender: TObject);
var
  ms : TMemoryStatus;
begin
  ms.dwLength:=sizeof(ms);
  GlobalMemoryStatus(ms);
  TotalMem:=(ms.dwTotalPhys shr 20) + 1;
end;

procedure idle;
begin
  Application.processMessages;
  Formncyh.Pie.progress:=Formncyh.Pie.progress+1;
end;
procedure TFormncyh.Button2Click(Sender: TObject);
begin
  Timer1.Enabled:=false;
  pie.Progress:=0;
  pie.Visible:=true;
  pie.MaxValue:=Totalmem*2;
  Defragmem(Totalmem,idle);
 // MessageBox(Application.Handle,'内存优化整理完毕!','系统提示',MB_OK);
  pie.Visible:=false;
  Timer1.Enabled:=true;
end;
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;
Function Memozl(AppHandle: THandle): Integer;
begin
 Application.Handle:=AppHandle;
 Formncyh:=TFormncyh.Create(Application);
 Formncyh.ShowModal;
 Formncyh.free;
 result:=0;
end;
Function Memozld(): Integer;
begin
 Formncyh:=TFormncyh.Create(NIL);
 Formncyh.ShowModal;
 Formncyh.free;
 result:=0;
end;


procedure TFormncyh.TrackBar1Change(Sender: TObject);
begin
  Label10.Caption:=inttostr(TrackBar1.Position)+'/%';
end;

end.