test.pas

DCU2PAS非常不错的破解控件程序,一定要尝试一下啊!

  Percentile = 0..99;

  //class testing
  TMyVariantRecord = record
    I: Integer;
    case Integer of
      0: (SI01: Integer;SI02: Integer);
      1: (SI1: Byte;
          case Integer of
            1: (ST11: Integer);
            2: (ST12: Byte);
         );
      2: (SI2: Extended);
      3: (SI3: PChar);
      4: (SI40: TVarRec;
          case Integer of
            1: (SI41: Integer);
            2: (SI42: Byte);
         );
  end;

const
  //Variant record testing
  MyVarRec: TMyVariantRecord = (I:$12345678;SI41:$76543210);

type
  TSet = set of Byte;
  TSetEnum = set of (Club, Diamond, Heart, Spade);

const
  //Set testing
  vcSet1: TSet = [30,41,61];
  vcSet2: TSet = [];
  vcSet3: Set of 'a'..'z' = ['a'..'c','i','x'..'z'];
  vcSet4: TSetEnum = [Club, Spade];

type
  //Array packed structure testing -- 20020524
  TPackedNumbers = packed array[1..100] of Real;
  TNumbers = array[1..100] of Real;

  //File testing -- 20020524
  TMyFile = file of TFigure;

var
  MyFile: file;

type
  //Function/procedure type testing -- 20020525
  TProcedure = procedure;
  TStrProc = procedure(const S: string);
  TMathFunc = function(X: Double): Double; stdcall;

  TMethod = procedure of object;
  TNotifyEvent = procedure(Sender: TObject) of object;

threadvar
  testThreadVar: String;

type
  //Class testing
  TMyClass = class of TMyObject;

  TMyObject = class
  public
    constructor Create;
    destructor Destroy; override;
    class procedure ClassProc(P1: Integer; P2: Extended);
    class function ClassFunc(P: Integer): Integer;
    procedure AbstractProc; dynamic; abstract;
  private
    FCoordinates: array[0..3] of Longint;
    function GetCoordinate(Index: Integer): Longint;
    procedure SetCoordinate(Index: Integer; Value: Longint);
  published
    property Left: Longint index 0 read GetCoordinate write SetCoordinate;
    property Top: Longint index 1 read GetCoordinate write SetCoordinate;
    property Right: Longint index 2 read GetCoordinate write SetCoordinate;
    property Bottom: Longint index 3 read GetCoordinate write SetCoordinate;
  public
    property Coordinates[Index: Integer]: Longint read GetCoordinate write SetCoordinate; default;
  end;

  //object testing -- 2002-05-25
  TTestObject1 = object
    I1: Integer;
    I2: Extended;
  end;

  TTestObject2 = object(TTestObject1)
    I3: String;
  end;

  //Overload testing
  procedure Proc1(I: Integer); overload;
  function Proc1(I: Int64): Integer; overload;

  //Argument testing
  procedure Proc2(aSet: TSet);
  procedure Proc3(const aSet: TSet);
  procedure Proc4(var aSet: TSet);
  procedure Proc5(out aSet: TSet);

  //with default parameter
  procedure Proc6(P: Byte = 0); overload;
  procedure Proc6(P: Shortint = -1); overload;
  procedure Proc6(P: Word = 0); overload;
  procedure Proc6(P: Smallint = -100); overload;
  procedure Proc6(P: Integer = 0); overload;
  procedure Proc6(P: Cardinal = $ffff); overload;
  //procedure Proc6(P: Longword = $ffff); overload;
  procedure Proc6(P: Int64 = MaxInt); overload;
  procedure Proc6(P: Single = 123); overload;
  procedure Proc6(P: Double = 1.23); overload;
  //procedure Proc6(P: Real = 1.23); overload;
  procedure Proc6(P: Real48 = 1.23); overload;
  procedure Proc6(P: Comp = 123); overload;
  procedure Proc6(P: Extended = pi); overload;
  procedure Proc6(P: Currency = 1e4); overload;
  procedure Proc6(P: Char ='c'); overload;
  //procedure Proc6(P: AnsiChar); overload;
  procedure Proc6(P: WideChar = 'w'); overload;
  procedure Proc6(P: String = 'I''m here'); overload;
  //procedure Proc6(P: AnsiString); overload;
  procedure Proc6(P: WideString = 'WideString'); overload;
  procedure Proc6(P: PChar = nil); overload;
  procedure Proc6(P: PWideChar = nil); overload;
  procedure Proc6(P: Pointer = nil); overload;

