unit regtools;

interface

uses
  SysUtils, Classes, wbsData, MultiLang
{$IFDEF CLX}
  , QGraphics, QControls, QForms, QDialogs, QStdCtrls
{$ELSE}
  , Graphics, Controls, Forms, Dialogs, StdCtrls
{$ENDIF}
  ;

type
  TForm7 = class(TForm)
    Label1: TLabel;
    Edit1: TEdit;
    Label2: TLabel;
    Edit2: TEdit;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

  function CheckSerialNo(serno: String): boolean;

var
  Form7: TForm7;

implementation

{$R *.dfm}

  function CheckSerialNo(serno: String): boolean;
  var
    reg:        boolean;
    i,j:        Integer;
    SubString:  String;
    SecPrime:   Integer;
    Div13:      Integer;
    Div7:       Integer;
    CharSum:    Integer;
    Prim5Dig:   Array[0..9999] Of Boolean;
  begin
    reg:=True;
    {check length}
    If Length(serno)<>22 Then reg:=False
    Else begin
      {is digit 10 a '.'?}
      If serno[10]<>'.' Then reg:=False;
      {are digits 17-19 = '-66'?}
      If reg Then Begin
        If serno[17]<>'-' Then reg:=False;
        If serno[18]<>'6' Then reg:=False;
        If serno[19]<>'6' Then reg:=False;
      End;
      {are digits 1-4 a secure prime number ?}
      If reg Then Begin
        SubString:=Copy(serno,1,4);
        SecPrime:=StrToInt(SubString);
        Prim5Dig[0]:=False;
        For i:=1 To 9999 Do Prim5Dig[i]:=True;
        For i:=2 To Trunc(Sqrt(9999)) Do
          If Prim5Dig[i] Then
          For j:=i To (9999 Div i) Do Prim5Dig[i*j]:=False;
        If Prim5Dig[SecPrime] Then Begin
          If Not(Prim5Dig[(SecPrime-1) Div 2]) Then reg:=False;
        End
        Else reg:=False;
      End;
      {are digits 5-9 dividable by 31?}
      If reg Then Begin
        SubString:=Copy(serno,5,5);
        Div13:=StrToInt(SubString);
        If (Div13 Mod 31)<>0 Then reg:=False;
      End;
      {are digits 20-22 dividable by 17?}
      If reg Then Begin
        SubString:=Copy(serno,20,3);
        Div7:=StrToInt(SubString);
      End;
      {is the sum of character codes of digits 11-16 divided by 6 = 99 ?}
      If reg Then Begin
        CharSum:=0;
        For i:=11 To 16 Do
          CharSum:=CharSum+Ord(serno[i]);
        If CharSum<>594 Then reg:=False;
      End;
    End;
    CheckSerialNo:=reg;
  end;

  function CheckNameConformity(serno, username: String): boolean;
  var
    isOK:    boolean;
    space:   Byte;
  begin
    isOK:=True;
    space:=Pos(' ',username);
    if space=0 Then space:=2 Else inc(space);
    If serno[11]<>LowerCase(username[1]) Then isOK:=false;
    If serno[14]<>UpperCase(username[space]) Then isOK:=false;
    CheckNameConformity:=isOK;
  end;

{---}

procedure TForm7.Button2Click(Sender: TObject);
begin
  If CheckSerialNo(Edit2.Text) And CheckNameConformity(Edit2.Text,Edit1.Text) Then Begin
    RegUserName:=Edit1.Text;
    RegSerialNo:=Edit2.Text;
    IsRegd:=True;
    ShowMessage(ml.GetCodeString('regtools',1){('Thank you for registering!'});    // code001
    Close;
  End
  Else MessageDlg(ml.GetCodeString('regtools',2){'Registration key is invalid or does not match name.'},mtError,[mbOK],0); // code002
end;

procedure TForm7.Button3Click(Sender: TObject);
begin
  Close;
end;

procedure TForm7.Button1Click(Sender: TObject);
begin
{$IFDEF CLX}
  Application.HelpSystem.ShowContextHelp(300,Application.HelpFile);
{$ELSE}
  Application.HelpContext(300);
{$ENDIF}
end;

procedure TForm7.FormCreate(Sender: TObject);
begin
  // ml support
  Button1.Caption:=ml.GetComponentString('regtools.Button1.Caption');
  Button2.Caption:=ml.GetComponentString('regtools.Button2.Caption');
  Button3.Caption:=ml.GetComponentString('regtools.Button3.Caption');
  Form7.Caption:=ml.GetComponentString('regtools.Form7.Caption');
  Label1.Caption:=ml.GetComponentString('regtools.Label1.Caption');
  Label2.Caption:=ml.GetComponentString('regtools.Label2.Caption');
  //////////////////////////////////////////////////////////////////////
end;

end.