{$I-,F+,O+}

Unit
  Protect;

Interface

Uses
{$IFNDEF WIN32}
  DOS,
{$ELSE}
  OpCrt,
  Forms,
{$ENDIF}
  tMisc;

Const
  Registered     : Boolean = False;
  RegDOS         : Boolean = False;
  RegOS2         : Boolean = False;
  RegWin32       : Boolean = False;
  SysOp          : String = '';
  RegNum         : LongInt = 0;

Procedure WriteKey (FN: PathStr);
Procedure InitKey (FN: PathStr);
Procedure CheckReg;

Implementation

Type
  RegStruct = Record
    ID              : String [42];
    SysOpRaw        : String;
    SysOp           : Array [1..3] Of String;
    Version, RegNum : LongInt;
    DOS, OS2, Win32 : String [50];
  End;

Var
  F              : File Of RegStruct;
  R              : RegStruct;
  KeyRead, KeyOK : Boolean;

{$IFNDEF NOT_TOR}
{$I INC\ver.inc}
{$ELSE}
{$I ver.inc}
{$ENDIF}

Function GetVerFirstNum: LongInt;
Begin
  GetVerFirstNum := Str2Long (ExtractWord (1, ExtractWord (2, NameVer, [' ']), ['.']));
End;

Function CryptString (S: String; Code: LongInt): String;
Var
  j, k, l, i, t : Byte;
  Out, Crc      : String;

Begin
  S := UpString (S);
  Crc := PadCh (DelChars (['-'], Long2Str (Crc32Str (S))), '0', 12);
  Out := Crc;
  j := 1; i := 1; t := 1;
  Out [0] := #50;

  While True Do
  Begin
    k := Ord (S [i]);
    l := Ord (Crc [j]);
    k := k xor l;
    Inc (k, Code);
    Out [t+12] := Chr (k);
    Inc (j); If j > 12 Then j := 1;
    Inc (i); If i > Length (S) Then i := 1;
    Inc (t); If t > 38 Then Break;
  End;

  For i := 1 To 12 Do Out [i] := Chr (Str2Long (Out [i]));

  CryptString := Out;
End;

Procedure InitKey (FN: PathStr);
Begin
  Assign (F, FN);
  ReSet (F);
  Randomize;
  KeyRead := False;

  If IOResult = 0 Then
  Begin
    Read (F, R);
    Close (F);
    RegNum := R. RegNum;

    If (R. Version = GetVerFirstNum) And
       (R. SysOpRaw = SysOp) Or
       (IOResult <> 0) Then
    Begin
      KeyRead := True;
      CheckReg;
      Registered := KeyOK;
    End;
  End;
End;

Procedure WriteKey (FN: PathStr);
Var
  i     : Byte;

Begin
  Assign (F, FN);
  ReWrite (F);

  If IOResult = 0 Then
  Begin
    FillChar (R, SizeOf (R), '±');
    R. ID := ' This is a key file by Konst, prot v1.01 *';
    For i := 1 To 3 Do R. SysOp [i] := CryptString (SysOp, i);
    R. Version := GetVerFirstNum;
    R. RegNum := RegNum;
    R. SysOpRaw := SysOp;
    If RegDOS Then R. DOS := CryptString ('DOS' + R. SysOpRaw, 4);
    If RegOS2 Then R. OS2 := CryptString ('OS2' + R. SysOpRaw, 5);
    If RegWin32 Then R. Win32 := CryptString ('Win32' + R. SysOpRaw, 6);
    Write (F, R);
    Close (F);
  End;
End;

Procedure CheckReg;
Var
  i     : Byte;
  S     : String;

Begin
  KeyOK := False;

  If KeyRead Then
  Begin
    i := Random (3)+1;
    KeyOK := CryptString (SysOp, i) = R. SysOp [i];
    i := Random (4);
    Registered := (i <> 2) Or KeyOK;
    RegDOS := R. DOS = Copy (CryptString ('DOS' + R. SysOpRaw, 4), 1, 50);
    RegOS2 := R. OS2 = Copy (CryptString ('OS2' + R. SysOpRaw, 5), 1, 50);
    RegWin32 := R. Win32 = Copy (CryptString ('Win32' + R. SysOpRaw, 6), 1, 50);

    If Not Registered Then
    Begin
      ExitProc := Nil;
    {$IFNDEF WIN32}
      Halt;
    {$ELSE}
      Application. Terminate;
    {$ENDIF}
    End;

  End;
End;

End.