Jason Aller Floppy Collection/189.img/TCS120S.ZIP/PROTOCOL.PAS

Pascal/Delphi Source File | 1989-04-06 | 54KB | 1,888 lines

{$R-,S-,I-,D-,F+,V-,B-,N-,L+ }
{$M 65500,0,0 }

unit protocol;

interface

uses dos,crt,
     configrt,gentypes,modem,statret,windows,gensubs,subs1,subs2,mainr2,
     userret;

var totaltime:sstr;
    b:string;
    totalxferpoints,mins:integer;
    totalxfersize:longint;

function protocolxfer (send,crcmode,ymodem:boolean; fn:lstr):integer;
procedure runext (var ret_code:integer; var commandline,switchz:lstr);
function doext (mode,proto:char; uddir,fn:lstr; baud,comm:integer):integer;
procedure beepbeep (ok:integer);
function checkdszlog (fnxfered:anystr):char;
function sponsoron:boolean;
procedure seekudfile (n:integer);
procedure requestfile;
function getfname (path:lstr; name:mstr):lstr;
procedure possiblelzm (points:integer);
function checkok (ud:udrec):boolean;
function searchforfile (f:sstr):integer;
procedure listfile (n:integer; extended:boolean);
procedure listfiles (extended:boolean);
function allowxfer:boolean;
function numuds:integer;
function nofiles:boolean;
function getfilenum (t:mstr):integer;
procedure addtobatch (auto:integer);
procedure downbatch;
procedure upbatch;
procedure listbatch;
procedure clearbatch;
procedure batchmenu;

implementation

function protocolxfer (send,crcmode,ymodem:boolean; fn:lstr):integer;
{ Return codes:  0=OK, 1=Cancelled within last three blocks, 2=Aborted }

{% ENDIF}

  const can=^X; ack=^F; nak=^U; soh=^A; stx=^B; eot=^D; crcstart='C';

  var timedout:boolean;

  function tenthseconds:integer;
  var r:registers;
  begin
    r.ah:=$2c;
    intr ($21,r);
    tenthseconds:=(r.dh*10)+(r.dl div 10)
  end;

  function fromnow (tenths:integer):integer;
  begin
    tenths:=tenthseconds+tenths;
    if tenths>599 then tenths:=tenths-600;
    fromnow:=tenths
  end;

  function timeout (en:integer):boolean;
  begin
    timeout:=(en=tenthseconds) or hungupon
  end;

  procedure clearmodemahead;
  var k:char;
  begin
    while numchars>0 do k:=getchar
  end;

  procedure wait (tenths:integer);
  begin
    tenths:=fromnow (tenths);
    repeat until timeout (tenths) or hungupon
  end;

  function waitchar (tenths:integer):char;
  begin
    waitchar:=#0;
    tenths:=fromnow (tenths);
    repeat
      if numchars>0 then begin
        waitchar:=getchar;
        timedout:=false;
        exit
      end
    until timeout (tenths) or hungupon;
    timedout:=true
  end;

  procedure computecrc (var block; blocksize:integer; var outcrc:word);
  var cnt,c2:integer;
      crc,b:word;
      blk:array[1..1030] of byte absolute block;
      willbecarry:boolean;
  begin
    crc:=0;
    for cnt:=1 to blocksize do begin
      b:=blk[cnt];
      for c2:=1 to 8 do begin
        willbecarry:=(crc and $8000)=$8000;
        crc:=(crc shl 1) or (b shr 7);
        b:=(b shl 1) and 255;
        if willbecarry then crc:=crc xor $1021
      end
    end;
    outcrc:=crc
  end;

