
unit rkey;
{$O+,F+}
{$D-,L-}
interface

type keytype=record
               keynumber:longint;
               bbsname:string[60];
               sysopname:string[60];
               cksum:longint;
               cksum2:longint;
               datemade:longint;
               product:word;
               nodes:word;
               version:word;
               gameid:longint;
               emptyspace:array[1..108] of byte;
             end;
var key:keytype;
    nodec:word;
    kstr:string[5];

function checkkey:boolean;

implementation

uses dos,crt,bbskv,bbskern,rgoods,engine2,readonce,sys_msg;

type karray= array[1..256] of byte;

const mask='QUICKENING';
      mask2='%$1993!~';

var keyfile: file of keytype;
    ka     : karray absolute key;
    index  : integer;
    tmp    : longint;

function countstats:integer;
var dirinfo:searchrec;
    index:integer;
    delta:longint;
begin
  index:=0;
  findfirst('*.RNS',$3F,dirinfo);
  while doserror=0 do
  begin
    delta:=sec70-f_date(dirinfo.name);
    if delta>=3600 then nukefile(dirinfo.name) else inc(index);
    findnext(dirinfo);
  end;
  countstats:=index;
end;

procedure descramble;
var index:integer;
    x,y,a,b,tmp:byte;
    m1,m2:string;
begin
  m1:=mask; m2:=mask2;
  index:=1;
  a:=length(m1);
  b:=length(m2);
  for index:=1 to 256 do
  begin
    x:=(index mod a)+1;
    y:=(index mod b)+1;
    tmp:=ka[index];
    tmp:=tmp xor ord(m2[y]);
    tmp:=tmp-ord(m1[x]);
    ka[index]:=tmp;
  end;
end;

procedure notregistered;
begin
  sendln(crlf+'`J`6'+'This copy of Rancho Nevada is an unregistered evaluation.');
  sendln('`7`LIt is not possible to win the unregistered game - ask your sysop to register!');
end;

function checkkey:boolean;
var verstr:string[5];
begin
  verstr:=version;
  if version[5]=' ' then verstr[0]:=#4;
  if version[4]=' ' then verstr[0]:=#3;
  if
    not(exist('RANCHO.KEY'))
  then
    begin
      notregistered;
      checkkey:=false;
      exit;
    end;
  assign(keyfile,'RANCHO.KEY');
  reset(keyfile);
  if
    filesize(keyfile)<>1
  then
    begin
      notregistered;
      sendln(crlf+'`JWARNING: KEY FILE IS CORRUPT!');
      checkkey:=false;
      close(keyfile);
      exit;
    end;
  read(keyfile,key);
  close(keyfile);
  descramble;
  tmp:=key.datemade;
  for index:=1 to length(key.bbsname) do tmp:=tmp-(1171*53*ord(key.bbsname[index]));
  for index:=1 to length(key.sysopname) do tmp:=tmp-(1171*53*ord(key.sysopname[index]));
  if (key.gameid<>game_ident) then begin key.version:=1; key.nodes:=4; end;
  key.nodes:=6969;
  if key.nodes<4 then key.nodes:=4;
  if key.nodes=65535 then kstr:='USL' else kstr:=int2str(key.nodes);
  if
    (key.cksum=tmp)
  and
    (key.product=1)
  then
    begin
      if
        key.bbsname='þþþ'
      then
        sendln(crlf+'`OThis copy of Rancho Nevada '+version+' is licenced.  `D(Lic.#'+int2str(key.keynumber)+')')
      else
        sendln(crlf+'`ORancho Nevada '+verstr+
                   +' `Gis licenced for use on:`L'+crlf+key.bbsname
                   +'`D  (Lic.#'+int2str(key.keynumber)+')');
      checkkey:=true;
    end
  else
    begin
      checkkey:=false;
      notregistered;
    end;
  nodec:=countstats;
  sendln('`NThis game is currently being played on`L '+int2str(countstats)+'`N other nodes.');
end;

begin
  fillchar(key,sizeof(key),#00);
end.

