home *** CD-ROM | disk | FTP | other *** search
/ Reverse Code Engineering RCE CD +sandman 2000 / ReverseCodeEngineeringRceCdsandman2000.iso / RCE / Quantico / km / ucfkey03.pas.txt < prev    next >
Encoding:
Text File  |  2000-05-25  |  6.5 KB  |  256 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.  key,name,result:string;
  83.     namec,nameb:array[1..10] of byte;
  84.     named :array[1..80] of byte;
  85.     j:integer;
  86.     ral,rbl,rcl,rdl : byte;
  87.  
  88. Begin
  89.   Curs(1);
  90.   ax:=wherex;
  91.   bx:=wherey;
  92.   write(' ■ Enter your name   : ');
  93.   Repeat
  94.     {readln(name);}
  95.     GetInput(Name,'',20,24,bx,0,7,' ',false);
  96.   until Name<>'';
  97.   key := '0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ?!';
  98.  
  99. {
  100.  
  101.         @loop:    mov cl , [0]
  102.                   inc eax
  103.                   not cl
  104.                   mov [esp + eax + 0B], cl
  105.                   cmp eax, $0000000A
  106.                   jl 00404A1A
  107. }
  108.  
  109.   for i:=1 to 10 do begin
  110.     nameb[i]:=47+i;
  111.     if length(name)>=i then nameb[i]:=ord(name[i]);
  112.     if length(name)+1=i then nameb[i]:=0;
  113.     namec[i]:=not(nameb[i]);
  114.   end;
  115.  
  116. {                 xor esi, esi
  117.                   lea edi, [esp + 6C]
  118.         :00404A30 xor eax, eax
  119.                   mov ecx, $00000007
  120.         :00404A37 mov dl, [esp + esi + 0C]
  121.                   sar dl, cl
  122.                   and dl, 01
  123.                   mov [eax + edi], dl
  124.                   inc eax
  125.                   dec ecx
  126.                   cmp eax, $00000008
  127.         :00404A48 jl 00404A37
  128. }
  129.  
  130.   for j:=0 to 9 do begin
  131.   rcl:=7;
  132.   for i:=1 to 8 do begin
  133.     rdl:=namec[j+1];
  134.     asm
  135.       mov cl,rcl
  136.       mov dl,rdl
  137.       sar dl, cl
  138.       and dl, 1
  139.       mov rdl,dl
  140.     end;
  141.     named[j*8+i]:=rdl;
  142.     dec(rcl);
  143.   end;
  144.  
  145. {
  146.  
  147.                   inc esi
  148.                   add edi, $00000008
  149.                   cmp esi, $0000000A
  150.         :00404A51 jl 00404A30
  151.  
  152. }
  153.   end;
  154.   result:='';
  155.   rcl:=0;
  156.   ral:=1;
  157.   repeat
  158.   rdl:=named[ral];
  159.   rbl:=named[ral+1];
  160.   rdl:= rdl shl 1;
  161.   rdl:=rdl+rbl;
  162.   rbl:=named[ral+2];
  163.   rdl:= rdl shl 1;
  164.   rdl:=rdl+rbl;
  165.   rbl:=named[ral+3];
  166.   rdl:= rdl shl 1;
  167.   rdl:=rdl+rbl;
  168.   rbl:=named[ral+4];
  169.   rdl:= rdl shl 1;
  170.   rdl:=rdl+rbl;
  171.   rbl:=named[ral+5];
  172.   rdl:= rdl shl 1;
  173.   rdl:=rdl+rbl;
  174.   ral:=ral+6;
  175.   inc(rcl);
  176.   result:=result+key[rdl+1];
  177.   until rcl=$d;
  178.  
  179. {                 xor ecx, ecx
  180.                   lea eax, [esp + 6C]
  181.         :00404A59 mov dl, [eax]
  182.                   mov bl , [eax+01]
  183.                   shl dl, 1
  184.                   add dl, bl
  185.  
  186.                   mov bl , [eax+02]
  187.                   shl dl, 1
  188.                   add dl, bl
  189.  
  190.                   mov bl , [eax+03]
  191.                   shl dl, 1
  192.                   add dl, bl
  193.  
  194.                   mov bl , [eax+04]
  195.                   shl dl, 1
  196.                   add dl, bl
  197.  
  198.                   mov bl , [eax+05]
  199.                   shl dl, 1
  200.                   add dl, bl
  201.  
  202.                   add eax, 00000006
  203.                   mov [esp + ecx + 0C], dl
  204.                   inc ecx
  205.                   cmp ecx, 0000000D
  206.                   jl 00404A59
  207.  
  208. }
  209.  
  210.  
  211.  
  212.  
  213. {                  mov eax, [esp + 000000C8]
  214.                   xor ecx, ecx
  215.                   mov edx, eax
  216.                   mov esi, 0000000D
  217.                   mov [edx], ecx
  218.         :00404A9D mov [edx+04], ecx
  219.                   mov [edx+08], ecx
  220.                   mov [edx+0C], cx
  221.                   lea ecx, [esp + 0C]
  222.                   sub ecx, eax
  223.                   movsx byte ptr edx, [ecx + eax]
  224.                   inc eax
  225.                   dec esi
  226.                   mov dl, [esp + edx + 28]
  227.                   mov [eax-01], dl
  228.                   jne 00404AAD
  229.  
  230.                   werwrwjlrk
  231.    end;
  232. }
  233.   writeln;
  234.   write(' ■ Registration code : ');
  235.   writeln(result);
  236.  
  237.  
  238. end;
  239.  
  240.  
  241. {  end;}
  242.  
  243.  
  244. Begin
  245.   writeln('     Action Player v3.0 (c) Bo Yi-Lin    ');
  246.   writeln('──────────────|  MiRaMaX  |──────────────');
  247.   writeln('   ▄▄▄   ▄▄▄    ▄▄▄▄▄▄▄▄▄    ▄▄▄▄▄▄▄▄▄   ');
  248.   writeln('   ███   ███    ███          ███▄▄▄      ');
  249.   writeln('   ███▄  ███    ███▄         ███         ');
  250.   writeln('   ▀▀▀▀▀▀▀▀▀    ▀▀▀▀▀▀▀▀▀    ▀▀▀         ');
  251.   writeln('─────────────────────────────────────────');
  252.   writeln(' u N I T E D  c R A C K I N G  f O R C E ');
  253.   writeln('[kEYMAKER]─────────────────────[dEC 1997]');
  254.   Output:=GenerateReg;
  255. end.
  256.