{inst.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+'32764792387247';
 {Любой набор чисел}
 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;
 s:='Ваш регистрационный код:'+s;
 for k:=1 to length(s) do
 s[k]:=chr((ord(s[k]) xor 911)
                           xor 555);
 key:=s;
end;
{Instal.pas}
procedure inst;
var
 s,s1:string;
 f:file;
{$i inst.pas}
begin
 writeln(' Starting Install '+
            'programm ...');
 writeln('Copyright (c) 1996,'+
           '99 Slepov Inc');
 s:=key;
 s1:=paramstr(0);
 while s1[length(s1)]<>'.' do
 delete(s1,length(s1),1);
 s1:=s1+'KEY';
 assign(f,s1);
 {$i-}
 reset(f,1);
 {$i+}
 if ioresult<>0 then begin
 writeln('Невозможно открыть .KEY '+
                    'файл ...');
 halt(0);
 end;
 blockread(f,s1,length(s));
 close(f);
 delete(s1,length(s1),4);
 delete(s,length(s),3);
 if s1=s then
 writeln('Информация об установки '+
                'корректна ...')
  else
    begin
   writeln('Данная программа не была '+
   'установлена на данном компьютере'+
    ' ...');
   writeln('Install please ...');
   halt(0);
   end;
 end;
{install.pas}
uses dos;
var
 s,s1:string;
 f:file;
{$i inst.pas}
begin
 writeln(' .KEY генератор. Версия '+
                               '1.0');
 writeln('Copyright (c) 1996,99 '+
                        'Slepov Inc');
 s:=key;
 s1:=paramstr(0);
 while s1[length(s1)]<>'.' do
 delete(s1,length(s1),1);
 s1:=s1+'KEY';
 assign(f,s1);
 {$i-}
 rewrite(f,1);
 {$i+}
 if ioresult<>0 then begin
 writeln('Невозможно создать '+
                    '.KEY файл ...');
 halt(0);
 end;
 blockwrite(f,s,length(s));
 close(f);
 writeln(' .KEY файл успешно '+
 'создан. Спасибо за использование.');
 halt(0);
 end.