Program KeyGen_for_New_Rover;
Uses Logo,Crt;
Const
    NB : Array[1..85] of String[24] = ( {This is the name database}
    'ChrisLepezia'              ,
    'ComengIseng'               ,
    'DouglasGoodall'            ,
    'Durkpc97'                  ,
    'Durk'                      ,
    'FrankMaier'                ,
    'JennyMcCarthy'             ,
    'JohnSeca'                  ,
    'RogerGreene'               ,
    'AlanGarrett'               ,
    'DieterBach'                ,
    'ScottMorgan'               ,
    'RogerSmith'                ,
    'MichaelGilbreath'          ,
    'JudithWareham'             ,
    'JanKlaassen'               ,
    'TheGuardianAngelTgaGis'    ,
    'TheGuardianAngel'          ,
    'FreeRegisteredVersion'     ,
    'Free'                      ,
    'TellerbopTelGis'           ,
    'Tellerbop'                 ,
    'Me'                        ,
    'You'                       ,
    '2U'                        ,
    '4U'                        ,
    'Somebody'                  ,
    'Nobody'                    ,
    'Anybody'                   ,
    'sysop'                     ,
    'anyone'                    ,
    'noone'                     ,
    'xxx'                       ,
    'MadJester'                 ,
    'MadJesterGrs97'            ,
    'BlackSheep'                ,
    'WilliamMartinez'           ,
    'NormanGTolman'             ,
    'SteveFair'                 ,
    'FazalMohammed'             ,
    'CraigBruno'                ,
    'MarcFeist'                 ,
    'BobCouchman'               ,
    'JVilleneuve'               ,
    'EdwardRudman'              ,
    'DanaWood'                  ,
    'DaGiVeR'                   ,
    'craks4u'                   ,
    'pc97Teslacoil'             ,
    'pc97'            {Yep!}    ,
    'teslacoil'                 ,
    'CowChicken'                ,
    'Cow'                       ,
    'Chicken'                   ,
    'BiteMyLeg'                 ,
    'SHComputerSystemsInc'      ,
    'GeraldPaul'                ,
    'MrLee'                     ,
    'asaiharum'                 ,
    'scotttsnt'                 ,
    'CharlesKEllis'             ,
    'MartinGagne'               ,
    'DonDayton'                 ,
    'Alpha'                     ,
    'redinger'                  ,
    'Igrowledforfiveseconds'    ,
    'MichaelJaschek'            ,
    'Arealkeyhere'              ,
    'DeeZawel'                  ,
    'Yogan'                     ,
    'Havana'                    ,
    'UnlimitedUse'              ,
    'fsmith3'                   ,
    'Dexter'                    ,
    'SeasonsGreetings'          ,
    'Mirnixdirnix'              ,
    'asdfg'                     ,
    'Registered'                ,
    'Myasshurts'                ,
    'Thiscomputer'              ,
    'Mycomputer'                ,
    'Klansmansuckblackdick'     ,       {Sick programmer}
    'KKKsuckblackdick'          ,       {Really sick programmer!}
    'AlienSoft'                 ,
    'AnyComputer' );

Var Name : string[30];
    I,j,K : byte;
    A : Array[1..2] of word ;
    B,C : Array[1..4] of byte;
    S,H : String[4];
    Code : Array[1..4] of Byte;
    Y: String[6];



