Skip to content

Latest commit

 

History

History
141 lines (123 loc) · 4.04 KB

fvtype.pas

File metadata and controls

141 lines (123 loc) · 4.04 KB
 
Nov 25, 2000
Nov 25, 2000
1
{$A+,B+,E+,F+,I+,L+,N-,O+,R-,S+,V-}
Nov 18, 2000
Nov 18, 2000
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
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.