home *** CD-ROM | disk | FTP | other *** search
/ Jason Aller Floppy Collection / 341.img / TCS161S.ZIP / BASICS.PAS < prev    next >
Pascal/Delphi Source File  |  1989-10-07  |  2KB  |  65 lines
  1.  
  2.   procedure acceptfile(fname:lstr);
  3.   var process:boolean; dir1,extend:lstr; f1,f2:text; fn1,fn2:mstr; fn3:lstr;
  4.   begin
  5.     process:=true;
  6.     dir1:=copy(area.xmodemdir,1,length(area.xmodemdir)-1);
  7.     extend:=copy(fname,length(fname)-3,4);
  8.     extend:=upstring(extend);
  9.     write(^R'Received File: '^S+fname);
  10.     fn1:=forumdir+'PROCNAME.TXT'; fn2:=forumdir+'PROCMSG.TXT';
  11.     assign(f1,fn1); assign(f2,fn2);
  12.     if exist(fn1) then erase(f1);
  13.     if exist(fn2) then erase(f2);
  14.     if process then processfile(fname,extend);
  15.     if exist(fn1) then begin
  16.                 reset(f1);
  17.                 readln(f1,fn3);
  18.                 close(f1);
  19.                 ud.filename:=fn3;
  20.                 fname:=fn3;
  21.                end;
  22.     if exist(fn2) then begin
  23.                 reset(f2);
  24.                 readln(f2,fn3);
  25.                 close(f2);
  26.                 write(^S'  '+fn3+'... ');
  27.                end;
  28.     if not exist('c:\workdir\'+fname) then exit;
  29.  
  30.     writeln(^R'  posting...');
  31. exec(getenv('COMSPEC'),' /C copy c:\workdir\'+fname+' '+dir1+' >etc.tcs');
  32. exec(getenv('COMSPEC'),' /C del c:\workdir\'+fname+' >etc.tcs');
  33.    end;
  34.  
  35.    procedure getextras;
  36.    var r:registers; ffinfo:searchrec;
  37.        tpath:anystr; b:byte; cnt:integer; mm:text; fname:lstr;
  38.  
  39.    begin
  40.     writeln; writeln(^R'Checking Upload Discrepancy.');
  41.     writeln;
  42.     tpath:='c:\workdir\*.*'; cnt:=0;
  43.     findfirst (tpath,$17,ffinfo);
  44.  
  45. if doserror<>0 then begin
  46.             writeln('File not received. (Upload Aborted)');
  47.             exit;
  48.             end;
  49.  
  50.           if ffinfo.name[1]<>'.' then begin
  51.                     fname:=ffinfo.name;
  52.           if answer<>'H' then begin
  53.             writeln;
  54.             writestr(^R'Describe file '^S+ffinfo.name+^R+': *');
  55.             ud.descrip:=input;
  56.             writestr(^R'Download P/W for file: *');
  57.             ud.dlpw:=input;
  58.             end else begin
  59.             ud.descrip:='Upload with no description.';
  60.             ud.dlpw:='';
  61.             end;
  62.           acceptfile(fname);
  63.       end;
  64. end;
  65.