home *** CD-ROM | disk | FTP | other *** search
- {$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.
-