home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The World of Computer Software
/
World_Of_Computer_Software-02-385-Vol-1of3.iso
/
f
/
faq-s.zip
/
NETNEW.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-01-31
|
10KB
|
414 lines
{$R-,S-,I-,D-,F+,V-,B-,N-,L+,O+ }
{$M 65500,0,0 }
unit netnew;
interface
uses crt,dos,overlay,mainr2,overret1,modem,gensubs,gentypes,subs2,
protocol,subs1,configrt,statret,msg,subs3;
procedure Startnet;
procedure NewNetSend;
procedure DoFeatures;
implementation
type
SubSetType = set of 0..255;
var
GotPosts:boolean;
procedure Notice(Data,data2:lstr);
begin
writeln(usr,^M,data,^M,data2,^M);
end;
procedure killdir;
var r:registers; ffinfo:searchrec;
tpath:anystr; b:byte; cnt:integer; mm:text;
begin
{Delete everything in the net directory}
end;
function checkesc:boolean;
var
ch: char;
begin
if keypressed then
ch:=readkey;
if ch=#27 then
checkesc:=true
else
checkesc:=false;
if not carrier then writeln(usr,'No Carrier Detected!');
if not carrier then checkesc:=true else
checkesc:=false;
end;
procedure co(color:byte);
begin
textcolor(color);
end;
procedure send(xx:anystr);
var cnt:integer;
begin
for cnt:=1 to length(xx) do begin
sendchar (xx[cnt]);
write (usr,xx[cnt]);
end;
sendchar(#13);
write(usr,#13);
end;
procedure zipfile(filename1,filename2:lstr);
begin
writeln(usr,'Adding ',filename2,' to ZIP file: ',filename1);
addtozip(networkdir+filename1,networkdir+filename2);
end;
procedure unzipfile(filename1,filename2:lstr);
begin
writeln(usr,'Unzipping ',filename2,' from ',filename1);
extractzip(filename2,networkdir+filename1,networkdir);
end;
function waitfor(what:lstr):boolean;
var
s:string;
done:boolean;
cnt:longint;
begin
co(14);
done:=false;
cnt:=now+300;
s:='';
repeat
repeat until (numchars>0) or (cnt<now);
while numchars>0 do begin
delay(20);
s:=s+getchar;
write(usr,s[length(s)]);
end;
if pos(what,s)>0 then done:=true;
if checkesc then done:=true; {bail if esc pressed}
until done or (cnt<now);
waitfor:=done;
co(4);
if done=false then writeln(usr,'Did not find what was sought.');
end;
procedure download(target:sstr);
begin
modemoutlock:=true;
co(11);
exec(getenv('COMSPEC'),' /C dsz port '+strr(usecom)+' speed '+
strlong(defbaudrate)+' rz -y '+networkdir+target);
modemoutlock:=false;
co(14);
nobreak:=true;
end;
procedure upload(source:sstr);
begin
modemoutlock:=true;
co(10);
exec(getenv('COMSPEC'),' /C dsz port '+strr(usecom)+' speed '
+strlong(defbaudrate)+' ha slow sz -n '+networkdir+source);
modemoutlock:=false;
co(14);
nobreak:=true;
end;
Procedure PrepareStats; {Prepare user data for CelerityNet}
var cnt:byte;
u:userrec;
{stat:UserNodeInfoRec;
statf:file of UserNodeInfoRec;}
begin
{Unused}
end;
procedure processposts(host:boolean);
var cnt:integer;
b:NetPostRec;
temp:file of NetPostRec;
begin
if host then assign(temp,networkdir+'posts.net') else
assign(temp,networkdir+'posts.new');
reset(temp);
for cnt:=1 to filesize(temp) do begin
read(temp,b);
writeln(usr,'Moving post #',cnt,' to net sub ',b.netidnum);
(* MoveToSub(b); {This routine should post it on the correct sub. Again,
my implementation is VERY Celerity-specific}
*)
end;
close(temp);
modemoutlock:=true;
erase(temp);
modemoutlock:=false;
end;
procedure choosesubs(var SubSet: SubSetType);
begin
{ This code has all been deleted as it would not be appropriate to any other
system than Celerity. Go ahead and make your subset of subs to write to a
file (scanning through your subs). If you're lazy, just have the sysops
make a seperate file on their disk and copy that over}
end;
procedure s_postman;
var
SubSet: SubSetType;
x: byte;
f:file;
begin
unzipfile('incom.zip','posts.new');
writeln(usr,'Processing Posts');
processposts(false);
end;
procedure s_mailman;
begin
end;
procedure s_statman;
begin
end;
procedure s_bbsman;
begin
unzipfile('incom.zip','bbslist.dat');
exec(getenv('COMSPEC'),' /C copy '+networkdir+'bbslist.dat '+bbsdatadir+'bbslist.dat>nul');
exec(getenv('COMSPEC'),' /C del '+networkdir+'bbslist.dat>nul');
end;
procedure s_gossip;
begin
unzipfile('incom.zip','rumors.dat');
exec(getenv('COMSPEC'),' /C copy '+networkdir+'rumors.dat '+bbsdatadir+'rumors.dat>nul');
exec(getenv('COMSPEC'),' /C del '+networkdir+'rumors.dat>nul');
end;
procedure s_pollster;
begin
Notice('The Pollster','');
{RmWin;}
end;
procedure s_netnews;
begin
unzipfile('incom.zip','news.net');
Notice('Receiving Net News','');
exec(getenv('COMSPEC'),' /C copy '+networkdir+'news.net '+faqdir+'news.net>nul');
exec(getenv('COMSPEC'),' /c del '+networkdir+'news.net>nul');
{Rmwin;}
end;
procedure s_stork;
begin
Notice('Receiving the New Baby','');
unzipfile('incom.zip','updates.zip');
{Rmwin;}
end;
function docall:boolean;
var
resultstr,moo:lstr;
result,x:integer;
cnt:longint;
begin
co(4);
result:=0;
{if (featureb or featurec) then exit;}
setparam(usecom,defbaudrate,false);
while numchars>0 do moo:=getchar;
delay(500);
writeln(usr,'Dialing number..');
{writeln(usr,'(Fuck the aesthetics)');}
if (length(extender)>0) and (length(hostphone)>0)
then dialnumber(extender+hostphone) else if length(hostphone)>0 then dialnumber (hostphone);
writeln(usr,'Waiting for carrier...');
while numchars>0 do moo:=getchar;
cnt:=now+60;
repeat
delay(100);
until (numchars>1) or (cnt>now) or (keypressed);
cnt:=now+10;
repeat
inc(cnt);
delay(200);
ResultStr:='';
moo:='';
while numchars>0 do resultstr:=resultstr+getchar;
for x:=1 to length(resultstr) do
if ord(resultstr[x])<>13 then moo:=moo+resultstr[x];
resultstr:=moo;
val(resultstr,result,x);
if (result=11) or (result=2) then
resultstr:='';
until (length(resultstr)>0) or (cnt<now);
val(resultstr,result,x);
writeln(usr,'The Result Code is ',result);
delay(1000);
case result of
0,1,10,13,17,23,27,28,29,19,14:begin
docall:=true;
writelog(21,2,'');
end
else begin
docall:=false;
writeln(21,3,'');
end;
end;
end;
procedure preparepack;
var i:byte;
f:text;
subset:subsettype;
begin
ChooseSubs(subset);
assign(f,networkdir+'SENDSUBS');
rewrite(f);
for i:=1 to 255 do if i in subset then writeln(f,i);
i:=0;
write(f,i);
textclose(f);
exec(getenv('COMSPEC'),' /c ren '+networkdir+'posts.out posts.net >nul');
zipfile('outgo.zip','posts.net');
zipfile('outgo.zip','bbslist.new');
zipfile('outgo.zip','rumors.new');
exec(getenv('COMSPEC'),' /c del '+networkdir+'*.new >nul');
zipfile('outgo.zip','sendsubs');
exec(getenv('COMSPEC'),' /c del '+networkdir+'sendsubs >nul');
end;
procedure dofeatures;
var cnt:longint;
begin
writeln(usr,'Extracting net data...');
if featurea then s_postman;
if featureb then s_mailman;
if featurec then s_statman;
if featured then s_bbsman; {How about making feature an array?}
if featuree then s_gossip; {And making this a case}
if featuref then s_netnews;
if featureg then s_pollster;
if featureh then s_stork;
if featurej then ;
end;
procedure StartNet;
begin
writestr ('Node:*');
writestr (^M'Pass:*');
if not match(input,netpas) then begin
hangupmodem; if local then halt (2); end;
delay(50);
writestr ('Features:*');
download ('OUTGO.ZIP');
while numchars>0 do write(usr,getchar);
writeln('*Sending Packet*');
preparepack;
upload('INCOM.ZIP');
hangupmodem; if local then halt (2);
sendmodemstr ('~ATH1|',true);
writeln('Processing Data');
DoFeatures;
killdir;
delay(1000);
sendmodemstr ('~ATH|',true);
end;
procedure NewNetsend;
var
netfile:text;
cnt:integer;
features:string[10];
subset:subsettype;
begin
if not docall then begin
co(4);
writeln('Failed.');
hangupmodem;
delay(1000);
exit;
end;
GotPosts:=false;
co(14);
clrscr;
online:=true;local:=false;modemoutlock:=false;modeminlock:=false;
cnt:=0;
while (numchars<10) and (cnt<1000) do begin
delay(10);
inc(cnt);
end;
if checkesc then exit;
while(numchars>0) do begin
write(usr,getchar);
delay(10);
end;
send('New Net Buddy!');
if not waitfor('Node:') then exit;
send(strr(netnum));
if not waitfor('Pass:') then exit;
send(netpas);
delay(50);
if checkesc then exit; {bail if esc pressed}
if not waitfor('Features:') then exit;
features:='';
if featurea then features:=features+'A';
if featured then features:=features+'D';
if featured then features:=features+'E';
if featured then features:=features+'F';
send(features);
PreparePack;
Upload('OUTGO.ZIP');
if not carrier then begin
writeln(usr,^M^M'Carrier lost. Aborting netcall.');
exit;
end else
killdir;
while numchars>0 do write(usr,getchar);
delay(10000);
if not waitfor('*Sending Packet*') then exit;
download('INCOM.ZIP');
hangupmodem;
sendmodemstr ('~ATH1|',true);
writeln('Processing Data');
DoFeatures;
killdir;
netmade:=true;
writestatus;
writelog(21,4,'');
delay(1000);
sendmodemstr ('~ATH|',true);
end;
begin
end.