home *** CD-ROM | disk | FTP | other *** search
/ Jason Aller Floppy Collection / 189.img / TCS120S.ZIP / NETSEND.PAS < prev    next >
Pascal/Delphi Source File  |  1987-06-17  |  4KB  |  169 lines
  1. Overlay Procedure Pnet_Send;
  2.   var Ss:anystr;
  3.   Chrr:char;
  4.   Simplex:boolean;
  5.   jo:integer;
  6.   finished:boolean;
  7.  
  8. procedure getitall;
  9. begin
  10. {while numchars>0 do Write (getchar);}
  11. end;
  12.  
  13. procedure send(xx:anystr);
  14. var cnt:integer;
  15.  begin
  16.         for cnt:=1 to length(xx) do begin
  17.              sendchar (xx[cnt]);write (usr,xx[cnt]);end;
  18.  end;
  19.  
  20. PROCEDure send_The_file (xx:lstr);
  21. var dummm:boolean;
  22. jo:text;
  23. begin
  24.    Writeln (Usr,' ■ Je fourre les filles! ');
  25.    ymodem:=false;super:=false;wxmodem:=false;kermit:=false;zmodem:=false;
  26.    delay (3000);
  27.    clearitall;
  28.    dummm:=false;
  29.    repeat until (numchars>0) or hungupon or keypressed;
  30.  
  31.     dummm:=protocolxfer(true,true,uploaddir+xx);
  32.  
  33.     assign (jo,uploaddir+xx);
  34.  
  35.     if dummm then erase (jo);
  36.  
  37.     IF dummm then Writeln (USR,^M' ■ EmuMail Transfer Successful!')
  38.              ELSE Writeln (USR,^M' ■ EmuMail Transfer Failed?!?!?');
  39.  
  40.     clearitall;
  41. end;
  42.  
  43.  
  44. procedure once_got_carrier;
  45. begin
  46. writeln (usr,' ■ Ah Ben!, ici la Carriere! ');
  47. online:=true;
  48. delay (999);
  49. send (^M^M^M^M^M^M^M^M^M'       ');
  50. delay (6000);
  51. send (^H^H^H^H^H);
  52. Delay (200);
  53. send ('PNET-FILE'+#13);
  54. delay (500);
  55. if carrier then send ('***************');
  56. writeln (usr,' ■ Donnez la lettre!');
  57. end;
  58.  
  59. Function There_is_any_mail:boolean;
  60. var zed,one,NEXTONE:anystr;
  61. ct:integer;
  62. joe:text;
  63. finished:boolean;
  64.    begin
  65.    Writeln (USR,' ■ Est-ce-qu''il y est les lettres pour aller?');
  66.    There_Is_any_mail:=false;
  67.    NEXTONE:='';
  68.    ct:=0;
  69.    repeat
  70.            cT:=ct+1;
  71.            zed:=strr(ct)+'.out';
  72.            if exist(uploaddir+zed) then begin
  73.            there_is_any_mail:=true;
  74.            write (usr,zed+',');END;
  75.  
  76.        until (ct>30);
  77.  
  78.    end;
  79.  
  80.  
  81. Function call (var number:anystr):boolean;
  82. begin
  83. Setparam(1,1200,FALSE);
  84. Writeln (usr,^M' ■ Je Telephone ',number,' Tapez une key a abortement!');
  85.  
  86. online:=false;
  87. ss:=number;
  88. if ss='' then exit;
  89. if  keypressed then  read (kbd,Chrr);
  90.  
  91. doanswer;delay (200);
  92. send ('      ');delay(500);
  93. send ('ATDT'+extender+ss+#13);
  94. jo:=0;
  95. FINISHED:=FALSE;
  96.  
  97. repeat
  98.      jo:=jo+1;
  99.      delay(1);
  100.      if keypressed then finished:=true;
  101.      if carrier then finished:=true;
  102.     until finished or (jo>18000);
  103. send (^M);
  104. call:=carrier;
  105. end;
  106.  
  107. procedure SEND_THE_MAIL;
  108. var zed,one,NEXTONE:anystr;
  109. ct:integer;
  110. joe:text;
  111. Going:anystr;
  112. finished:boolean;
  113.    begin
  114. writeln (usr,^M' ■ Beginning Mail Search and Delivery routines.');
  115.  
  116.    finished:=false;
  117.    NEXTONE:='';
  118.    ct:=0;
  119.  
  120.    repeat
  121.            cT:=ct+1;
  122.            zed:=strr(ct)+'.out';
  123.            if exist(uploaddir+zed) then begin
  124.                       write (usr,zed+',');
  125.  
  126.                                         assign (joe,uploaddir+zed);
  127.                                         reset (joe);
  128.                                         readln (joe,Going);
  129.                                         close (joe);
  130.  
  131.                     if Call (Going) then begin
  132.                      once_got_Carrier;
  133.                      Send_The_File (zed);
  134.                      disconnect;
  135.                      online:=false;
  136.                      delay (500);send (^M'  ');
  137.                      Writeln (usr,^M' ■ SAMMY''Z est cool!');
  138.                      end;
  139.                  nextone:=zed;
  140.                   end;
  141.        until ct>30;
  142.    end;
  143.  
  144.  
  145. begin
  146. modeminlock:=false;modemoutlock:=false;local:=false;
  147. window (1,1,80,25);
  148. clrscr;
  149. gotoxy (1,1);WRite (USR,'EmuMail 1.01 (tm) Emulex BBS Software.');
  150. window (1,2,80,25);gotoxy (1,1);
  151. clrscr;
  152. if there_is_any_mail then begin
  153.              send ('     ');delay (500);send ('ATS0=0'^M);
  154.              Send_The_Mail;
  155.              if carrier then disconnect;
  156.              Writeln (usr,' ■ EmuMail est completement! Retournerez a la bbs!');
  157.              send (^M^M^M'   ');
  158.              delay (200);
  159.              send ('ATS0=1'^M);
  160.              Async_Close;
  161.              Halt(0);
  162.  
  163.        end else begin
  164.           Writeln (usr,^M' ■ Rien de lettres!,je retournera a la bbs!');
  165.           Async_Close;
  166.           Halt(0);
  167.           End;
  168. end;
  169.