Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/FAQ-S.ZIP/NETNEW.PAS

Pascal/Delphi Source File | 1991-01-31 | 9.5 KB | 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.