home *** CD-ROM | disk | FTP | other *** search
/ Jason Aller Floppy Collection / 341.img / TCS161S.ZIP / XFERMOD1.PAS < prev   
Pascal/Delphi Source File  |  1980-10-06  |  2KB  |  89 lines
  1.   procedure acceptfile(tramp:integer);
  2.   var process:boolean; dir1,extend:lstr; f1,f2:text; fn1,fn2:mstr; fn3:lstr;
  3.   begin
  4.     process:=true;
  5.     dir1:=copy(area.xmodemdir,1,length(area.xmodemdir)-1);
  6.     extend:=copy(fnames[tramp],length(fnames[tramp])-3,4);
  7.     extend:=upstring(extend);
  8.     write(^R'Received File: '^S+fnames[tramp]);
  9.     fn1:=forumdir+'PROCNAME.TXT'; fn2:=forumdir+'PROCMSG.TXT';
  10.     assign(f1,fn1); assign(f2,fn2);
  11.     if exist(fn1) then erase(f1);
  12.     if exist(fn2) then erase(f2);
  13.     if process then processfile(fnames[tramp],extend);
  14.     if exist(fn1) then begin
  15.                 reset(f1);
  16.                 readln(f1,fn3);
  17.                 close(f1);
  18.                 fnames[tramp]:=fn3;
  19.                end;
  20.     if exist(fn2) then begin
  21.                 reset(f2);
  22.                 readln(f2,fn3);
  23.                 close(f2);
  24.                 write(^S'  '+fn3+'... ');
  25.                end;
  26.     if not exist('c:\workdir\'+fnames[tramp]) then exit;
  27.  
  28.     writeln(^R'  posting...');
  29. exec(getenv('COMSPEC'),' /C copy c:\workdir\'+fnames[tramp]+' '+dir1+' >etc.tcs');
  30. exec(getenv('COMSPEC'),' /C del c:\workdir\'+fnames[tramp]+' >etc.tcs');
  31.     ud.path:=area.xmodemdir;
  32.     ud.filename:=fnames[tramp];
  33.     ud.descrip:=fdescs[tramp];
  34.     ud.dlpw:=fdlpws[tramp];
  35.     ud.extdesc:='Batch U/L - No Description';
  36.     writelog(15,2,fnames[tramp]);
  37.     buflen:=40;
  38.     if ups>32765 then ups:=0;
  39.     inc(ups);
  40.     ud.sentby:=unam;
  41.     ud.when:=now;
  42.     ud.whenrated:=now;
  43.     ud.points:=0;
  44.     ud.downloaded:=0;
  45.     ud.newfile:=true;
  46.     ud.specialfile:=false;
  47.  
  48.     getfsize(ud); addfile(ud);
  49.     inc(urec.uploads);
  50.  
  51.     urec.upk:=urec.upk+ud.filesize;
  52.     newuploads:=newuploads+1;
  53.     writeurec;
  54.    end;
  55.  
  56.    procedure getextras;
  57.    var r:registers; ffinfo:searchrec;
  58.        tpath:anystr; b:byte; cnt:integer; mm:text;
  59.  
  60.    begin
  61.     writeln; writeln(^R'Searching for ',checkwork,' extra file(s).');
  62.     writeln;
  63.     tpath:='c:\workdir\*.*'; cnt:=0;
  64.     findfirst (tpath,$17,ffinfo);
  65.  
  66. if doserror<>0 then begin
  67.             writeln('None Found!  Please Alert Sysop!');
  68.             exit;
  69.             end;
  70.  
  71.       while doserror=0 do begin
  72.       if not break then if ffinfo.name[1]<>'.' then begin
  73.                     fnames[1]:=ffinfo.name;
  74.           if answer<>'H' then begin
  75.             writeln;
  76.             writestr(^R'Describe file '^S+ffinfo.name+^R+': *');
  77.             fdescs[1]:=input;
  78.             writestr(^R'Download P/W for file: *');
  79.             fdlpws[1]:=input;
  80.             end else begin
  81.             fdescs[1]:='Batch U/L with no description';
  82.             fdlpws[1]:='';
  83.             end;
  84.           acceptfile(1);
  85.                         end;
  86.       findnext (ffinfo)
  87.       end;
  88. end;
  89.