//Dynamic arrays testing
type
  TMessageGrid = array of array of string;
var
  MyDynArray1: array of Integer;
  MyDynArray2: array of TMyRecord1;

//2002-05-25
resourcestring
  CreateError = 'Cannot create file %s';        {  for explanations of format specifiers, }
  OpenError = 'Cannot open file %s';            { see 'Format strings' in the online Help }
  LineTooLong = 'Line too long';
  ProductName = 'Borland Rocks\000\000';

implementation

{TMyObject}

constructor TMyObject.Create;
asm
  @@18:       mov       [ebp-6],cl
  @@21:       mov       [ebp-5],dl
  @@24:       mov       [ebp-4],eax
  @@27:       mov       ecx,[ebp+8]
  @@30:       xor       edx,edx
  @@32:       mov       eax,[ebp-4]
  @@35:       call      Exception.Create
  @@40:       mov       al,[ebp-6]
  @@43:       mov       edx,[ebp-4]
  @@46:       mov       [edx+12],al
  @@49:       mov       eax,[ebp-4]
  @@73:       mov       eax,[ebp-4]
  @@76:       pop       ecx
  @@77:       pop       ecx
end;

destructor TMyObject.Destroy;
begin
end;

class procedure TMyObject.ClassProc(P1: Integer; P2: Extended);
begin
end;

class function TMyObject.ClassFunc(P: Integer): Integer;
begin
  Result := 0;
end;

function TMyObject.GetCoordinate(Index: Integer): Longint;
begin
  Result := 0;
end;

procedure TMyObject.SetCoordinate(Index: Integer; Value: Longint);
begin
end;

procedure Proc1(I: Integer);
var
  iTmp: Integer;
asm
  jmp System.@AbstractError
end;

function Proc1(I: Int64): Integer;
begin
  Result := $12345678;
end;

procedure Proc2(aSet: TSet);
begin
end;

procedure Proc3(const aSet: TSet);
begin
end;

procedure Proc4(var aSet: TSet);
begin
end;

procedure Proc5(out aSet: TSet);
begin
end;

procedure Proc6(P: Byte);
begin
end;

procedure Proc6(P: Shortint);
begin
end;

procedure Proc6(P: Word);
begin
end;

procedure Proc6(P: Smallint);
begin
end;

procedure Proc6(P: Integer);
begin
end;

procedure Proc6(P: Cardinal);
begin
end;

procedure Proc6(P: Int64);
begin
end;

procedure Proc6(P: Single);
begin
end;

procedure Proc6(P: Double);
begin
end;

procedure Proc6(P: Real48);
begin
end;

procedure Proc6(P: Comp);
begin
end;

procedure Proc6(P: Extended);
begin
end;

procedure Proc6(P: Currency);
begin
end;

procedure Proc6(P: Char);
begin
end;

procedure Proc6(P: WideChar);
begin
end;

procedure Proc6(P: String);
begin
end;

procedure Proc6(P: WideString);
asm
end;

procedure Proc6(P: PChar);
begin
end;

procedure Proc6(P: PWideChar);
asm
  push ebp
  mov ebp,esp
  add esp,-100
  add esp,-500
  sub esp,100
  sub esp,500
end;

procedure Proc6(P: Pointer);
var
  I,J: Int64;
begin
  try
    I := 100;
    J := 0;
    I := I div J;
  except
    I := 0;
  end;
  MessageBox(0,PChar(IntToStr(I)),'Test',MB_OK);
end;

end.