{$M $4000,0,65536}       {* Set heap size to zero !!! *}

Program UniversialKeymaker;

uses palette,dos,crt,keyinput;

{$L ULONGS.OBJ}                         { link in the assembly code }

FUNCTION LongADD (Addend1,Addend2:LONGINT):LONGINT;   EXTERNAL;

FUNCTION LongSUB (LongWord,Subtrahend:LONGINT):LONGINT;  EXTERNAL;

FUNCTION LongMUL (Multiplicand,Multiplier:LONGINT):LONGINT; EXTERNAL;

FUNCTION LongDIV (Dividend,Divisor:LONGINT):LONGINT;  EXTERNAL;

FUNCTION LongMOD (Dividend,Divisor:LONGINT):LONGINT;  EXTERNAL;

PROCEDURE WriteULong (LongWord:LONGINT;     { the longword          }

                      Width:BYTE;           { _minimum_ field width }

                      FillChar:CHAR;        { leading space char    }

                      Base:BYTE); EXTERNAL; { number base 2..26     }



Var

  sk                         : array[1..8000] of byte absolute $b800:0000;

  i,numwritten:integer;

  ToF:File;

  Output : String;

  f:text;

  x,y,Name,Company:String;

Type

  String8 = String[8];





Const

  AskName=1;

  AskCompany=0;





Procedure LongToHex(AnyLong : LongInt; Var HexString : String8);



Var

  ALong : LongInt;

  ch    : Char;

  Index : Byte;

begin

  HexString := '00000000';                  { default to zero   }

  Index := Length(HexString);               { String length     }

  While AnyLong <> 0 do

  begin                                     { loop 'til done    }

    ch := Chr(48 + Byte(AnyLong) and $0F);  { 0..9 -> '0'..'9'  }

    if ch > '9' then

      Inc(ch, 39);                           { 10..15 -> 'A'..'F'}

    HexString[Index] := ch;                 { insert Char       }

    Dec(Index);                             { adjust chr Index  }

    AnyLong := AnyLong SHR 4;               { For next nibble   }

  end;

end;



Procedure Curs(n:integer);



Var regs : registers;



Begin

  regs.ah:=1;

  case n of

  0 : begin

        regs.cl:=32;

        regs.ch:=32;

      end;

  1 : begin

        regs.cl:=8;

        regs.ch:=7;

      end;

  end;

  intr($10,regs);

End;

PROCEDURE SwitchTo25; ASSEMBLER;

ASM

   MOV AX,$1114

   INT $10

END;



Function GenerateReg:String;



Var

  lic,eax,ebx,ecx,edx,edi,esi,ebp:Longint;

  ax,bx,cx,dx,si,bp : word;

  i:integer;

  dummy,MyStr : String8;

 key,name,result:string;

    namec,nameb:array[1..10] of byte;

    named :array[1..80] of byte;

    j:integer;

    ral,rbl,rcl,rdl : byte;



Begin

  Curs(1);

  ax:=wherex;

  bx:=wherey;

  write(' ž Enter your name   : ');

  Repeat

    {readln(name);}

    GetInput(Name,'',20,24,bx,0,7,' ',false);

  until Name<>'';

  key := '0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ?!';



{



        @loop:    mov cl , [0]

                  inc eax

                  not cl

                  mov [esp + eax + 0B], cl

                  cmp eax, $0000000A

                  jl 00404A1A

}



  for i:=1 to 10 do begin

    nameb[i]:=47+i;

    if length(name)>=i then nameb[i]:=ord(name[i]);

    if length(name)+1=i then nameb[i]:=0;

    namec[i]:=not(nameb[i]);

  end;



{                 xor esi, esi

                  lea edi, [esp + 6C]

        :00404A30 xor eax, eax

                  mov ecx, $00000007

        :00404A37 mov dl, [esp + esi + 0C]

                  sar dl, cl

                  and dl, 01

                  mov [eax + edi], dl

                  inc eax

                  dec ecx

                  cmp eax, $00000008

        :00404A48 jl 00404A37

}



  for j:=0 to 9 do begin

  rcl:=7;

  for i:=1 to 8 do begin

    rdl:=namec[j+1];

    asm

      mov cl,rcl

      mov dl,rdl

      sar dl, cl

      and dl, 1

      mov rdl,dl

    end;

    named[j*8+i]:=rdl;

    dec(rcl);

  end;



{



                  inc esi

                  add edi, $00000008

                  cmp esi, $0000000A

        :00404A51 jl 00404A30



}

  end;

  result:='';

  rcl:=0;

  ral:=1;

  repeat

  rdl:=named[ral];

  rbl:=named[ral+1];

  rdl:= rdl shl 1;

  rdl:=rdl+rbl;

  rbl:=named[ral+2];

  rdl:= rdl shl 1;

  rdl:=rdl+rbl;

  rbl:=named[ral+3];

  rdl:= rdl shl 1;

  rdl:=rdl+rbl;

  rbl:=named[ral+4];

  rdl:= rdl shl 1;

  rdl:=rdl+rbl;

  rbl:=named[ral+5];

  rdl:= rdl shl 1;

  rdl:=rdl+rbl;

  ral:=ral+6;

  inc(rcl);

  result:=result+key[rdl+1];

  until rcl=$d;



{                 xor ecx, ecx

                  lea eax, [esp + 6C]

        :00404A59 mov dl, [eax]

                  mov bl , [eax+01]

                  shl dl, 1

                  add dl, bl



                  mov bl , [eax+02]

                  shl dl, 1

                  add dl, bl



                  mov bl , [eax+03]

                  shl dl, 1

                  add dl, bl



                  mov bl , [eax+04]

                  shl dl, 1

                  add dl, bl



                  mov bl , [eax+05]

                  shl dl, 1

                  add dl, bl



                  add eax, 00000006

                  mov [esp + ecx + 0C], dl

                  inc ecx

                  cmp ecx, 0000000D

                  jl 00404A59



}









{                  mov eax, [esp + 000000C8]

                  xor ecx, ecx

                  mov edx, eax

                  mov esi, 0000000D

                  mov [edx], ecx

        :00404A9D mov [edx+04], ecx

                  mov [edx+08], ecx

                  mov [edx+0C], cx

                  lea ecx, [esp + 0C]

                  sub ecx, eax

                  movsx byte ptr edx, [ecx + eax]

                  inc eax

                  dec esi

                  mov dl, [esp + edx + 28]

                  mov [eax-01], dl

                  jne 00404AAD



                  werwrwjlrk

   end;

}

  writeln;

  write(' ž Registration code : ');

  writeln(result);





end;





{  end;}





Begin

  writeln('     Action Player v3.0 (c) Bo Yi-Lin    ');

  writeln('ÄÄÄÄÄÄÄÄÄÄÄÄÄÄ|  MiRaMaX  |ÄÄÄÄÄÄÄÄÄÄÄÄÄÄ');

  writeln('   ÜÜÜ   ÜÜÜ    ÜÜÜÜÜÜÜÜÜ    ÜÜÜÜÜÜÜÜÜ   ');

  writeln('   ŪŪŪ   ŪŪŪ    ŪŪŪ          ŪŪŪÜÜÜ      ');

  writeln('   ŪŪŪÜ  ŪŪŪ    ŪŪŪÜ         ŪŪŪ         ');

  writeln('   ßßßßßßßßß    ßßßßßßßßß    ßßß         ');

  writeln('ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ');

  writeln(' u N I T E D  c R A C K I N G  f O R C E ');

  writeln('[kEYMAKER]ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ[dEC 1997]');

  Output:=GenerateReg;

end.