{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure Check_Name;
Var ClnName : string[30];

Begin
     j:=0;
     For i:=1 to Length(Name) do    {Create ClnName - only Letters and dig}
        Begin
         K := Ord(Name[i]);
         If (( K >= Ord('0')) And ( K <= Ord('9'))) Or
            (( K >= Ord('a')) And ( K <= Ord('z'))) Or
            (( K >= Ord('A')) And ( K <= Ord('Z'))) Then
               Begin INc(j); ClnName[j]:=Name[i]; End;
        End;
     ClnName[0]:=Chr(j);

     For I:=1 to 85 do
         If ClnName = NB[i] Then
           Begin
            TextColor(14);
            write('Error:');
            TextColor(15);
            Writeln('The Name ',ClnName,' is not accepted In the Registration!(Blaim the programmer;)');
            writeln('      Choose a different Name (Tip:CAPPITAL and small Letters are DiFfErEnT)!');
            Halt(1);
           End;

end;


{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
procedure dec2hex(x : word);
var g : Byte;
Begin
     S[0]:=Chr(4);
     For g:=4 downto 1 do
      Begin
         s[g]:=Chr((x mod 16));
         x := x div 16;
      End;

End;


{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure Cal1;
          Function Hex2Dec(X : Byte) : Byte;
            Begin
                 Hex2Dec := Ord(S[x])*16+Ord(s[x+1]);
            End;
Begin
     A[1]:=0;
     J:=0;
     For i:=1 to Length(Name) do
        Begin
         K := Ord(Name[i]);
         If (( K >= Ord('0')) And ( K <= Ord('9'))) Or
            (( K >= Ord('a')) And ( K <= Ord('z'))) Or
            (( K >= Ord('A')) And ( K <= Ord('Z'))) Then
               Begin
                                   {small letters to cappital}
               If ( K >= Ord('a')) And ( K <= Ord('z')) Then k:=k-$20;
               K:=K Xor (j);
               A[1] := A[1] + k;
               Inc(j);
               End;
        End;
     Dec2Hex(A[1]);     {Will put in S the Hex Value of A[1]}
     B[3] := Hex2Dec(1);
     B[4] := Hex2Dec(3);
End;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure Cal2;
Begin
     Randomize;
     B[1]:=Random($ff);
     B[2]:=Random($ff);
     H:=S;


     J:=0;
     While J=0 do
     Begin
     Inc(B[2]);
     A[2]:=B[1]*256+B[2];
     Dec2Hex(A[2]);
     If Ord(S[2]) Xor Ord(S[3]) Xor Ord(S[4]) Xor Ord(H[1]) Xor
        Ord(H[2]) Xor Ord(H[3]) Xor Ord(H[4]) = Ord(S[1]) Then j:=1;
     End;

End;

{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure Cal3;
Var X : Array[1..2] of Word;
    L : Array[1..2] of LongInt;
    T : real;
    g:byte;
    q:integer;
    p:Array[1..2] of byte;

Begin
     C[1]:=B[3] Xor $17;
     C[2]:=B[2] Xor $76;
     C[3]:=B[1] Xor $51;
     C[4]:=B[4] Xor $98;

     Randomize;
     J:=0;
     While j=0 do
     Begin
     X[1]:=random($ff);
     X[2]:=random($ff);

     Dec2Hex(X[1]);
     H:=S;
     Dec2Hex(X[2]);
     L[1]:=(Ord(h[3])*1048576);
     L[1]:=L[1]+(Ord(h[4])*65536);
     For g:=1 to Ord(s[3]) Do L[1]:=L[1]+4096;
     L[1]:=L[1]+(Ord(s[4])*256);

     L[2]:=L[1] shr 2;

     Y[0]:=Chr(6);
     For g:=6 downto 1 do
      Begin
         T:=L[2]/16;
         L[2] := L[2] div 16;
         q:=Round((T-L[2])*16);
         Y[g]:=Chr(q);
      End;

     P[1] := Ord(y[1])*16+Ord(y[2]);
     P[2] := Ord(y[5])*16+Ord(y[6]);

     If ((Ord(y[3])*16+Ord(y[4])) = C[4])     And
         ((P[1] Or P[2]) = C[3]) Then j:=1;

     End;

     Code[1]:=X[2];
     Code[2]:=X[1];

End;

{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure Cal4;
Var X : Array[1..3] of Word;
    L : Array[1..2] of LongInt;
    T : real;
    g:byte;
    q:integer;
    p:Array[1..2] of byte;
Begin
     Randomize;
     J:=0;
     While j=0 do
     Begin
     X[1]:=random($ff);
     X[2]:=random($ff);
     X[3]:=0;

     Dec2Hex(X[1]);
     H:=S;
     Dec2Hex(X[2]);
     L[1]:=(Ord(h[3])*1048576);
     L[1]:=L[1]+(Ord(h[4])*65536);
     For g:=1 to Ord(s[3]) Do L[1]:=L[1]+4096;
     L[1]:=L[1]+(Ord(s[4])*256);

     L[2]:=L[1] shr 1;

     Y[0]:=Chr(6);
     For g:=6 downto 1 do
      Begin
         T:=L[2]/16;
         L[2] := L[2] div 16;
         q:=Round((T-L[2])*16);
         Y[g]:=Chr(q);
      End;

     P[1] := Ord(y[1])*16+Ord(y[2]);
     P[2] := Ord(y[5])*16+Ord(y[6]);

     If ((Ord(y[3])*16+Ord(y[4])) = C[2])     And
         ((P[1] Or P[2]) = C[1]) Then j:=1;

     End;

     Code[3]:=X[2];
     Code[4]:=X[1];


End;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure Show_Code;
Var T : Real;
    g : BYte;
    V : String[8];
    F_Code : String[10];
Begin
     V[0]:=Chr(8);
     For g:=1 to 4 do
     Begin
     V[(g*2)-1]:=Chr( Code[g] Div 16);
     V[(g*2)]:=Chr( Code[g] Mod 16);
     End;

     T:=0;
     For g:=1 to Ord(v[1]) Do T:=T+268435456;
     For g:=1 to Ord(v[2]) Do T:=T+16777216;
     For g:=1 to Ord(v[3]) Do T:=T+1048576;
     For g:=1 to Ord(v[4]) Do T:=T+65536;
     For g:=1 to Ord(v[5]) Do T:=T+4096;
     For g:=1 to Ord(v[6]) Do T:=T+256;
     For g:=1 to Ord(v[7]) Do T:=T+16;
     T:=T+Ord(v[8]);

     Writeln('[ê] Your Code Is : ',T:10:0);
     Writeln;
     Writeln('Enjoy!');Writeln('The+Q [Phrozen Crew]');

End;

{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Begin
     PC_logo('News Rover v3.X');

     Writeln;Write('[?] Enter Your Name : ');Readln(Name);
     If Length(Name) < 5 Then
        Begin
             TextColor(14);
             Write('ERROR:');
             TextColor(15);
             Writeln('Name''s Length should be 5 or more chars !');
             Halt(1);
        End;

     Check_Name;
     Cal1;Writeln('[þ] Please wait , Calculating ...');
     Cal2;
     Cal3;
     Cal4;
     Show_Code;

end.