142 lines
4.0 KiB
ObjectPascal
142 lines
4.0 KiB
ObjectPascal
{$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.
|