(****
    inline (
             $1E/                    {           PUSH  DS               }
             $C5/$B6/block/          {           LDS   SI,[BP+block]    }
             $8B/$96/blocksize/      {           MOV   DX,[BP+blocksize]}
             $31/$DB/                {           XOR   BX,BX            }
             $FC/                    {           CLD                    }
             $AC/                    { Mainloop: LODSB                  }
             $B9/$08/$00/            {           MOV   CX,0008          }
             $D0/$E0/                { Byteloop: SHL   AL,1             }
             $D1/$D3/                {           RCL   BX,1             }
             $73/$04/                {           JNC   No_xor           }
             $81/$F3/$21/$10/        {           XOR   BX,1021          }
             $E2/$F4/                { No_xor:   LOOP  Byteloop         }
             $4A/                    {           DEC   DX               }
             $75/$ED/                {           JNZ   Mainloop         }
             $89/$9E/crc/            {           MOV   [BP+crc],BX      }
             $1F                     {           POP   DS               }
           );
****)

  procedure computecksum (var data; blocksize:integer; var outcksum:byte);
  var t:array [1..1024] of byte absolute data;
      cnt,q:integer;
  begin
    q:=0;
    for cnt:=1 to blocksize do q:=q+t[cnt];
    outcksum:=q and 255
  end;

  procedure showerrorstats (curblk,totalerrs,consec:integer);
  var x:integer;
      r:real;
  begin
    x:=wherex;
    write (usr,totalerrs);
    gotoxy (x,wherey+1);
    write (usr,consec,' ');
    gotoxy (x,wherey+1);
    if curblk+totalerrs<>0 then begin
      r:=round(10000.0*totalerrs/(curblk+totalerrs))/100.0;
      write (usr,r:0:2,'%    ')
    end
  end;

  function xymodemsend (ymodem:boolean):integer;
  var f:file;
      b:array [1..1026] of byte;
      blocksize:integer;
      fsize,curblk,totalerrs,consec,blocksatatime:integer;
      k:char;
      firstblock:boolean;

    function getctrlchar:char;   { Gets ACK/NAK/CAN }
    var k,k2:char;
        cnt:integer;
    begin
      getctrlchar:=can;
      repeat
        cnt:=0;
        repeat
          k:=waitchar (10);
          cnt:=cnt+1;
          if keyhit then begin
            k2:=bioskey;
            if k2=^X then exit;
            timedout:=true
          end
        until (not timedout) or (cnt=60);
        if timedout or hungupon then exit;
        if (k in [ack,nak,crcstart,can]) then begin
          getctrlchar:=k;
          if k=can then sendchar (can);
          exit
        end
      until hungupon;
      timedout:=true
    end;

    procedure sendendoffile;
    var k:char;
        tries:integer;
    begin
      tries:=0;
      repeat
        tries:=tries+1;
        sendchar(eot);
        k:=waitchar (20);
      until (k=ack) or (k=can) or (tries=3);
      sendchar(eot)
    end;

    procedure getblockfromfile;
    begin
      fillchar (b,sizeof(b),26);
      blockread (f,b,blocksatatime);
      blocksize:=blocksatatime shl 7
    end;

    procedure buildfirstblock;
    var cnt,p:integer;
    begin
      blocksize:=128;
      fillchar(b,128,0);
      p:=length(fn);
      repeat
        p:=p-1
      until (p=0) or (fn[p]='\');
      for cnt:=1 to length(fn)-p do b[cnt]:=ord(fn[cnt+p])
    end;

    procedure sendblock (num:integer);
    var cnt,bksize:integer;
        crc:word;
        n:byte;
        k:char;
    begin
      clearmodemahead;
      n:=num and 255;
      if blocksize=1024
        then k:=stx
        else k:=soh;
      if crcmode
        then
          begin
            b[blocksize+1]:=0;
            b[blocksize+2]:=0;
            computecrc (b,blocksize+2,crc);
            b[blocksize+1]:=hi(crc);
            b[blocksize+2]:=lo(crc);
            bksize:=blocksize+2;
          end
        else
          begin
            b[blocksize+1]:=0;
            computecksum (b,blocksize,b[blocksize+1]);
            bksize:=blocksize+1
          end;
      sendchar (k);
      sendchar (chr(n));
      sendchar (chr(255-n));
      for cnt:=1 to bksize do sendchar(chr(b[cnt]))
    end;

    procedure updatestatus;
    begin
      gotoxy (16,3);
      write (usr,curblk,' of ',fsize);
      gotoxy (16,4);
      write (usr,minstr((fsize-curblk)*blocksatatime),' of ',totaltime,' ');
      gotoxy (16,5);
      showerrorstats (curblk,totalerrs,consec)
    end;

    procedure initxfer;
    begin
      starttimer (numminsxfer);
      if ymodem then blocksatatime:=8 else blocksatatime:=1;
      fsize:=(filesize(f)+blocksatatime-1) div blocksatatime;
      totaltime:=minstr(fsize*blocksatatime);
      totalerrs:=0;
      consec:=0;
      firstblock:=true;
      if ymodem
        then
          begin
            curblk:=0;
            buildfirstblock
          end
        else
          begin
            curblk:=1;
            getblockfromfile
          end;
      splitscreen (8);
      top;
      write (usr,'Waiting for NAK')
    end;

    procedure setupscreen;
    begin
      gotoxy (1,1);
      if ymodem then write (usr,'Y') else write (usr,'X');
      write (usr,'modem');
      if crcmode then write (usr,'-CRC');
      writeln (usr,' send in progress.  Press [Ctrl-X] to Abort.');
      clreol;
      gotoxy (1,3);
      writeln (usr,'Current block:');
      writeln (usr,'Time left:');
      writeln (usr,'Total errors:');
      writeln (usr,'  Consecutive:');
      write (usr,'Error rate:')
    end;

  label abort,done;
  begin
    xymodemsend:=2;
    assign (f,fn);
    reset (f);
    iocode:=ioresult;
    if iocode<>0 then exit;
    initxfer;
    repeat
      k:=getctrlchar;
      if k=can then begin
        if (curblk>(fsize*3/4)) and (curblk>2)
          then xymodemsend:=1; { Cheater! }
        goto abort
      end;
      if firstblock then begin
        if (k=nak) or (k=crcstart) then firstblock:=false;
        crcmode:=k=crcstart;
        setupscreen;
        k:=#0
      end;
      if k=ack then begin
        curblk:=curblk+1;
        if eof(f) then goto done;
        getblockfromfile
      end;
      if k<>nak then consec:=0 else begin
        totalerrs:=totalerrs+1;
        consec:=consec+1
      end;
      sendblock(curblk);
      updatestatus
    until 0=1;
    done:
    sendendoffile;
    xymodemsend:=0;
    abort:
    close (f);
    unsplit;
    stoptimer (numminsxfer)
  end;

  function xymodemreceive(ymodem:boolean):integer;
  var f:file;
      block:array [1..1026] of byte;
      blkl,blkh,xblkl,nblkl,nblk1:byte;
      curblk:integer;
      ctrl,k,k2:char;
      timeul,consec,totalerrs,blocksize:integer;
      canceled,timeout:boolean;

    procedure cancel;
    begin
      wait (10);
      clearmodemahead;
      sendchar (can);
      wait (10);
      clearmodemahead;
      sendchar (can);
      canceled:=true
    end;

    function writeblock:boolean;
    var wb:boolean;
    begin
      blockwrite (f,block,blocksize div 128);
      wb:=ioresult=0;
      writeblock:=wb;
      if not wb then begin
        gotoxy (1,1);
        write (usr,'I/O ERROR ',iocode,' WRITING BLOCK');
        clreol;
        sendchar (can);
        wait (10);
        sendchar (can);
        clearmodemahead
      end
    end;

    procedure updatestatus;
    begin
      curblk:=blkl+(blkh shl 8);
      gotoxy (16,3);
      write (usr,curblk);
      gotoxy (16,4);
      showerrorstats (curblk,totalerrs,consec)
    end;

    function sendctrl:char;
    var cnt,consec:integer;
        k:char;
    begin
      cnt:=0;
      consec:=0;
      timeout:=false;
      updatestatus;
      sendctrl:=can;
      repeat
        if keyhit then begin
          k:=bioskey;
          if k=^X then begin
            timeout:=true;
            cancel;
            exit
          end
        end;
        sendctrl:=waitchar (50);
        if not timedout then exit;
        sendchar (ctrl);
        cnt:=0;
        consec:=consec+1
      until (consec=10) or hungupon;
      timeout:=true
    end;

    function getachar:char;
    var cnt:integer;
        k:char;
    begin
      getachar:=#0;
      timeout:=timeout or hungupon;
      if timeout then exit;
      timeout:=false;
      if keyhit then begin
        k:=bioskey;
        if k=^X then begin
          getachar:=#0;
          timeout:=true;
          cancel;
          exit
        end
      end;
      getachar:=waitchar (10);
      timeout:=timeout or timedout
    end;

    procedure xfererror (txt:lstr);
    begin
      gotoxy (16,7);
      write (usr,txt,' in block ',curblk);
      clreol
    end;

    procedure initxfer;
    var k:char;
    begin
      timeul:=timer;
      timeout:=false;
      consec:=0;
      blkl:=1;
      blkh:=0;
      xblkl:=1;
      curblk:=1;
      totalerrs:=0;
      if crcmode
        then ctrl:=crcstart
        else ctrl:=nak;
      canceled:=false;
      starttimer (numminsxfer);
      splitscreen (8);
      top;
      gotoxy (1,1);
      if ymodem then write (usr,'Y') else write (usr,'X');
      write (usr,'modem');
      if crcmode then write (usr,'-CRC');
      write (usr,' receive in progress.  Press [Ctrl-X] to Abort.'^M^J^J,
             'Current block:'^M^J,
             'Total errors:'^M^J,
             '  Consecutive:'^M^J,
             'Error rate:'^M^J,
             'Error type:');
      while numchars>0 do k:=getchar
    end;

    procedure endoffile;
    begin
      xymodemreceive:=0;
      sendchar (ack);
      wait (10);
      sendchar (ack);
      clearmodemahead
    end;

    function block0:boolean;
    var b0:boolean;
        cnt:integer;
    begin
      b0:=(nblkl=0) and (nblk1=255) and (blkh=0) and (blkl<>255);
      if b0 then begin
        xfererror ('(Receiving block 0...)');
        for cnt:=1 to blocksize do block[cnt]:=ord(getachar);
        ctrl:=ack;
        sendchar (ack)
      end;
      block0:=b0
    end;

    function blocknumerror:boolean;
    var bne:boolean;
    begin
      bne:=(nblkl<>(255-nblk1)) or ((nblkl<>xblkl) and (nblkl<>blkl));
      if bne then xfererror ('Block # '+strr(nblkl)+' not '+strr(255-nblk1)+
                             ' and '+strr(xblkl)+' or '+strr(blkl));
      blocknumerror:=bne
    end;

    function resentnoreason:boolean;
    var rnr:boolean;
        cnt:integer;
    begin
      rnr:=(nblkl<>xblkl) and (nblkl=blkl);
      if rnr then begin
        xfererror ('Block re-sent for no reason');
        for cnt:=1 to blocksize do block[cnt]:=ord(getachar);
        ctrl:=ack;
        sendchar (ack)
      end;
      resentnoreason:=rnr
    end;

    procedure getblockfrommodem;
    var cnt:integer;
    begin
      for cnt:=1 to blocksize do begin
        block[cnt]:=ord(getachar);
        if timeout then exit
      end
    end;

    function badblock:boolean;
    var crc:word;
        cksum,reccksum:byte;
    begin
      badblock:=false;
      if crcmode
        then
          begin
            computecrc(block,blocksize,crc);
            if crc<>0 then begin
              xfererror ('CRC error');
              badblock:=true
            end
          end
        else
          begin
            reccksum:=block[129];
            block[129]:=0;
            computecksum(block,blocksize,cksum);
            if cksum<>reccksum then begin
              xfererror ('Checksum error');
              badblock:=true
            end
          end
    end;

  label nakit,abort,done;
  begin
    xymodemreceive:=2;
    assign (f,fn);
    rewrite (f);
    iocode:=ioresult;
    if iocode<>0 then begin
      fileerror ('XYMODEMRECEIVE',fn);
      exit
    end;
    initxfer;
    repeat
      k:=sendctrl;
      ctrl:=nak;
      if timeout or (k=can) then goto abort;
      if k=eot then begin
        endoffile;
        goto done
      end;
      case k of
        soh:blocksize:=128;
        stx:blocksize:=1024
        else begin
          xfererror ('SOH error: '+strr(ord(k)));
          goto nakit
        end
      end;
      if crcmode
        then blocksize:=blocksize+2
        else blocksize:=blocksize+1;
      nblkl:=ord(getachar);
      nblk1:=ord(getachar);
      if timeout then goto nakit;
      if block0 then goto nakit;
      if blocknumerror then goto nakit;
      if resentnoreason then goto nakit;
      if (nblkl=0) and (blkl=255) then blkh:=blkh+1;
      blkl:=nblkl;
      getblockfrommodem;
      if timeout then goto nakit;
      if badblock then goto nakit;
      ctrl:=ack;
      xblkl:=blkl+1;
      sendchar (ack);
      updatestatus;
      if not writeblock then goto abort;
      consec:=0;
      nakit:
      if hungupon then goto abort;
      if timeout then xfererror ('Time out (short block)');
      if ctrl<>ack then begin
        totalerrs:=totalerrs+1;
        consec:=consec+1;
        repeat
          k:=waitchar (10)
        until timedout;
        if consec>=15 then begin
          sendchar (can);
          goto abort
        end;
        sendchar (ctrl)
      end
    until 0=1;
    abort:
    cancel;
    done:
    close (f); consec:=ioresult;
    if canceled then begin
      erase (f); consec:=ioresult
    end;
    timeul:=timer-timeul;
    if timeul<0 then timeul:=timeul+1440;
    settimeleft (timeleft+timeul*2);
    unsplit;
    stoptimer (numminsxfer)
  end;

begin
  totaltime:='';
  if send
    then protocolxfer:=xymodemsend(ymodem)
    else protocolxfer:=xymodemreceive(ymodem)
end;

  function cmdline (f:lstr):lstr;
  var a,b,c:string;
      x:integer;
  begin
   x:=0;
   a:='';
   b:='';
   c:='';
   repeat
    x:=x+1;
    a:=a+f[x];
   until f[x]=' ';
   delete (a,length(a),1);
   c:=forumdir;
   if c[length(c)]<>'\' then
   c:=c+'\';
   c:=c+a;
   cmdline:=c;
  end;

  function switches (c,fn:lstr):lstr;
  var x,y,z,w:string;
      a,s:integer;
      monolith:boolean;
  begin
   a:=0;
   s:=0;
   x:='';
   y:='';
   z:='';
   w:='';
   repeat
    s:=s+1;
    w:=w+c[s];
   until c[s]=' ';
   delete (c,1,s);
   for a:=1 to length(c) do begin
    monolith:=false;
    x:=copy (c,a,1);
    if x='%' then begin
     y:=copy (c,a+1,1);
     if (y='1') or (y='2') or (y='3') then
     begin
      monolith:=true;
      case valu(y) of
       1:z:=z+strr(usecom);
       2:z:=z+strr(baudrate);
       3:z:=z+fn;
      end;
      delete (c,a+1,1);
     end
    end
    else z:=z+x;
   end;
   switches:=z;
  end;

  procedure runext (var ret_code:integer; var commandline,switchz:lstr);
  begin
   exec (commandline,switchz);
   if doserror<>0 then
      begin
      writeln;
      writeln (^G^G);
      writeln ('DOS Error #',doserror);
      writeln ('Please report the error number to the Sysop!');
      writeln;
      writestr ('Press [Enter] to continue.*');
    end
   else ret_code:=dosexitcode;
  end;

  function doext (mode,proto:char; uddir,fn:lstr; baud,comm:integer):integer;
  var cline,switchz,dirsave,cddir,wildcatsucks:lstr;
      baudst,commst:mstr;
      retcd:integer;
      foofur:text;
      h1,h2,m1,m2,s1,s2,ss1,ss2:word;
  begin
  { getdir (0,dirsave); }{ drive: 0 = cur. 1 = A: etc. - save cur. dir. }
    dirsave:=forumdir;
    if dirsave[length(dirsave)]='\' then
    dirsave:=copy (dirsave,1,length(dirsave)-1);
    if uddir[length(uddir)]='\'
    then cddir:=copy(uddir,1,length(uddir)-1)
    else cddir:=uddir;
    writeln (usr,^M'[Changing Directories to '+cddir+']'^M);
    chdir (cddir);
    str (baud:3,baudst);
    str (comm:1,commst);
    if mode='R' then begin
      case proto of
        'Z':cline:=cmdline(zmodemr);
        'J':cline:=cmdline(jmodemr);
        'L':cline:=cmdline(lynxr);
        'G':cline:=cmdline(ymodemgr);
        'O':cline:=cmdline(xovrr);
        '1':cline:=cmdline(yovrr);
        'S':cline:=cmdline(superkr);
        'K':cline:=cmdline(k9xr);
        'R':cline:=cmdline(zcrashr);
        'P':cline:=cmdline(zpcpr);
        'E':cline:=cmdline(lynxcrashr);
        'W':cline:=cmdline(wxmodemr);
      end
    end;
    if mode='R' then begin
      case proto of
        'Z':switchz:=switches(zmodemr,fn);
        'J':switchz:=switches(jmodemr,fn);
        'L':switchz:=switches(lynxr,fn);
        'G':switchz:=switches(ymodemgr,fn);
        'O':switchz:=switches(xovrr,fn);
        '1':switchz:=switches(yovrr,fn);
        'S':switchz:=switches(superkr,fn);
        'K':switchz:=switches(k9xr,fn);
        'R':switchz:=switches(zcrashr,fn);
        'P':switchz:=switches(zpcpr,fn);
        'E':switchz:=switches(lynxcrashr,fn);
        'W':switchz:=switches(wxmodemr,fn);
      end
    end;
    if mode='S' then begin
      case proto of
        'Z':cline:=cmdline(zmodems);
        'J':cline:=cmdline(jmodems);
        'L':cline:=cmdline(lynxs);
        'G':cline:=cmdline(ymodemgs);
        'O':cline:=cmdline(xovrs);
        '1':cline:=cmdline(yovrs);
        'S':cline:=cmdline(superks);
        'K':cline:=cmdline(k9xs);
        'R':cline:=cmdline(zcrashs);
        'P':cline:=cmdline(zpcps);
        'W':cline:=cmdline(wxmodems);
        '^':cline:=cmdline(zrles);
      end
    end;
    if mode='S' then begin
      case proto of
        'Z':switchz:=switches(zmodems,fn);
        'J':switchz:=switches(jmodems,fn);
        'L':switchz:=switches(lynxs,fn);
        'G':switchz:=switches(ymodemgs,fn);
        'O':switchz:=switches(xovrs,fn);
        '1':switchz:=switches(yovrs,fn);
        'S':switchz:=switches(superks,fn);
        'K':switchz:=switches(k9xs,fn);
        'R':switchz:=switches(zcrashs,fn);
        'P':switchz:=switches(zpcps,fn);
        'W':switchz:=switches(wxmodems,fn);
        '^':switchz:=switches(zrles,fn);
      end;
    end;
    write (^B);
{   if (proto='Z') or (proto='G') or (proto='O') or (proto='1') or (proto='R')
    or (proto='P') then
    begin
     if (not exist (forumdir+'\DSZ.COM')) and (not exist (forumdir+'\DSZ.EXE'))
     then begin
      writeln;
      writeln (^G^R'DSZ Protocols are not available at the moment!');
      writeln ('Sysop does not have DSZ.COM or DSZ.EXE in the TCS directory.');
      writeln ('Please notify him!');
      writeln;
      writeln (usr,^M'[Changing Directories back to '+dirsave+']');
      chdir (dirsave);
      exit;
     end;
    end;
    if (proto='J') then begin
     if not exist (forumdir+'\JMODEM.COM') then
     begin
      writeln;
      writeln (^G^R'Jmodem Protocol is not available at the moment!');
      writeln ('Sysop does not have JMODEM.COM in the TCS directory.');
      writeln ('Please notify him!');
      writeln;
      writeln (usr,^M'[Changing Directories back to '+dirsave+']');
      chdir (dirsave);
      exit;
     end;
    end;
    if (proto='L') or (proto='E') then begin
     if not exist (forumdir+'\LYNX.EXE') then
     begin
      writeln;
      writeln (^G^R'Lynx Protocols is not available at the moment!');
      writeln ('Sysop does not have LYNX.EXE in the TCS directory.');
      writeln ('Please notify him!');
      writeln;
      writeln (usr,^M'[Changing Directories back to '+dirsave+']');
      chdir (dirsave);
      exit;
     end;
    end;
    if (proto='K') or (proto='S') or (proto='W') then begin
     if not exist (forumdir+'\SUPERK.COM') then
     begin
      writeln;
      writeln (^G^R'Super8k/K9Xmodem Protocol is not available at the moment!');
      writeln ('Sysop does not have SUPERK.COM in the TCS directory.');
      writeln ('Please notify him!');
      writeln;
      writeln (usr,^M'[Changing Directories back to '+dirsave+']');
      chdir (dirsave);
      exit;
      end;
     end; }
    assign (foofur,dszlog);
    if exist (dszlog) then erase (foofur);
    starttimer (numminsxfer);
    gettime (h1,m2,s1,ss1);
    runext (retcd,cline,switchz);
    gettime (h2,m2,s2,ss2);
    stoptimer (numminsxfer);
    writeln (usr,^M'[Changing Directories back to '+dirsave+']');
    chdir (dirsave);
    doext:=retcd;
    setparam (usecom,baudrate,parity);
  end;

  procedure beepbeep (ok:integer);
  begin
    delay (500);
    write (^B^M);
    case ok of
      0:write ('Xfer completed!');
      1:write ('Xfer Aborted just before EOF!');
      2:write ('Xfer Aborted!')
    end;
    writeln (^G^M)
  end;

  function checkdszlog (fnxfered:anystr):char;
  var f:text;
      l,sn,code,bytes,xferfile,cps,bps,errors,blocksize,flowstops:anystr;
      c:string[1];
      done:boolean;
      x:integer;

  function parsespaces (s:anystr):anystr;
  var p,pee,xy:integer;
      k,j:char;
      r:anystr;
  begin
   parsespaces:=s;
   r:=s;
   repeat
   p:=pos (' ',r);
   if p>0 then begin
    delete (r,p,1);
   end;
   until p=0;
   parsespaces:=r;
  end;

  begin
   checkdszlog:=' ';
   if not exist (dszlog) then begin
    writeln (^G^G);
    writeln ('DSZLOG error.');
  { ansicolor (12);
    writeln ('*********************************************');
    writeln ('** DSZLOG Error!! Please notify Sysop NOW! **');
    writeln ('*********************************************'); }
    ansicolor (urec.regularcolor);
    exit;
   end;
   assign (f,dszlog);
   reset (f);
   l:='';
   sn:=''; code:=''; bytes:=''; xferfile:='';
   cps:=''; bps:=''; errors:=''; blocksize:='';
   readln (f,l);
   code:=copy (l,1,1);
   bytes:=copy (l,2,7);
   bps:=copy (l,10,6);
   cps:=copy (l,19,5);
   errors:=copy (l,28,12);
   flowstops:=copy (l,40,6);
   blocksize:=copy (l,45,5);
   c:='';
   x:=50;
   repeat
    x:=x+1;
    if c='/' then c:='\';
    xferfile:=xferfile+c;
    c:=copy (l,x,1);
   until c=' ';
   sn:=copy (l,x+1,10);
   textclose (f);
   bps:=parsespaces (bps);
   cps:=parsespaces (cps);
   errors:=parsespaces (errors);
   bytes:=parsespaces (bytes);
   flowstops:=parsespaces (flowstops);
   blocksize:=parsespaces (blocksize);
   xferfile:=parsespaces (xferfile);
   sn:=parsespaces (sn);
   checkdszlog:=code[1];
   writeln (^R^B'Code-> '+code+'  Filename: '+xferfile);
   writeln ('Bytes sent: ',bytes,'  (',cps,' cps at ',bps,' bps)');
   writeln ('SN#: ',sn,'  Packet Length: ',blocksize,' bytes');
   writeln;
  end;

  function sponsoron:boolean;
  begin
    sponsoron:=match(area.sponsor,unam) or issysop
  end;

  procedure seekudfile (n:integer);
  begin
    seek (udfile,n-1)
  end;

  procedure requestfile;
  var t:text;
      me:message;
      m:mailrec;
  begin
    if hungupon then exit;
    writestr (^M^J+'Filename to Request: *');
    if length(input)=0 then exit;
    writeln (^M^J+'Enter a Message regarding the File Request:');
    delay (1000);
    titlestr:='File Request: '+input;
    sendstr:='Sysop';
    m.line:=editor (me,false,'File Request: '+input);
    sendstr:='';
    if m.line<0 then exit;
    m.anon:=false;
    m.title:=titlestr;
    m.sentby:=unam;
    m.when:=now;
    addfeedback (m);
  end;

  function getfname (path:lstr; name:mstr):lstr;
  var l:lstr;
  begin
    l:=path;
    if length(l)<>0
      then if not (l[length(l)] in [':','\'])
        then l:=l+'\';
    l:=l+name;
    getfname:=l
  end;

  procedure possiblelzm (points:integer);
  var n:text;
  begin
      writeln;
      writeln (^R'** Possible LEECH-ZMODEM User!');
      writeln (^R'** Notifying Sysop...');
      assign (n,forumdir+'System.Not');
      if exist (forumdir+'System.Not') then append (n)
      else begin
       writeln (n,'─────────────────────────────────────────────────');
       writeln (n,'[ TCS '+ver+' System Notifications Routed to Sysop ]');
       writeln (n,'─────────────────────────────────────────────────');
       writeln (n,'');
       rewrite (n);
      end;
      writeln (n,'────────────────────────────────────────────────────────────────────────────');
      writeln (n,'This is a possible notification of a LEECH-ZMODEM user.');
      writeln (n,'Leech-Zmodem allows the user to download a file via Zmodem FREE');
      writeln (n,'of cost by aborting the transfer near the end of the file, or');
      writeln (n,'by rewinding the file pointer to a random value. TCS reports that');
      writeln (n,'this may have been attempted by a user; namely:');
      writeln (n,'"'+unam+'".');
      writeln (n,'He was trying to download a file (or a batch of files).');
      writeln (n,'The cost point of this file was subtracted from that user''s points');
      writeln (n,'as a result of the possible violation.');
      writeln (n,' ');
      writeln (n,'[System Notification auto-sent at '+timestr(now)+' on '+datestr(now)+']');
      writeln (n,'────────────────────────────────────────────────────────────────────────────');
      textclose (n);
      urec.udpoints:=urec.udpoints-points;
      writeurec;
      writeln ('** Sysop notified & file cost accounted for.');
      writeln;
      writeln ('If you were not using Leech-Zmodem and were honestly aborting the Transfer,');
      writeln ('Then send some [F]eedback to the Sysop telling him you were not using LZM!');
      writeln ('These precautions are taken to protect against UNWANTED Leech-Zmodem');
      writeln ('users.');
      ansicolor (urec.regularcolor);
  end;

  function allowxfer:boolean;
  var cnt:baudratetype;
      k:char;
  begin
    allowxfer:=false;
   { if not carrier then begin
      writeln ('You may only transfer from remote!');
      exit
    end; }
    for cnt:=firstbaud to lastbaud do
      if baudrate=baudarray[cnt]
        then if not (cnt in downloadrates)
          then begin
            writeln ('Sorry, File Transfer is not allowed at ',baudrate,' Baud!');
            exit
          end;
    if parity then begin
      writeln ('Please select NO parity and press [Return]:');
      parity:=false;
      setparam (usecom,baudrate,parity);
      repeat
        k:=getchar;
        if hungupon then exit
      until k in [#13,#141];
      if k=#141 then begin
        parity:=true;
        setparam (usecom,baudrate,parity);
        writeln ('You did not turn off parity.  Transfer aborted.');
        exit
      end
    end;
    allowxfer:=true
  end;

  function numuds:integer;
  begin
    numuds:=filesize (udfile)
  end;

  function nofiles:boolean;
  begin
    if numuds=0 then begin
      nofiles:=true;
      writestr (^M'Sorry, no files!')
    end else nofiles:=false
  end;

  function checkok (ud:udrec):boolean;
  var m:string;
  begin
   checkok:=true;
   if (not sponsoron) and (ud.points>urec.udpoints) then begin
      if not allowloan then begin
       writeln (^R'Sorry, that file requires '^S,ud.points,^R' points.');
       writeln;
       checkok:=false;
       exit;
      end;
       if allowloan then begin
       if ulvl<lvltoloan then begin
        writeln (^R'Sorry, that file requires '^S,ud.points,^R' points.');
        checkok:=false;
        exit;
       end;
       if ud.points>maxloan then begin
        writeln (^R'Sorry, that file requires '^S,ud.points,^R' points.');
        writeln ('You have exceeded the File Point Loan limit.');
        writeln ('Better upload something before the sysop removes your type of scum.');
        checkok:=false;
        exit;
       end;
        writeln (^R'That file requires '^S,ud.points,^R' file points.');
        writeln (^R'You have '^S,urec.udpoints,^R' file points.');
        writestr ('Take a Point Loan [y/n]? *');
         m:=input;
         if yes then urec.udpoints:=urec.udpoints-ud.points;
          end;
     end;
    if (ud.newfile) and (not sponsoron) then begin
      writeln ('Sorry, that is a new file and must be validated.');
      checkok:=false;
      exit
    end;
    if (ud.specialfile) and (not sponsoron) then begin
      writeln ('Sorry, downloading that file requires special permission.');
      checkok:=false;
      exit
    end;
    if not exist (getfname(ud.path,ud.filename)) then begin
      checkok:=false;
      writeln ('That file is [Offline].');
      writestr ('Would you like to request that it be put online [y/n]? *');
      if length(input)=0 then exit;
      if (input[1]='y') or (input[1]='Y') then requestfile;
      exit;
    end;
    if (length(ud.dlpw)>0) then begin
     writeln;
     dots:=true;
     writestr ('[Enter Download Password]:');
     dots:=false;
     checkok:=false;
     if length(input)=0 then exit else
     if not match(input,ud.dlpw) then exit else
     checkok:=true;
    end;
    if tempsysop then begin
      ulvl:=regularlevel;
      tempsysop:=false;
      writeurec;
      bottomline
    end;
  end;

  function searchforfile (f:sstr):integer;
  var ud:udrec;
      cnt:integer;
  begin
    for cnt:=1 to numuds do begin
      seek (udfile,cnt-1);
      read (udfile,ud);
      if match(ud.filename,f) then begin
        searchforfile:=cnt;
        exit
      end
    end;
    searchforfile:=0
  end;

  procedure listfile (n:integer; extended:boolean);
  var ud:udrec;
      q:sstr;
      a,b,c,ed:string;
  begin
    seekudfile (n);
    read (udfile,ud);
    ansicolor (urec.statcolor);
    tab (strr(n)+'.',4);
    ansicolor (urec.promptcolor);
    tab (ud.filename,14);
    ansicolor (urec.inputcolor);
    if ud.newfile
      then write ('[New]  ')
      else if ud.specialfile
        then write ('[Ask]  ')
        else if ud.points>0
          then tab (strr(ud.points),7)
          else write ('[Free] ');
    ansicolor (urec.regularcolor);
    if exist (getfname(ud.path,ud.filename)) then tab (strlong(ud.filesize),10) else
     write ('[Offline] ');
    ansicolor (urec.statcolor);
    writeln (ud.descrip);
    ansicolor (urec.regularcolor);
    if break or (not extended) then exit;
    write (^R'    ');
    tab (datestr(ud.when),19);
    ansicolor (urec.promptcolor);
    tab (strr(ud.downloaded)+' D/L''s',13);
    ansicolor (urec.inputcolor);
    writeln (ud.sentby);
    a:=copy (ud.extdesc,1,80);
    ansicolor (urec.statcolor);
    writeln (a);
    if length(ud.extdesc)>80 then begin
     b:=copy (ud.extdesc,81,80);
     ansicolor (urec.statcolor);
     writeln (b);
    end;
    if length(ud.extdesc)>160 then begin
     c:=copy (ud.extdesc,161,80);
     ansicolor (urec.statcolor);
     writeln (c);
    end;
    ansicolor (urec.regularcolor);
  end;

  procedure listfiles (extended:boolean);
  var cnt,max,r1,r2:integer;
  const extendedstr:array[false..true] of string[9]=('','Extended ');
  begin
    if nofiles then exit;
    writehdr (extendedstr[extended]+'File List');
    max:=numuds;
    thereare (max,'File','Files');
    parserange (max,r1,r2);
    if r1=0 then exit;
    writeln (^S'#.'^P'  Filename'^U'      Points '^R'Size      '^S'Description'^R);
    if (asciigraphics in urec.config) then
     writeln ('───────────────────────────────────────────────────────────────────────────────')
    else
     writeln ('-------------------------------------------------------------------------------');
    for cnt:=r1 to r2 do begin
      listfile (cnt,extended);
      if break then exit
    end
  end;

  function getfilenum (t:mstr):integer;
  var n,s:integer;
  begin
    getfilenum:=0;
    if length(input)>1 then input:=copy(input,2,255) else
      repeat
        writestr ('File Name/Number to '+t+' [?/List]:');
        if hungupon or (length(input)=0) then exit;
        if input='?' then begin
          listfiles (false);
          input:=''
        end
      until input<>'';
    val (input,n,s);
    if s<>0 then begin
      n:=searchforfile(input);
      if n=0 then begin
        writeln ('File not found.');
        exit
      end
    end;
    if (n<1) or (n>numuds)
      then writeln ('File number out of range!')
      else getfilenum:=n
  end;

  function numbatches:integer;
  var x,n:integer;
  begin
   n:=0;
   for x:=1 to maxb do begin
    if (length (bbuffer[x].fn)>0) and (length (bbuffer[x].path)>0) and
    (bbuffer[x].filesize>0)
    then n:=n+1;
   end;
   numbatches:=n;
  end;

  function minutes (m:longint):integer;
  var mins,secs,realtime,x:integer;
      tyme,y:string;
  begin
   minutes:=-1;
   mins:=0;
   tyme:=minstr(m);
   x:=pos (':',tyme)-1;
   y:=copy(tyme,1,x);
   if valu(y)<1 then
   begin
    realtime:=1;
    minutes:=realtime;
    exit;
   end;
 { case baudrate of
    300:mins:=valu(y) * 4;
    1200:mins:=valu(y);
    2400:mins:=valu(y) div 2;
    9600:mins:=valu(y) div 8;
   end; }
   mins:=valu(y);
   secs:=valu(copy(tyme,x+1,2));
   if mins=0 then mins:=1;
   if secs<>0 then realtime:=mins+(secs div 60) else
   realtime:=mins;
   minutes:=realtime;
  end;

  function minutestring (m:longint):string;
  var anarky,y,mins,secs,it:string;
      x:integer;
  begin
   minutestring:='-1:-1';
   anarky:=minstr(m);
   x:=pos(':',anarky)-1;
   y:=copy(anarky,1,x);
 { case baudrate of
    300:mins:=strr(valu(y) * 4);
    1200:mins:=strr(valu(y));
    2400:mins:=strr(valu(y) div 2);
    9600:mins:=strr(valu(y) div 8);
   end; }
   mins:=y;
   secs:=copy(anarky,x+1,2);
   it:=mins+':'+secs;
   minutestring:=it;
  end;

  function totalxfertime (size:longint):integer;
  var silpheed,urlame:string;
      sq3,min:integer;
      rsec:real;
  begin
   rsec:=1.38*size*(1200/baudrate);
   min:=trunc (rsec/60.0);
   totalxfertime:=min;
  {
   silpheed:=minstr(size);
   sq3:=pos(':',silpheed)-1;
   urlame:=copy(silpheed,1,sq3);
   totalxfertime:=valu(urlame);
  }
  end;

  procedure listbatch;
  var x,gayger,firm:integer;
      freeworld,kopy:string;
      f:file;
  begin
   gayger:=0;
   for x:=1 to maxb do begin
    if (length(bbuffer[x].fn)>0) and (length(bbuffer[x].path)>0) and
       (bbuffer[x].filesize>0) then
    begin
     gayger:=gayger+1;
     if gayger=1 then begin
     writehdr ('Batch Download File List');
     writeln ('Num Filename       Cost  Bytes       Time');
     if (asciigraphics in urec.config) then
     writeln ('───────────────────────────────────────────') else
     writeln ('-------------------------------------------');
     end;
     tab (strr(x)+'.',4);
     tab (bbuffer[x].fn,15);
     tab (strr(bbuffer[x].points),6);
     tab (strlong(bbuffer[x].filesize),12);
     assign (f,getfname(bbuffer[x].path,bbuffer[x].fn));
     reset (f);
     writeln (minstr(filesize(f)));
     close (f);
    end;
   end;
   if gayger>0 then begin
    if (asciigraphics in urec.config) then
    writeln  ('───────────────────────────────────────────') else
    writeln  ('-------------------------------------------');
    writeln;
    write (^R'Total Size:   '^S);
    write (strlong(totalxfersize));
    writeln (^S' bytes'^R);
    write (^R'Total Time:   '^S);
    writeln (minstr(totalxfersize),^R);
    write (^R'Total Points: '^S);
    writeln (strr(totalxferpoints));
    ansireset;
   end;
  end;

  procedure addtobatch (auto:integer);
  var x,num,y:integer;
      ud:udrec;
      m:string;
      floyd:boolean;
      t:text;
      fff,ffff:file;
      playdoland:longint;
  begin
    if numbatches<1 then begin
     totalxfersize:=0;
     totalxferpoints:=0;
    end;
    assign (t,b);
    if not allowxfer then exit;
    if nofiles then exit;
    if useqr then begin
     calcqr;
     if (qr<qrlimit) and (ulvl<qrexempt) then begin
      writeln ('Your Quality Rating is '^S+strr(qr)+^R'.');
      writeln ('That exceeds the limit of '^S+strr(qrlimit)+^R'!');
      writeln ('You must get a better QR before you can download.');
      exit;
     end;
     end;
    if (area.download=false) then begin
     writeln;
     writeln ('Sorry, downloading is not allowed from this area!');
     writeln;
     exit;
    end;
    num:=getfilenum ('Add to Batch Buffer');
    if num=0 then exit;
    writeln;
    seek (udfile,num-1);
    read (udfile,ud);
    assign (ffff,getfname(ud.path,ud.filename));
    floyd:=checkok (ud);
    reset (ffff);
    playdoland:=filesize (ffff);
    close (ffff);
    if not floyd then exit else
    if (totalxfertime(totalxfersize)+minutes(playdoland))>timeleft then
     begin
      writeln ('You don''t have enough time left!');
      exit;
    end else
    if totalxfertime(totalxfersize)-5>timeleft then begin
     writeln ('The system event is coming up to soon to do the transfer!');
     exit;
    end else
    if (totalxferpoints+ud.points)>urec.udpoints then begin
     writeln ('You don''t have enough points left!');
     exit;
    end else
    begin
     if not exist (b) then rewrite (t) else reset (t);
     y:=numbatches+1;
     bbuffer[y].num:=num;
     bbuffer[y].fn:=ud.filename;
     bbuffer[y].path:=ud.path;
     bbuffer[y].descrip:=ud.descrip;
     bbuffer[y].dlpw:=ud.dlpw;
     bbuffer[y].extdesc:=ud.extdesc;
     bbuffer[y].points:=ud.points;
     bbuffer[y].filesize:=ud.filesize;
     bbuffer[y].downloaded:=ud.downloaded;
     bbuffer[y].sent:=false;
     close (t);
     totalxfersize:=totalxfersize+bbuffer[y].filesize;
     assign (fff,getfname(bbuffer[y].path,bbuffer[y].fn));
     reset (fff);
     totalxferpoints:=totalxferpoints+bbuffer[y].points;
     close (fff);
     writeln (^R'File added to Batch Download Buffer as #',numbatches,'.');
    end;
  end;

  function batchdownload (proto:char; fl:lstr; baud,comm:integer):integer;
  var cline,switchz,dirsave,cddir,wildcatsucks:lstr;
      baudst,commst:mstr;
      retcd:integer;
      foofur:text;
  begin
    dirsave:=forumdir;
    if dirsave[length(dirsave)]='\' then
    dirsave:=copy (dirsave,1,length(dirsave)-1);
    str (baud:3,baudst);
    str (comm:1,commst);
      case proto of
        'Z':cline:=cmdline(zmodems);
        'J':cline:=cmdline(jmodems);
        'L':cline:=cmdline(lynxs);
        'G':cline:=cmdline(ymodemgs);
        'S':cline:=cmdline(superks);
        'K':cline:=cmdline(k9xs);
        'P':cline:=cmdline(zpcps);
        'W':cline:=cmdline(wxmodems);
        'Y':cline:=cmdline(ybatchs);
      end;
      case proto of
       'Z':switchz:=' port '+commst+' speed '+baudst+' sz -s @'+fl;
       'J':switchz:=' p'+commst+' s'+baudst+' sjb f @'+fl;
       'L':switchz:=' S /'+commst+' /'+baudst+' @'+fl;
       'G':switchz:=' port '+commst+' speed '+baudst+' sb -g @'+fl;
       'S':switchz:=' p'+commst+' s'+baudst+' ssb f @'+fl;
       'K':switchz:=' p'+commst+' s'+baudst+' skb f @'+fl;
       'P':switchz:=' port '+commst+' speed '+baudst+' sz -w -s @'+fl;
       'Y':switchz:=' port '+commst+' speed '+baudst+' sb -s @'+fl;
       'W':switchz:=' p'+commst+' s'+baudst+' swb f @'+fl;
      {'X':switchz:=' p'+commst+' s'+baudst+' scb -s @'+fl;}
      end;
    write (^B);
    if (proto='Z') or (proto='G') or (proto='O') or (proto='1') or (proto='R')
    or (proto='P') then
    begin
     if (not exist (forumdir+'\DSZ.COM')) and (not exist (forumdir+'\DSZ.EXE'))
     then begin
      writeln;
      writeln (^G^R'DSZ Protocols are not available at the moment!');
      writeln ('Sysop does not have DSZ.COM or DSZ.EXE in the TCS directory.');
      writeln ('Please notify him!');
      writeln;
      writeln (usr,^M'[Changing Directories back to '+dirsave+']');
      chdir (dirsave);
      exit;
     end;
    end;
    if (proto='J') then begin
     if not exist (forumdir+'\JMODEM.COM') then
     begin
      writeln;
      writeln (^G^R'Jmodem Protocol is not available at the moment!');
      writeln ('Sysop does not have JMODEM.COM in the TCS directory.');
      writeln ('Please notify him!');
      writeln;
      writeln (usr,^M'[Changing Directories back to '+dirsave+']');
      chdir (dirsave);
      exit;
     end;
    end;
    if (proto='L') or (proto='E') then begin
     if not exist (forumdir+'\LYNX.EXE') then
     begin
      writeln;
      writeln (^G^R'Lynx Protocols is not available at the moment!');
      writeln ('Sysop does not have LYNX.EXE in the TCS directory.');
      writeln ('Please notify him!');
      writeln;
      writeln (usr,^M'[Changing Directories back to '+dirsave+']');
      chdir (dirsave);
      exit;
     end;
    end;
    if (proto='K') or (proto='S') or (proto='W') or (proto='X') then begin
     if not exist (forumdir+'\SUPERK.COM') then
     begin
      writeln;
      writeln (^G^R'Super8k/K9Xmodem Protocol is not available at the moment!');
      writeln ('Sysop does not have SUPERK.COM in the TCS directory.');
      writeln ('Please notify him!');
      writeln;
      writeln (usr,^M'[Changing Directories back to '+dirsave+']');
      chdir (dirsave);
      exit;
      end;
     end;
    assign (foofur,dszlog);
    if exist (dszlog) then erase (foofur);
    starttimer (numminsxfer);
    runext (retcd,cline,switchz);
    stoptimer (numminsxfer);
    chdir (dirsave);
    batchdownload:=retcd;
    setparam (usecom,baudrate,parity);
  end;

  function batchupload (proto:char; dir:lstr; baud,comm:integer):integer;
  var cline,switchz,dirsave,cddir,wildcatsucks:lstr;
      baudst,commst:mstr;
      retcd:integer;
      foofur:text;

  begin
    dirsave:=forumdir;
    if dirsave[length(dirsave)]='\' then
    dirsave:=copy (dirsave,1,length(dirsave)-1);
    str (baud:3,baudst);
    str (comm:1,commst);
      case proto of
        'Z':cline:=cmdline(zmodemr);
        'J':cline:=cmdline(jmodemr);
        'L':cline:=cmdline(lynxr);
        'G':cline:=cmdline(ymodemgr);
        'O':cline:=cmdline(xovrr);
        '1':cline:=cmdline(yovrr);
        'S':cline:=cmdline(superkr);
        'K':cline:=cmdline(k9xr);
        'R':cline:=cmdline(zcrashr);
        'P':cline:=cmdline(zpcpr);
        'E':cline:=cmdline(lynxcrashr);
        'W':cline:=cmdline(wxmodemr);
      end;
      case proto of
        'Z':switchz:=' port '+commst+' speed '+baudst+' rz '+dir;
        'J':switchz:=' p'+commst+' s'+baudst+' rjb f '+dir;
        'L':switchz:=' R /'+commst+' /'+baudst+' '+dir;
        'G':switchz:=' port '+commst+' speed '+baudst+' rb -g '+dir;
        'S':switchz:=' p'+commst+' s'+baudst+' rsb f '+dir;
        'K':switchz:=' p'+commst+' s'+baudst+' rkb f '+dir;
        'P':switchz:=' port '+commst+' speed '+baudst+' rz -w '+dir;
        'Y':switchz:=' port '+commst+' speed '+baudst+' rb '+dir;
        'W':switchz:=' p'+commst+' s'+baudst+' rw f '+dir;
        'X':switchz:=' p'+commst+' s'+baudst+' rcb '+dir;
    end;
    write (^B);
    if (proto='Z') or (proto='G') or (proto='O') or (proto='1') or (proto='R')
    or (proto='P') then
    begin
     if (not exist (forumdir+'\DSZ.COM')) and (not exist (forumdir+'\DSZ.EXE'))
     then begin
      writeln;
      writeln (^G^R'DSZ Protocols are not available at the moment!');
      writeln ('Sysop does not have DSZ.COM or DSZ.EXE in the TCS directory.');
      writeln ('Please notify him!');
      writeln;
      writeln (usr,^M'[Changing Directories back to '+dirsave+']');
      chdir (dirsave);
      exit;
     end;
    end;
    if (proto='J') then begin
     if not exist (forumdir+'\JMODEM.COM') then
     begin
      writeln;
      writeln (^G^R'Jmodem Protocol is not available at the moment!');
      writeln ('Sysop does not have JMODEM.COM in the TCS directory.');
      writeln ('Please notify him!');
      writeln;
      writeln (usr,^M'[Changing Directories back to '+dirsave+']');
      chdir (dirsave);
      exit;
     end;
    end;
    if (proto='L') or (proto='E') then begin
     if not exist (forumdir+'\LYNX.EXE') then
     begin
      writeln;
      writeln (^G^R'Lynx Protocols is not available at the moment!');
      writeln ('Sysop does not have LYNX.EXE in the TCS directory.');
      writeln ('Please notify him!');
      writeln;
      writeln (usr,^M'[Changing Directories back to '+dirsave+']');
      chdir (dirsave);
      exit;
     end;
    end;
    if (proto='K') or (proto='S') or (proto='W') or (proto='X') then begin
     if not exist (forumdir+'\SUPERK.COM') then
     begin
      writeln;
      writeln (^G^R'Super8k/K9Xmodem Protocol is not available at the moment!');
      writeln ('Sysop does not have SUPERK.COM in the TCS directory.');
      writeln ('Please notify him!');
      writeln;
      writeln (usr,^M'[Changing Directories back to '+dirsave+']');
      chdir (dirsave);
      exit;
      end;
     end;
    assign (foofur,dszlog);
    if exist (dszlog) then erase (foofur);
    starttimer (numminsxfer);
    runext (retcd,cline,switchz);
    stoptimer (numminsxfer);
    chdir (dirsave);
    batchupload:=retcd;
    setparam (usecom,baudrate,parity);
  end;

  function checkbatchlogs:char;
  var f:text;
      l,sn,code,bytes,xferfile,cps,bps,errors,blocksize,flowstops:anystr;
      c:string[1];
      done:boolean;
      x:integer;

  function parsespaces (s:anystr):anystr;
  var p,pee,xy:integer;
      k,j:char;
      r:anystr;
  begin
   parsespaces:=s;
   r:=s;
   repeat
   p:=pos (' ',r);
   if p>0 then begin
    delete (r,p,1);
   end;
   until p=0;
   parsespaces:=r;
  end;

  begin
   checkbatchlogs:=' ';
   if not exist (dszlog) then begin
    writeln (^G^G);
    ansicolor (12);
    writeln ('*********************************************');
    writeln ('** DSZLOG Error!! Please notify Sysop NOW! **');
    writeln ('*********************************************');
    ansicolor (urec.regularcolor);
    exit;
   end;
   assign (f,dszlog);
   reset (f);
   l:='';
   sn:=''; code:=''; bytes:=''; xferfile:='';
   cps:=''; bps:=''; errors:=''; blocksize:='';
   readln (f,l);
   code:=copy (l,1,1);
   bytes:=copy (l,2,7);
   bps:=copy (l,10,6);
   cps:=copy (l,19,5);
   errors:=copy (l,28,12);
   flowstops:=copy (l,40,6);
   blocksize:=copy (l,45,5);
   c:='';
   x:=50;
   repeat
    x:=x+1;
    if c='/' then c:='\';
    xferfile:=xferfile+c;
    c:=copy (l,x,1);
   until c=' ';
   sn:=copy (l,x+1,10);
   textclose (f);
   bps:=parsespaces (bps);
   cps:=parsespaces (cps);
   errors:=parsespaces (errors);
   bytes:=parsespaces (bytes);
   flowstops:=parsespaces (flowstops);
   blocksize:=parsespaces (blocksize);
   xferfile:=parsespaces (xferfile);
   sn:=parsespaces (sn);
   checkbatchlogs:=code[1];
   writeln (^R^B'Code-> '+code+'  Filename: '+xferfile);
   writeln ('Bytes sent: ',bytes,'  (',cps,' cps at ',bps,' bps)');
   writeln ('SN#: ',sn,'  Packet Length: ',blocksize,' bytes');
  end;

  procedure downbatch;
  var t:text;
      x,xferdood,cnt:integer;
      genesis,pro,thecode:char;
      mastermind:minuterec;
      tcs:udrec;

  begin
   assign (t,b);
   if totalxfertime(totalxfersize)>timeleft then begin
    writeln (^M'You don''t have enough time left!'^M);
    exit;
   end;
   if (totalxfertime(totalxfersize)-5>timetillevent) then begin
    writeln (^M'Sorry, the timed event is coming up to soon to do the xfer!'^M);
    exit;
   end;
   ansicls;
   if exist (b) then reset (t) else rewrite (t);
   for x:=1 to numbatches do
   begin
    writeln (t,bbuffer[x].fn);
    writeln (^R'Processing -> '^S,bbuffer[x].fn,^R);
   end;
   textclose (t);
   writeln;
   writeln (^S'        - Batch Protocols -'^R);
   writeln (^R' ['^S'Z'^R']-Zmodem            ['^S'Y'^R']-Ymodem ');
   writeln (^S'*'^R'['^S'G'^R']-Ymodem-G          ['^S'P'^R']-PCPursuit Zmodem');
 { writeln (^R' ['^S'J'^R']-Jmodem            ['^S'L'^R']-Lynx');
   writeln (^R' ['^S'S'^R']-Super8k           ['^S'K'^R']-K9Xmodem');
   writeln (^R' ['^S'W'^R']-Wxmodem           ['^S'X'^R']-Xmodem-CRC'); }
   writeln (^R' ['^S'Q'^R']-Quit/Abort');
   writeln (^S' * = '^R'Registered DSZ required');
   writeln;
   writestr ('Protocol: &');
   if length(input)=0 then exit;
   genesis:=upcase(input[1]);
   case genesis of
    'Y':pro:='Y';
    'Z':pro:='Z';
  { 'J':pro:='J';
    'L':pro:='L';
    'S':pro:='S'; }
    'G':pro:='G';
  { 'K':pro:='K'; }
    'P':pro:='P';
  { 'W':pro:='W'; }
    'X':pro:='X';
    'Q':pro:='N';
   end;
   if pro='N' then exit;
   write (^B^M);
   listbatch;
   if ascii then write ('■') else write ('*');
   writeln (' Batch Send Ready.');
   if tempsysop then begin
     ulvl:=regularlevel;
     tempsysop:=false;
     writeurec;
     bottomline
    end;
    {}{}{}
    if pro<>'N' then begin
     starttimer (mastermind);
     xferdood:=batchdownload (pro,b,baudrate,usecom);
     if xferdood<>0 then xferdood:=2;
     modeminlock:=false;
     beepbeep (xferdood);
     stoptimer (mastermind);
    end;
    thecode:=checkbatchlogs;
  { if (leechzmodem) and ((xferdood=1) or (xferdood=0)) then
    possiblelzm (totalxferpoints); }
    if (xferdood=0) or (xferdood=1) then begin
     for cnt:=1 to numbatches do
     begin
      seekudfile (bbuffer[cnt].num);
      read (udfile,tcs);
      tcs.downloaded:=tcs.downloaded+1;
      seekudfile (bbuffer[cnt].num);
      write (udfile,tcs);
      urec.udpoints:=urec.udpoints-bbuffer[cnt].points;
     end;
     urec.downloads:=urec.downloads+numbatches;
     urec.downk:=urec.downk+totalxfersize;
   { urec.timetoday:=urec.timetoday-elapsedtime(mastermind); }
     writeurec;
     settimeleft (urec.timetoday);
    end;
    {}{}{}
  end;

  procedure upbatch;
  begin

  end;

  procedure clearbatch;
  var x:integer;
      kaos:text;
  begin
   writestr ('Clear Batch Download Buffer [y/n]? *');
   if yes then begin
   totalxfersize:=0;
   totalxferpoints:=0;
   assign (kaos,b);
   for x:=1 to maxb do begin
    bbuffer[x].num:=-1;
    bbuffer[x].fn:='';
    bbuffer[x].path:='';
    bbuffer[x].descrip:='';
    bbuffer[x].dlpw:='';
    bbuffer[x].extdesc:='';
    bbuffer[x].points:=0;
    bbuffer[x].filesize:=0;
    bbuffer[x].downloaded:=0;
    bbuffer[x].sent:=false;
   end;
   if exist (b) then erase (kaos);
  end;
  end;

  procedure batchmenu;
  var i:integer;
  begin
   {}{}{}{}{}{
   BETA!!!!!!!!!!!!!!!!!!!!!!
   }{
   EXIT;
   }{}{}{}{}{}{
   BETA!!!!!!!!!!!!!!!!!!!!!!
   }
   ansicls;
   b:=forumdir+'Xferlist.TCS';
   writehdr ('Batch Xfer Menu');
   writeln (^R'Have filled '^S,numbatches,^R' spots in the Batch Buffer so far.');
   writeln (^R'Type '^S'[L]'^R' to list the Buffer.');
   repeat
      i:=menu('Batch Xfer Menu','BATCH','DULCQ');
      case i of
       1:downbatch;
       2:upbatch;
       3:listbatch;
       4:clearbatch;
      end
    until hungupon or (i=5)
  end;

end.