{$A+,B+,E+,F+,I+,L+,N-,O+,R-,S+,V-}
unit fvtype;

interface

uses
  crt, dos,

  {rcg11172000 no overlay under Linux.}
  {overlay,}

  mdek, myio, timejunk;

procedure findvertypeout(s:string;
                         var vercs:string;
                         var vertype:string;
                         var vertypes:byte;
                         var serialnumber:longint;
                         var siteinfo:string;
                         var sitedatetime:packdatetime);

implementation

type
  infoheaderrec=array[1..6] of byte;

const
  infoheader:infoheaderrec=($FA,$CD,$20,$EF,$02,$AA);

procedure domessage;
var x,y,cx,c1,c2:integer;
    c:char;
begin
  cursoron(FALSE);
  clrscr;
  writeln('             ÛßßÜ ÜßßÜ ÛÜ  Û Û ßßÛßß       ÛÜ ÜÛ Ûßßßß Üßßßß Üßßßß');
  writeln('             Û  Û Û  Û Û ßÜÛ     Û         Û ß Û Ûßßß   ßßßÜ  ßßßÜ');
  writeln('             ßßß   ßß  ß   ß     ß         ß   ß ßßßßß ßßßß  ßßßß');
  writeln;
  writeln('                             Û Û Û ßÛß ßßÛßß Û   Û');
  writeln('                             Û Û Û  Û    Û   ÛßßßÛ');
  writeln('                             ßß ßß ßßß   ß   ß   ß');
  writeln;
  writeln('              ßßÛßß Û   Û Ûßßßß       ÛßßßÜ ÛßßßÜ Üßßßß   ÛÛ  ÛÛÛ');
  writeln('                Û   ÛßßßÛ Ûßßß        ÛßßßÜ ÛßßßÜ  ßßßÜ   ßß  ßßß');
  writeln('                ß   ß   ß ßßßßß       ßßßß  ßßßß  ßßßß    ßß  ßßß');
  writeln;
  writeln;
  writeln('              Analysis of the BBS.EXE and BBS.OVR files has shown');
  writeln('            that they have been tampered with.  Don''t do it again!!');
  writeln('           We - the authors of this BBS - feel it is already a pretty');
  writeln('                 good piece of software... don''t mess with it!');
  writeln;
  c1:=0;

  {rcg11172000 this doesn't fly under Linux. Is this all necessary anyway?}
  repeat
  {
    for x:=39 downto 2 do begin
      cx:=cx mod 3+1;
      case cx of 1:c1:=4; 2:c1:=12; 3:c1:=14; end;
      case cx of 1:c2:=12; 2:c2:=14; 3:c2:=15; end;
      inline($FA);
      for y:=1 to 11 do begin
        mem[vidseg:(160*(y-1)+2*(x-1))+1]:=c1;
        mem[vidseg:(160*(y-1)+2*((79-x)-1))+1]:=c1;
      end;
      delay(1);
      inline($FB);
    end;
  }
  until (keypressed);
  c:=readkey;
  cursoron(TRUE);
  gotoxy(1,19);
  halt(255);
end;

procedure findvertypeout(s:string;
                         var vercs:string;
                         var vertype:string;
                         var vertypes:byte;
                         var serialnumber:longint;
                         var siteinfo:string;
                         var sitedatetime:packdatetime);
var f:file;
    rs:string;
    r:array[1..144] of byte;
    chk,chk1,chk2:word;
    i,res:integer;
    b1,b2:byte;

  procedure decryptinfo;
  var s:string;
      i:integer;
  begin
    for i:=13 to 142 do s[i-12]:=chr(r[i]); s[0]:=chr(132);
    s:=decrypt(s,r[7],r[8],r[9],r[10],r[11],r[12]);
    for i:=13 to 142 do r[i]:=ord(s[i-12]);
  end;

begin
  vertype:='Standard'; vertypes:=0; vercs:='';
  filemode:=0; assign(f,s); reset(f,1);
  seek(f,filesize(f)-144); blockread(f,r,144,res);
  close(f); filemode:=2;

  for i:=1 to 6 do
    if (r[i]<>infoheader[i]) then exit;

  decryptinfo;

  chk:=0;

  for i:=13 to 142 do inc(chk,r[i]);
  chk1:=(chk div 6)*5;
  chk2:=(chk div 19)*25;
  b1:=chk1 mod 256;
  b2:=chk2 mod 256;
  if ((r[143]<>b1) or (r[144]<>b2)) then domessage;
  vertypes:=r[19];
  case (r[19] and $07) of
    $01:begin vercs:='à'; vertype:='Alpha'; end;
    $02:begin vercs:='€'; vertype:='Center'; end;
    $03:begin vercs:='á'; vertype:='Beta'; end;
    $04:begin vercs:='ä'; vertype:='Special'; end;
  else  begin vercs:='';  vertype:='Standard'; end;
  end;
  if (r[19] and $10=$10) then vertype:=vertype+' Node';
  if (r[19] and $08=$08) then begin
    vercs:=vercs+'$';
    if (vertype='Standard') then vertype:='Registered'
                            else vertype:='Registered '+vertype;
  end;
  serialnumber:=r[20]+(r[21] shl 8)+(r[22] shl 16)+(r[23] shl 24);
  for i:=1 to 6 do sitedatetime[i]:=r[12+i];
  siteinfo:='';
  for i:=1 to r[24] do siteinfo:=siteinfo+chr(r[i+24]);
end;

end.