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 / NET.PAS < prev    next >
Pascal/Delphi Source File  |  1991-01-13  |  5KB  |  184 lines
  1. procedure dounzipnetmail;
  2. var sqlf:file of bulrec;
  3.     mesf:file of message;
  4.     textf:message;
  5.     thefn:sstr;
  6.     filename:sstr;
  7.     b:bulrec;
  8.     f1:file;
  9.     ourf:string;
  10.     ourf2:string;
  11.     numb,cnt:integer;
  12.  
  13.  procedure seekbfile (n:integer);
  14.  begin
  15.    seek (bfile,n-1); che
  16.  end;
  17.  
  18.  function numbuls:integer;
  19.  begin
  20.    numbuls:=filesize(bfile);
  21.  end;
  22.  
  23.  procedure addbul (var b:bulrec);
  24.   var b2:bulrec;
  25.   begin
  26.     assign (bfile,datadir+curboard.shortname+'.MS'+strr(conn));
  27.     reset (bfile);
  28.     if numbuls=0 then b.id:=1 else begin
  29.       seekbfile (numbuls);
  30.       read (bfile,b2);
  31.       if b2.id=65535
  32.         then b.id:=1
  33.         else b.id:=b2.id+1;
  34.     end;
  35.     seekbfile (numbuls+1);
  36.     write (bfile,b);
  37.     close (bfile);
  38.   end;
  39.  
  40.   begin
  41.     openbdfile;
  42.     thefn:=strr(conn)+'NET'+curboard.shortname+'.ZIP';
  43.     filename:='NETRECV'+strr(conn)+'.ZIP';
  44.     ourf:=copy (thefn,1,length(thefn)-4);
  45.     ourf2:=copy (thefn,1,length(filename)-4);
  46.     numb:=filesize(bdfile);
  47.     writeln (usr,'[Working with ',upstring(ourf2),']');
  48.     for cnt:=1 to numb do
  49.     seekbdfile (cnt);
  50.     if curboard.net then begin
  51.       begin
  52.         writeln (usr,'[Status: UnZipping File]');
  53.         delay (100);
  54.         extractzip('',networkdir+thefn,copy (datadir,1,length(datadir)-1));
  55.         assign(sqlf,networkdir+ourf+'.SQ'+strr(conn));
  56.   {$I+} reset (sqlf); {$I-}
  57.         assign(mesf,networkdir+ourf+'.ME'+strr(conn));
  58.   {$I+} reset (mesf); {$I-}
  59.       end;
  60.       writeln (usr,'[Status: Writing Messages to Message Base]');
  61.       while not eof(sqlf) do
  62.       begin
  63.         read(sqlf,b);
  64.         read(mesf,textf);
  65.         b.line:=maketext(textf);
  66.         addbul(b);
  67.         delay (10);
  68.       end;
  69.       close(sqlf);
  70.       close(mesf);
  71.       erase(sqlf);
  72.       erase(mesf);
  73.       writeln(usr,'[Status: UnZipping and Processing Complete. Deleting FAQNet-Paket]');
  74.       assign (f1,networkdir+thefn);
  75.       erase (f1);
  76.      end;
  77.     closebdfile;
  78.   end;
  79.  
  80.   function checklog:string;
  81.   var f:text;
  82.       xferfile,code,l:anystr;
  83.       c:string[1];
  84.       done:boolean;
  85.       x:integer;
  86.  
  87.   function parsespaces (s:anystr):anystr;
  88.   var p,pee,xy:integer;
  89.       k,j:char;
  90.       r:anystr;
  91.   begin
  92.    parsespaces:=s;
  93.    r:=s;
  94.    repeat
  95.    p:=pos (' ',r);
  96.    if p>0 then begin
  97.     delete (r,p,1);
  98.    end;
  99.    until p=0;
  100.    parsespaces:=r;
  101.   end;
  102.  
  103.   begin
  104.    checklog:=' ';
  105.    if not exist (dszlogname) then begin
  106.     writeln (^G'DSZLOG Error.'^M);
  107.     exit;
  108.    end;
  109.    assign (f,dszlogname);
  110.    reset (f);
  111.    code:='';
  112.    xferfile:='';
  113.    readln (f,l);
  114.    code:=copy (l,1,1);
  115.    c:='';
  116.    x:=50;
  117.    repeat
  118.     x:=x+1;
  119.     if c='/' then c:='\';
  120.     xferfile:=xferfile+c;
  121.     c:=copy (l,x,1);
  122.    until c=' ';
  123.    textclose (f);
  124.    xferfile:=parsespaces (xferfile);
  125.    checklog:=xferfile;
  126.    writeln (usr,'[Code: ',upstring(code[1]),'] [Filename: ',upstring(xferfile),']');
  127.   end;
  128.  
  129.   procedure rnetmail;
  130.   var yo:byte;
  131.       f1:file;
  132.       thefn:sstr;
  133.       a:sstr;
  134.       filename2,filename3:file;
  135.   begin
  136.     clrscr;
  137.    {if exist (dszlogname) then begin
  138.       assign (f1,dszlogname);
  139.       erase (f1);
  140.     end;}
  141.    {writestr('Netmail Conference [1-5]: *');
  142.     conn:=valu(input);}
  143.     writeln(usr,'[Status: Receiving Net Mail]');
  144.     assign(filename3,networkdir+'NETSEND'+strr(conn)+'.ZIP');
  145.     if exist(networkdir+'NETSEND'+strr(conn)+'.ZIP') then
  146.     rename(filename3,networkdir+'NETTEMP'+strr(conn)+'.ZIP');
  147.     yo:=doext ('R','Z',networkdir,'NETSEND'+strr(conn)+'.ZIP',baudrate,usecom);
  148.    {yo:=0;}
  149.     if yo=0 then begin
  150.       writeln(usr,^M^M);
  151.       writeln(usr,'[Status: Checking File Received]');
  152.       assign(filename2,networkdir+'NETSEND'+strr(conn)+'.ZIP');
  153.       rename(filename2,networkdir+'NETRECV'+strr(conn)+'.ZIP');
  154.       thefn:='NETRECV'+strr(conn)+'.ZIP';
  155.       writeln(usr,'[File Received: ',upstring(thefn),']');
  156.       a:=copy (thefn,length(thefn)-3,4);
  157.       if not (match(a,'.ZIP')) then begin
  158.         writeln (usr,'[Status: File Received is not a ZipFile, Deleting]');
  159.         assign (f1,networkdir+thefn);
  160.         erase (f1);
  161.         writeln (usr,'[File Deleted]');
  162.       end else begin
  163.         if netsubs then begin
  164.         dounzipnetmail;
  165.         end;
  166.         if netnews then begin
  167.         chdir (networkdir);
  168.         extractzip (networkdir+'NETSEND.ZIP','NEWS.NET',networkdir);
  169.         chdir (faqdir);
  170.         end;
  171.         if netupgrade then begin
  172.         chdir (networkdir);
  173.         extractzip (networkdir+'NETSEND.ZIP','UPGRADE.ZIP',networkdir);
  174.         end;
  175.       end;
  176.     end;
  177.     assign(filename3,networkdir+'NETTEMP'+strr(conn)+'.ZIP');
  178.     if exist(networkdir+'NETTEMP'+strr(conn)+'.ZIP') then
  179.     rename(filename3,networkdir+'NETSEND'+strr(conn)+'.ZIP');
  180.     unum:=-1;
  181.     delay (100);
  182.     writeln ('Netmail Package Processed.');
  183.     disconnect;
  184.   end;