umain.pas

内存管理程序

unit uMain;
//NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE:
//
//License agreement in a nutshell: By installing these files into your application,
//you AGREE to the license agreement.  If you don't agree.  Don't use.
//
//Warranty:  Beta AS-IS No Warrantee.
//Liability: Digital Tundra LLC is not responsible for any damage caused by
//the use of this software in any way.  This includes but is not limited to,
//bugs within the memory manager itself.
//Expiration: This is DEMO software, and any attempt to break the copy protection
//is a violation of the License agreement and persons using cracked versions of this
//software will be responsible for compensatory damages for all illegal copies in
//their posession and/or distributed to 3rd parties.
//YOU MAY NOT DISTRIBUTE THIS SOFTWARE to 3RD PARTIES. If a 3rd party needs this
//software, you may direct them to the www.digitaltundra.com to download the software.
//
//YOU ALSO MAY NOT RESELL THIS SOURCE CODE, or MODIFY-AND-SELL THIS SOURCE
//CODE.

interface


uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, TeEngine, Series, ExtCtrls, TeeProcs, Chart, ComCtrls,
  XPMan, beeper;

type
  TDemoThread = class(TThread)
  private
    function GetThreadResult: string;
    procedure SetThreadResult(const Value: string);
  protected
    sect: _RTL_CRITICAL_SECTION;
    FThreadResult: string;

  public
    constructor Create(createSuspended: boolean); reintroduce; virtual;
    destructor Destroy; override;
    procedure Execute; override;
    property ThreadResult: string read GetThreadResult write SetThreadResult;
    procedure Lock;
    procedure Unlock;
  end;


  TForm1 = class(TForm)
    Memo1: TMemo;
    Memo2: TMemo;
    Memo3: TMemo;
    Memo4: TMemo;
    Go: TButton;
    Chart1: TChart;
    Series1: TPieSeries;
    Timer1: TTimer;
    cbFeedBack: TCheckBox;
    Edit1: TEdit;
    UpDown1: TUpDown;
    Label1: TLabel;
    Label2: TLabel;
    XPManifest1: TXPManifest;
    procedure FormCreate(Sender: TObject);
    procedure GoClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    function ThreadCount: integer;
  end;

var
  Form1: TForm1;

implementation
uses

//Cut
////CutPro
//  BrainScanUltra;
////EndCutPro
//EndCut
//Cut
//CutUltra
  BrainScanPro;
//EndCutUltra
//EndCut

////CutPro
////CutUltra
//  BrainScan;
////EndCutUltra
////EndCutPro

{$R *.dfm}

{ TDemoThread }

constructor TDemoThread.Create(createSuspended: boolean);
begin
  inherited Create(true);
  InitializeCriticalSection(sect);
  if not CreateSuspended then
    resume;
end;

destructor TDemoThread.Destroy;
begin
  DeleteCriticalSection(sect);

  inherited;
end;

procedure TDemoThread.Execute;
var
  t: integer;
  tm1,tm2: cardinal;
  sTemp: string;
begin
  inherited;
  try
    tm1 := GetTickCount;
    sTemp := '';
    for t:=0 to 200000 do begin
      sTemp := chr(ord('a')+random(26))+sTemp;
//      ThreadResult := +ThreadResult;
    end;
    tm2 := GetTickCount;

    ThreadResult := 'Completed in '+floattostr((tm2-tm1)/1000)+' seconds.'#13#10+
                    'Throughput '+floattostr(60/((tm2-tm1)/1000))+' tests/min.'

  finally
    FreeOnTerminate := false;
    Terminate;
  end;
end;

function TDemoThread.GetThreadResult: string;
begin
  Lock;
  try
    result := FThreadResult;
    UniqueString(result);
  finally
   Unlock;
  end
end;
procedure TDemoThread.Lock;
begin
  EnterCriticalSection(sect);
end;

procedure TDemoThread.SetThreadResult(const Value: string);
begin
  Lock;
  try
    FThreadREsult := value;
    UniqueString(FThreadResult);
  finally
   Unlock;
  end

end;

procedure TDemoThread.Unlock;
begin
  LeaveCriticalSection(sect);
end;

procedure TForm1.GoClick(Sender: TObject);
var
  threads: array[1..4] of TDemoThread;
  iTerminatedCount: integer;
  bDone: boolean;
  t: integer;
begin
  for t := 1 to ThreadCount do
    threads[t] := TDemoThread.create(true);

  for t := 1 to ThreadCount do
    threads[t].Resume;

  repeat
    if cbFeedBack.checked then begin
      if ThreadCount >= 1 then
        memo1.Lines.text := threads[1].ThreadResult;
      if ThreadCount >= 2 then
        memo2.Lines.text := threads[2].ThreadResult;
      if ThreadCount >= 3 then
        memo3.Lines.text := threads[3].ThreadResult;
      if ThreadCount >= 4 then
        memo4.Lines.text := threads[4].ThreadResult;
    end;


    iTerminatedCount := 0;

    for t:= 1 to ThreadCount do begin
      if threads[t].terminated then
        inc(iTerminatedCount);
    end;


    bDone := iTerminatedCount = ThreadCount;

    if not bDone then begin
      MemChart(chart1);
      sleep(500);
      refresh;
    end;

  until bDone;

  if ThreadCount >= 1 then
  memo1.Lines.text := threads[1].ThreadResult;
  if ThreadCount >= 2 then
  memo2.Lines.text := threads[2].ThreadResult;
  if ThreadCount >= 3 then
  memo3.Lines.text := threads[3].ThreadResult;
  if ThreadCount >= 4 then
  memo4.Lines.text := threads[4].ThreadResult;

  for t:=1 to ThreadCount do begin
    threads[t].free;
  end;



end;

function TForm1.ThreadCount: integer;
begin
  result := strtoint(edit1.text);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  MemChart(chart1);

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  beeper.beep(100,100);
end;

end.