home *** CD-ROM | disk | FTP | other *** search
/ Reverse Code Engineering RCE CD +sandman 2000 / ReverseCodeEngineeringRceCdsandman2000.iso / RCE / Quantico / km / ucfkey02.pas.txt < prev    next >
Encoding:
Text File  |  2000-05-25  |  4.3 KB  |  155 lines
  1. {$M $4000,0,65536}       {* Set heap size to zero !!! *}
  2. Program UniversialKeymaker;
  3. uses palette,dos,crt,keyinput;
  4. {$L ULONGS.OBJ}                         { link in the assembly code }
  5. FUNCTION LongADD (Addend1,Addend2:LONGINT):LONGINT;   EXTERNAL;
  6. FUNCTION LongSUB (LongWord,Subtrahend:LONGINT):LONGINT;  EXTERNAL;
  7. FUNCTION LongMUL (Multiplicand,Multiplier:LONGINT):LONGINT; EXTERNAL;
  8. FUNCTION LongDIV (Dividend,Divisor:LONGINT):LONGINT;  EXTERNAL;
  9. FUNCTION LongMOD (Dividend,Divisor:LONGINT):LONGINT;  EXTERNAL;
  10. PROCEDURE WriteULong (LongWord:LONGINT;     { the longword          }
  11.                       Width:BYTE;           { _minimum_ field width }
  12.                       FillChar:CHAR;        { leading space char    }
  13.                       Base:BYTE); EXTERNAL; { number base 2..26     }
  14.  
  15. Var
  16.   sk                         : array[1..8000] of byte absolute $b800:0000;
  17.   i,numwritten:integer;
  18.   ToF:File;
  19.   Output : String;
  20.   f:text;
  21.   x,y,Name,Company:String;
  22. Type
  23.   String8 = String[8];
  24.  
  25.  
  26. Const
  27.   AskName=1;
  28.   AskCompany=0;
  29.  
  30.  
  31. Procedure LongToHex(AnyLong : LongInt; Var HexString : String8);
  32.  
  33. Var
  34.   ALong : LongInt;
  35.   ch    : Char;
  36.   Index : Byte;
  37. begin
  38.   HexString := '00000000';                  { default to zero   }
  39.   Index := Length(HexString);               { String length     }
  40.   While AnyLong <> 0 do
  41.   begin                                     { loop 'til done    }
  42.     ch := Chr(48 + Byte(AnyLong) and $0F);  { 0..9 -> '0'..'9'  }
  43.     if ch > '9' then
  44.       Inc(ch, 39);                           { 10..15 -> 'A'..'F'}
  45.     HexString[Index] := ch;                 { insert Char       }
  46.     Dec(Index);                             { adjust chr Index  }
  47.     AnyLong := AnyLong SHR 4;               { For next nibble   }
  48.   end;
  49. end;
  50.  
  51. Procedure Curs(n:integer);
  52.  
  53. Var regs : registers;
  54.  
  55. Begin
  56.   regs.ah:=1;
  57.   case n of
  58.   0 : begin
  59.         regs.cl:=32;
  60.         regs.ch:=32;
  61.       end;
  62.   1 : begin
  63.         regs.cl:=8;
  64.         regs.ch:=7;
  65.       end;
  66.   end;
  67.   intr($10,regs);
  68. End;
  69. PROCEDURE SwitchTo25; ASSEMBLER;
  70. ASM
  71.    MOV AX,$1114
  72.    INT $10
  73. END;
  74.  
  75. Function GenerateReg:String;
  76.  
  77. Var
  78.   lic,eax,ebx,ecx,edx,edi,esi,ebp:Longint;
  79.   ax,bx,cx,dx,si,bp : word;
  80.   i:integer;
  81.   dummy,MyStr : String8;
  82.  
  83. Begin
  84.   Curs(1);
  85.   ax:=wherex;
  86.   bx:=wherey;
  87.   write('  Enter your name           : ');
  88.   Repeat
  89.     {readln(name);}
  90.     GetInput(Name,'',20,31,bx,0,7,' ',false);
  91.   until Name<>'';
  92.   y:=name;
  93.   Write(#10,#13,'  # of licenses (max 65298) : ');
  94.   ax:=wherex;
  95.   bx:=wherey;
  96.   Repeat
  97.     GetInput(company,'',20,31,bx,0,7,' ',false);
  98.     val(company,lic,bp);
  99.   until (lic>0)and(lic<65299);
  100.   lic:=lic+$237;
  101.   writeln;
  102.   longtohex(lic,mystr);
  103.   for i:=1 to length(mystr) do mystr[i]:=upcase(mystr[i]);
  104.   x:=copy(mystr,5,4);
  105.   write('  Registration code         : ');
  106.   name:=x+name;
  107.   write;
  108.   ebx:=longadd($7eca,0);
  109.   for i:=1 to length(name) do begin
  110.     eax:=longadd($7eca,(longmul(ord(name[i]),ebx)));
  111.     ebx:=longadd(eax,0);
  112. {   write('eax=');
  113.     writeulong(eax,10,' ',16);
  114.     write('ebx=');
  115.     writeulong(ebx,10,' ',16);
  116.     readln;
  117. } end;
  118. {  writeulong(ebx,10,' ',16);}
  119.   longtohex(ebx,mystr);
  120.   for i:=1 to length(mystr) do mystr[i]:=upcase(mystr[i]);
  121.   GenerateReg:=x+'-'+copy(mystr,1,4)+'-'+copy(mystr,5,4)
  122.  
  123.  
  124. end;
  125.  
  126.  
  127. {  end;}
  128.                       
  129.  
  130. Begin
  131.   writeln('       Second Copy v5.21 build 66        ');
  132.   writeln('──────────────|  MiRaMaX  |──────────────');
  133.   writeln('   ▄▄▄   ▄▄▄    ▄▄▄▄▄▄▄▄▄    ▄▄▄▄▄▄▄▄▄   ');
  134.   writeln('   ███   ███    ███          ███▄▄▄      ');
  135.   writeln('   ███▄  ███    ███▄         ███         ');
  136.   writeln('   ▀▀▀▀▀▀▀▀▀    ▀▀▀▀▀▀▀▀▀    ▀▀▀         ');
  137.   writeln('─────────────────────────────────────────');
  138.   writeln(' u N I T E D  c R A C K I N G  f O R C E ');
  139.   writeln('[kEYMAKER]─────────────────────[dEC 1997]');
  140.   Output:=GenerateReg;
  141.   Writeln(Output);
  142.   writeln;
  143.   writeln('Enter this code or copy the generated keyfile');
  144.   writeln('"sc97.cfg" to your installed directory.');
  145.   assign(f,'sc97.cfg');
  146.   rewrite(f);
  147.   writeln(f,'[General]');
  148.   writeln(f,'Settings=8BCD');
  149.   writeln(f,'RegName='+y);
  150.   writeln(f,'RegKey='+output);
  151.   writeln(f,'Version=5.21');
  152.   close(f);
  153.  
  154. end.
  155.