testdll.dpr

delphi开发语言下的源代码分析

library TestDll;

uses
  ShareMemRep,
  SysUtils,
  Windows;

var
  Str : String = 'Written by Aimingoo!'#$0D#$0A;

threadvar
  A: array[1..3000] of Pointer;

procedure _RandomAlloc;
var
  I, J, K : Integer;
begin
  FillChar(A,SizeOf(A),0);
  // Allocate 1000 random blocks of (4097 .. 10000) bytes 1000 times
  for I := 1 to 1000 do
    for J := 1 to 1000 do
    begin
      K := Random(1000)+1;
      FreeMem(A[K]);
      GetMem(A[K],Random(5903)+4097);
    end;

  // free all
  for J := 1 to 1000 do
    FreeMem(A[J]);
end;

function AllocSpeedTest : LongWord;
begin
  Result := GetTickCount;
  _RandomAlloc;
  Result := GetTickCount - Result;
end;

function SequentialAllocTest : LongWord;
var
  I : Integer;
begin
  Result := GetTickCount;
  for I := 1 to 10 do
    _RandomAlloc;
  Result := GetTickCount - Result;
end;

var
  Threads : Integer = 0;

function ThreadProc(Parameter: Pointer): Integer;
begin
  Result := 0;
  _RandomAlloc;
  dec(Threads);
  EndThread(0);
end;

function ThreadAllocTest : LongWord;
var
  I : Integer;
  FThreadID : Cardinal;
begin
  Result := GetTickCount;
  for I := 1 to 10 do
  begin
    inc(Threads);
    BeginThread(nil, 0, @ThreadProc, nil, 0, FThreadID);
  end;

  // waiting for the end of all threads..
  while Threads <> 0 do
    Sleep(100);
  Result := GetTickCount - Result;
end;

exports
  AllocSpeedTest,
  SequentialAllocTest,
  ThreadAllocTest;

end.