269 lines
7.5 KiB
ObjectPascal
269 lines
7.5 KiB
ObjectPascal
uses dos,
|
||
mdek,timejunk;
|
||
|
||
(*
|
||
Execution method:
|
||
MABS [site type] [[site info file] [serial number]]
|
||
*)
|
||
|
||
type infoheaderrec=array[1..6] of byte;
|
||
|
||
const infoheader:infoheaderrec=($FA,$CD,$20,$EF,$02,$AA);
|
||
|
||
var siteinfof:text;
|
||
f:file;
|
||
pdt:packdatetime;
|
||
pstr:array[1..20] of string;
|
||
s,siteinfofile,siteinfos,oversiteinfo:string;
|
||
r:array[1..144] of byte;
|
||
lng,serialnumber:longint;
|
||
chk,chk1,chk2:word;
|
||
res,i,pcount,wanttype:integer;
|
||
c:char;
|
||
vertypes:byte;
|
||
b,notcoded:boolean;
|
||
|
||
function stripcolor(o:string):string;
|
||
var s:string;
|
||
i:integer;
|
||
lc:boolean;
|
||
begin
|
||
s:=''; lc:=FALSE;
|
||
for i:=1 to length(o) do
|
||
if (lc) then lc:=FALSE
|
||
else if ((o[i]=#3) or (o[i]='^')) then lc:=TRUE else s:=s+o[i];
|
||
stripcolor:=s;
|
||
end;
|
||
|
||
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;
|
||
|
||
procedure encryptinfo;
|
||
var s:string;
|
||
i:integer;
|
||
begin
|
||
for i:=13 to 142 do s[i-12]:=chr(r[i]); s[0]:=chr(132);
|
||
s:=encrypt(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;
|
||
|
||
procedure maketruerandom;
|
||
var dt:ldatetimerec;
|
||
ll,ll2:longint;
|
||
begin
|
||
getdatetime(dt);
|
||
with dt do
|
||
ll:=(year-1980)+month+day*hour*min*sec*sec100;
|
||
randseed:=ll;
|
||
end;
|
||
|
||
function aonoff(b:boolean; s1,s2:string):string;
|
||
begin
|
||
if (b) then aonoff:=s1 else aonoff:=s2;
|
||
end;
|
||
|
||
begin
|
||
maketruerandom;
|
||
|
||
siteinfofile:=''; oversiteinfo:='';
|
||
wanttype:=-1; serialnumber:=0;
|
||
|
||
pcount:=paramcount;
|
||
for i:=1 to pcount do pstr[i]:=paramstr(i);
|
||
|
||
{$IFDEF AS1}
|
||
pstr[1]:='9'; pstr[2]:='***'; pstr[3]:='1'; pcount:=3;
|
||
oversiteinfo:='Eric Oman'+^J+#3#7+'Grosse '+#3#0+'Pointe '+#3#4+'Centrale'+
|
||
^J+#3#7+'313-'+#3#0+'885-'+#3#4+'1779'+^J;
|
||
{$ELSE}
|
||
{$IFDEF AS2}
|
||
pstr[1]:='1'; pstr[2]:='***'; pstr[3]:='2'; pcount:=3;
|
||
oversiteinfo:='Todd Bolitho'+^J+'Warp Speed BBS'+^J+'313-544-0405'+^J;
|
||
{$ELSE}
|
||
{$IFDEF AS3}
|
||
pstr[1]:='1'; pstr[2]:='***'; pstr[3]:='3'; pcount:=3;
|
||
oversiteinfo:='Martin Pollard'+^J+'The I/O Bus'+^J+'313-755-7786'+^J;
|
||
{$ELSE}
|
||
{$IFDEF AS4}
|
||
pstr[1]:='1'; pstr[2]:='***'; pstr[3]:='4'; pcount:=3;
|
||
oversiteinfo:='John Dixon (Nikademus)'+^J+'The Ozone BBS'+^J+
|
||
'313-689-2876'+^J;
|
||
{ELSE}
|
||
{$IFDEF AS5}
|
||
pstr[1]:='1'; pstr[2]:='***'; pstr[3]:='5'; pcount:=3;
|
||
oversiteinfo:='Bill Schwartz'+^J+'Electric Eye II BBS'+^J+
|
||
'313-776-8928'+^J;
|
||
{$ENDIF}
|
||
{$ENDIF}
|
||
{$ENDIF}
|
||
{$ENDIF}
|
||
{$ENDIF}
|
||
|
||
if (pcount>=1) then begin
|
||
val(pstr[1],wanttype,i);
|
||
if (pcount>=2) then
|
||
if (pstr[2]='***') then
|
||
siteinfofile:='***'
|
||
else begin
|
||
siteinfofile:=pstr[2];
|
||
assign(f,siteinfofile);
|
||
{$I-} reset(f); {$I+}
|
||
if (ioresult<>0) then begin
|
||
writeln;
|
||
writeln(siteinfofile+': File not found.');
|
||
halt(1);
|
||
end else
|
||
close(f);
|
||
end;
|
||
if (pcount>=3) then val(pstr[3],serialnumber,i);
|
||
end;
|
||
|
||
assign(f,'bbs.ovr');
|
||
{$I-} reset(f,1); {$I+}
|
||
if (ioresult<>0) then begin
|
||
writeln;
|
||
writeln('BBS files not found.');
|
||
halt(1);
|
||
end;
|
||
seek(f,filesize(f)-144);
|
||
blockread(f,r,144,res);
|
||
close(f);
|
||
if (res<>144) then writeln('Errors reading in current data');
|
||
|
||
notcoded:=FALSE;
|
||
for i:=1 to 6 do
|
||
if (r[i]<>infoheader[i]) then notcoded:=TRUE;
|
||
|
||
if (not notcoded) then decryptinfo;
|
||
|
||
if (wanttype=-1) then begin
|
||
serialnumber:=r[20]+r[21] shl 8+r[22] shl 16+r[23] shl 24;
|
||
vertypes:=r[19];
|
||
c:=#0;
|
||
repeat
|
||
if (c<>'?') then begin
|
||
writeln;
|
||
write('Version type = ');
|
||
case (vertypes and $07) of
|
||
$00:writeln('Standard');
|
||
$01:writeln('Alpha'); $02:writeln('Beta');
|
||
$03:writeln('Gamma'); $04:writeln('Special');
|
||
else writeln('Unknown! (',vertypes,')');
|
||
end;
|
||
writeln('Serial number = ',serialnumber);
|
||
writeln('Registration = '+aonoff((vertypes and $08=$08),'Yes','No'));
|
||
writeln('Node membership = '+aonoff((vertypes and $10=$10),'Yes','No'));
|
||
writeln;
|
||
end;
|
||
write('[>'); readln(s); c:=upcase(s[1]);
|
||
if (s<>'') then
|
||
case c of
|
||
'0'..'4':
|
||
begin
|
||
vertypes:=vertypes and ($FF-$07);
|
||
case c of
|
||
'1':vertypes:=vertypes or $01;
|
||
'2':vertypes:=vertypes or $02;
|
||
'3':vertypes:=vertypes or $03;
|
||
'4':vertypes:=vertypes or $04;
|
||
'5':vertypes:=vertypes or $05;
|
||
end;
|
||
end;
|
||
'#':if (length(s)<>1) then begin
|
||
s:=copy(s,2,length(s)-1); val(s,lng,i);
|
||
serialnumber:=lng;
|
||
end;
|
||
'$':begin
|
||
b:=vertypes and $08=$08;
|
||
if (b) then vertypes:=vertypes and ($FF-$08)
|
||
else vertypes:=vertypes or $08;
|
||
end;
|
||
'@':begin
|
||
b:=vertypes and $10=$10;
|
||
if (b) then vertypes:=vertypes and ($FF-$10)
|
||
else vertypes:=vertypes or $10;
|
||
end;
|
||
'?':begin
|
||
writeln;
|
||
writeln('0:Standard');
|
||
writeln('1:Alpha - "<22>"');
|
||
writeln('2:Beta - "<22>"');
|
||
writeln('3:Gamma - "<22>"');
|
||
writeln('4:Special - "<22>"');
|
||
writeln('#xxxxx:Change serial number');
|
||
writeln('$:Toggle registration');
|
||
writeln('@:Toggle node membership');
|
||
writeln;
|
||
writeln('R:elist');
|
||
writeln;
|
||
end;
|
||
end;
|
||
until ((s='') or (c='Q'));
|
||
end else
|
||
vertypes:=wanttype;
|
||
|
||
for i:=1 to 6 do r[i]:=infoheader[i];
|
||
r[19]:=vertypes;
|
||
|
||
reset(f,1);
|
||
if (notcoded) then seek(f,filesize(f))
|
||
else seek(f,filesize(f)-144);
|
||
|
||
getpackdatetime(@pdt);
|
||
r[13]:=pdt[1]; r[14]:=pdt[2]; r[15]:=pdt[3];
|
||
r[16]:=pdt[4]; r[17]:=pdt[5]; r[18]:=pdt[6];
|
||
|
||
r[20]:=(serialnumber and $FF);
|
||
r[21]:=((serialnumber and $FF00) shr 8);
|
||
r[22]:=((serialnumber and $FF0000) shr 16);
|
||
r[23]:=((serialnumber and $FF000000) shr 24);
|
||
|
||
siteinfos:='';
|
||
if (siteinfofile<>'') then
|
||
if (oversiteinfo<>'') then begin
|
||
siteinfos:=oversiteinfo;
|
||
s:='';
|
||
for i:=1 to length(oversiteinfo) do
|
||
if (oversiteinfo[i]=^J) then s:=s+^M^J
|
||
else s:=s+oversiteinfo[i];
|
||
writeln;
|
||
writeln('This Alpha version is licensed to:');
|
||
write(stripcolor(s));
|
||
writeln;
|
||
writeln('WARNING: Giving out this EXE file, or your BBS.EXE or BBS.OVR');
|
||
writeln('files automatically terminates your status as an Alpha site.');
|
||
end else begin
|
||
assign(siteinfof,siteinfofile);
|
||
reset(siteinfof);
|
||
repeat
|
||
readln(siteinfof,s);
|
||
siteinfos:=siteinfos+s+^J;
|
||
until ((eof(siteinfof)) or (length(siteinfos)>118));
|
||
close(siteinfof);
|
||
end;
|
||
if (length(siteinfos)>118) then siteinfos:=copy(siteinfos,1,118);
|
||
r[24]:=length(siteinfos);
|
||
for i:=1 to 118 do r[i+24]:=random(256);
|
||
for i:=1 to length(siteinfos) do r[i+24]:=ord(siteinfos[i]);
|
||
|
||
for i:=1 to 6 do r[i+6]:=random(256); { new encryption indices }
|
||
|
||
chk:=0;
|
||
for i:=13 to 142 do inc(chk,r[i]);
|
||
chk1:=(chk div 6)*5;
|
||
chk2:=(chk div 19)*25;
|
||
r[143]:=chk1 mod 256;
|
||
r[144]:=chk2 mod 256;
|
||
|
||
encryptinfo;
|
||
blockwrite(f,r,144,res);
|
||
if (res<>144) then writeln('Error writing data.');
|
||
close(f);
|
||
end.
|