DM Serial Number Demo - نسخة قابلة للطباعة

PHP كود :
unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    txtName: TLabeledEdit;
    txtKey: TLabeledEdit;
    cmdRegister: TButton;
    procedure cmdRegisterClick(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function GetSerial(Username : string) : string;
var
  CH: Byte;
  S1,S2,Hash : string;
  I,J,A,B : Integer;
  const sTable = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
begin

  Hash := '';
  S1 := '';
  A := 1;
  B := Length(Username);

  If B = 0 then Exit;

  //Resize user name to 24 bytes
  For I := 1 to 24 do
  begin
    If A > B Then A := 1;
    //Use this to jumple of orginal char values
    J := (I * byte(Username[A]) XOR 45) AND 255;
    //Build new username
    S1 := S1 + Chr(J);
    //INC Counter
    INC(A);
  end;

  //Make serial string of username.
  For I := 1 to Length(S1) do
  begin
    CH := Byte(S1[I]);
    A := (CH MOD 36);
    If A = 0 then A := 1;
    //Build serial
    hash := hash + sTable[A];
  end;

  For I := 1 to Length(hash) do
  begin
    B := I - 1;
    If (B MOD 4) = 0 then
    begin
      //Add seperator.
      S2 := S2 + '-';
    end;
    //Build hash
    S2 := S2 + hash[I];
  end;
  //Delete first seperator.
  Delete(s2,1,1);
  //Return hash.
  GetSerial := S2;
end;

function IsSerialVaild(Username,sSerial : string) : Boolean;
begin
  //Test if number is vaild.
  if Length(Trim(Username)) = 0 then exit;
  IsSerialVaild := GetSerial(Username) = sSerial;
end;
procedure TForm1.cmdRegisterClick(Sender: TObject);
var sKey : string;
begin
  sKey := GetSerial(txtName.Text);
  txtkey.Text := sKey;
end;

end.