{Inst1.pas}
function key:string;
var
 k,time:longint;
 s,s1:string;
 ch:char;
 r:registers;
begin
 s:='';
 time:=0;
 for k:=1 to $FFFF  do
 time:=time+mem[$f000:k];
 str(time,s);
 s:=s+'75934785892239';
 {любой набор чисел}
 with r do begin
 ah:=$30;
 msdos(r);
 str(al,s1);
 s:=s+s1+'.';
 str(ah,s1);
 s:=s+s1;
 end;
 case mem[$f00:$fffe] of
 $FF:ch:='P';
 $FE:ch:='X';
 $FD:ch:='J';
 $FC:ch:='T'
 else ch:='A';
 end;
 s:=s+chr(mem[$f00:$fffe]);
 s:=s+chr(memw[0:$413]);
 port[$70]:=$14;
 if port[$71] and 2 <> 0 then
   s:=s+'666' else s:=s+'555';
 for k:=0 to 7 do
 s:=s+chr(mem[$f000:$fff5+k]);
 s:=s+'Copyright (c) 1996,99 Slepov '+
 'Inc. Привет всем любителям ВЗЛОМА !!!';
 for k:=1 to length(s) do
 s[k]:=chr((ord(s[k]) xor 666)
                            xor 13);
 s:=s;
 k:=0;
 for time:=1 to length(s) do
    k:=k+ord(s[time]);
 str(k,s);
 s:=s+'-'+ch;
 key:=s;
end;
{Instal1.pas}
procedure inst_666;
 const zap=10;
var
s,s1,s2,s3,s4,sr:string;
 f:file;
 i,i1,i2,i3:integer;
 label 1;
{$i inst1.pas}
procedure reg_1(ke:char;s1:string;
                    var s:string);
 var
  f:file;
  l:longint;
begin
assign(f,paramstr(0));
reset(f,1);
l:=filesize(f);
seek(f,l);
if ke='c' then begin
 blockwrite(f,s1,succ(length(s1)));
 seek(f,l);
 truncate(f);
 end
 else
 begin
 seek(f,l+25);
 blockwrite(f,s,1);
 seek(f,l);
 blockread(f,s,25);
 seek(f,l);
 truncate(f);
 end;
 close(f);
end;
function reg_2(sr:string):boolean;
var
 ss:string;
 i,i1:integer;
begin
reg_2:=false;
ss:=sr;
ss:=copy(ss,1,5);
if ss='Start' then begin
ss:=sr;
delete(ss,1,6);
val(ss,i,i1);
if i<zap then begin
 inc(i);
 str(i,ss);
 ss:='Start '+ss;
 reg_1('c',ss,sr);
 end
 else
 if (paramcount<>0)and
   (paramstr(1)='/$') then
  else
 begin
  writeln('Ваш лимит использования программы истек ... ');
  writeln('Ваш регистрационный номер-',s4);
  halt;
  end;
 end
  else
    reg_2:=true;
 end;
begin
 writeln('Инсталлятор Версия 1.0');
 writeln('Copyright (c) 1996,99 Slepov Inc');
 s:=key;
 s3:=s;
 s4:=s;
 for i3:=1 to 2 do
 delete(s3,length(s3),1);
 val(s3,i3,i2);
 s1:='';
 for i:=1 to length(s) do begin
 str(ord(s[i]),s2);
 s1:=s1+s2;
 end;
 for i:=1 to length (s1) do
 s1[i]:=chr((ord(s1[i]) xor 123)
                       xor 589);
 i1:=0;
 for i:=1 to length(s1) do
              i1:=i1+ord(s1[i]);
 for i2:=1 to i3 do begin
 s1:='';
 for i:=1 to length(s) do
 begin
 str(ord(s[i]),s2);
 s1:=s1+s2;
 end;
 for i:=1 to length(s1) do
            i1:=i1+ord(s1[i]);
 end;
 str(i1,s);
 reg_1(' ','',sr);
 if sr='' then begin
 writeln('Программа запущена впервые'+
 ' ... Идет создание системной информации ...');
 reg_1('c','Start 0',sr);
 writeln('Перезапустите программу ...');
 halt;
 end;
 if reg_2(sr)=false then
  writeln('Ваш регистрационный номер-',s4);
 if paramcount<>0 then
 begin
 s1:=paramstr(1);
 if (s1[1]='/')and(s1[2]='$')
 then s1:=paramstr(2)
  else goto 1;
 if s1<>s then
             begin
 writeln('Регистрационный ключ неправильный ...');
 exit;
 end;
 if s1=s then
 begin
 reg_1('c',s,s1);
 writeln('Спасибо за регистрацию ...');
 halt(0);
 end;end else
  1:
  if sr=s then writeln('Данная копия продукта уже '+
'зарегистрирована ...')
  else
  if reg_2(sr)=false then
 else
  begin
   writeln('Зарегистрируйте данную программу ...');
    writeln('Ваш регистрационный номер-',s4);
    reg_1('c','Start 0',sr);
   halt(0);
   end;
end;
{Instal11.pas}
uses dos;
var
 s,s1,s2,s3:string;
 i,i1,i3,i2:integer;
begin
 writeln('Генератор ключей. Версия 1.0');
 writeln('Copyright (c) 1996,99 Slepov Inc');
 write('Введите регистрационный номер:');
 readln(s);
 s3:=s;
 for i3:=1 to 2 do
 delete(s3,length(s3),1);
 val(s3,i3,i2);
 s1:='';
 for i:=1 to length(s) do begin
 str(ord(s[i]),s2);
 s1:=s1+s2;
 end;
 for i:=1 to length (s1) do
 s1[i]:=chr((ord(s1[i]) xor 123)
 xor 589);
 i1:=0;
 for i:=1 to length(s1) do
 i1:=i1+ord(s1[i]);
 for i2:=1 to i3 do
 begin
 s1:='';
 for i:=1 to length(s) do
 begin
 str(ord(s[i]),s2);
 s1:=s1+s2;
 end;
 for i:=1 to length(s1) do
 i1:=i1+ord(s1[i]);
 end;
 str(i1,s);
 writeln('Ваш регистрационный номер-',s);
 halt(0);
end.