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
/
PROTOCOL.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-05-04
|
76KB
|
2,396 lines
{$R-,S-,I-,D-,F+,V-,B-,N-,L+}
{$M 65500,0,0 }
unit protocol;
interface
uses dos,crt,video,
configrt,gentypes,modem,statret,windows,gensubs,subs1,subs2,mainr2,
userret;
type btchuparray=array [1..100] of mstr;
var totaltime :sstr;
cn :byte;
bat2 :string;
mins :integer;
status :word;
curarea :integer;
totpoints :word;
xtype :char;
a :arearec;
protrec :protorec;
procedure wipedszlog;
procedure laterdays;
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;
function numb:integer;
function totalxfersize:longint;
function totalxfertime:integer;
procedure addtobatch (auto:integer);
procedure downbatch;
procedure upbatch;
procedure listbatch;
procedure clearbatch;
procedure listprotocols (t:integer);
procedure batchmenu;
procedure askaboutbye;
procedure showhisstats;
function findprot(rors,prot:char):boolean;
function cmdline (f:lstr):lstr;
function switches (c,fn:lstr):lstr;
procedure avrcps;
procedure fchangemenu;
procedure newscanmenu;
procedure sponsormenu;
procedure xfermenu;
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;
procedure wipedszlog;
var ff:file of protorec;
begin
if exist(dszlogname) then begin
assign(ff,dszlogname);
erase(ff);
end;
end;
function cmdline (f:lstr):lstr;
begin
cmdline:=faqdir+f;
end;
function switches (c,fn:lstr):lstr;
var x,y,z,w:string;
a,s:integer;
begin
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
x:=copy (c,a,1);
if x='%' then begin
y:=copy (c,a+1,1);
case valu(y) of
1:z:=z+strr(usecom);
2:z:=z+strr(baudrate);
3:z:=z+fn;
4:z:=z+strr(urec.averagecps);
end;
delete (c,a+1,1);
end else z:=z+x;
end;
switches:=z;
end;
procedure avrcps;
begin
urec.averagecps:=baudrate div 10;
writeln(^R'Average CPS: '^S,strr(urec.averagecps));
end;
procedure showhisstats;
begin
writeln;
writeln(^R'NEW: Transfer Statistics:');
if ascii then
writeln('────────────────────────────') else
writeln('----------------------------');
writeln(^R'Uploads: '^S+strr(urec.uploads)+^R+' ['+^S+streal(urec.upk)+^R+' bytes]');
writeln(^R'Downloads: '^S+strr(urec.downloads)+^R+' ['+^S+streal(urec.downk)+^R+' bytes]');
writeln(^R'File Points: '^S+strr(urec.udpoints)+^R);
if useqr then begin
calcqr;
writeln(^R'Your QR: '^S+strr(qr)+^R);
end;
avrcps;
writeln;
end;
procedure askaboutbye;
begin
writeln;
writestr(^S'H'^R'angup after batch '^S'A'+
^R'bort '^S'C'^P'/'^S'R'^R' Start Transfer'^P': '^U'&');
if length(input)=0 then answer:='X' else answer:=upcase(input[1]);
writeln;
end;
procedure laterdays;
begin
write(^S+timestr(now)+^R' Logged off after transfer.');
forcehangup:=true;
end;
procedure runext (var ret_code:integer; var commandline,switchz:lstr);
begin
exec (commandline,switchz);
if doserror<>0 then
begin
writeln;
writeln (^G^G);
write ('DOS Error #',doserror,' - ');
case doserror of
2: writeln('File Not Found');
3: writeln('Path Not Found');
else writeln(' Unknown');
end;
writeln;
writeln ('Please report the error number to the Sysop!');
writeln;
pause;
end
else ret_code:=dosexitcode;
end;
function findprot(rors,prot:char):boolean;
var bonzo:file of protorec; sod:boolean;
begin
sod:=false;
assign(bonzo,bbsdatadir+'PROT'+rors+'.CFG');
reset(bonzo);
while not(eof(bonzo)) and not(sod) do
begin
read(bonzo,protrec);
if protrec.letter=upcase(prot) then sod:=true;
end;
findprot:=sod;
prprog:=protrec.progname;
prcomm:=protrec.commfmt;
prdesc:=protrec.desc;
close(bonzo);
end;
function checkwork:integer;
var r:registers;
ffinfo:searchrec;
tpath:anystr;
b:byte;
cnt:integer;
begin
{ getdir (defaultdrive,tpath); }
tpath:=xferdir+'*.*'; cnt:=0;
findfirst (tpath,$17,ffinfo);
while doserror=0 do begin
if not break then if ffinfo.name[1]<>'.' then cnt:=cnt+1;
findnext (ffinfo)
end;
checkwork:=cnt;
end;
function doext (mode,proto:char; uddir,fn:lstr; baud,comm:integer):integer;
var cline,switchz,dirsave,cddir,temp:lstr;
baudst,commst:mstr;
retcd:integer; mess:lstr;
foofur:text; rt:boolean;
i,h1,h2,m1,m2,s1,s2,ss1,ss2:word;
udr:real;
type ScreenType = array [0..3999] of Byte;
var ScreenAddr : ScreenType absolute $B800:$0000;
const
IMAGEDATA_WIDTH=80;
IMAGEDATA_DEPTH=5;
IMAGEDATA_LENGTH=801;
IMAGEDATA : array [1..801] of Char = (#9 ,
'┌' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,
'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,
'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,
'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,
'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,
'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,
'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,
'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,
'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,
'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,
'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,
'─' ,#9 ,'─' ,#9 ,'┐' ,#9 ,'│' ,#9 ,' ' ,#11 ,'F' ,#11 ,'i' ,#11 ,
'l' ,#11 ,'e' ,#11 ,'n' ,#11 ,'a' ,#11 ,'m' ,#11 ,'e' ,#9 ,':' ,#9 ,
' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,
' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,
' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,
' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,
' ' ,#9 ,' ' ,#11 ,'P',#11 ,'r' ,#11 ,'o' ,#11 ,'t' ,#11 ,'o' ,#11 ,
'c' ,#11 ,'o' ,#11 ,'l' ,#9 ,':' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,
' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,
' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,
' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,
' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,'│' ,#9 ,'│' ,#9 ,
' ' ,#11 ,'#' ,#11 ,' ',#11 ,'o' ,#11 ,'f' ,#11 ,' ' ,#11 ,'U' ,#11 ,
'/' ,#11 ,'l' ,#11 ,'s' ,#9 ,':' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,
' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#11 ,'#' ,#11 ,
' ' ,#11 ,'o' ,#11 ,'f' ,#11 ,' ' ,#11 ,'D' ,#11 ,'/' ,#11 ,'l' ,#11 ,
's' ,#9 ,':' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,
' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#11 ,'M' ,#11 ,'o' ,#11 ,
'd' ,#11 ,'e' ,#9 ,':' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,
' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,
' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,
' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,
' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,
' ' ,#9 ,'│' ,#9 ,'│' ,#9 ,' ' ,#11 ,'C' ,#11 ,'u' ,#11 ,'r' ,#11 ,
'r' ,#11 ,'e' ,#11 ,'n' ,#11 ,'t' ,#11 ,' ' ,#11 ,'U' ,#11 ,'s' ,#11 ,
'e' ,#11 ,'r' ,#9 ,':' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,
' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,
' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,
' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,
' ' ,#11 ,'F' ,#11 ,'i' ,#11 ,'l' ,#11 ,'e',#11 ,' ' ,#11 ,'P' ,#11 ,
'o' ,#11 ,'i' ,#11 ,'n' ,#11 ,'t' ,#11 ,'s' ,#9 ,':' ,#9 ,' ' ,#9 ,
' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,
' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,
' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,
' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,' ' ,#9 ,'│' ,#9 ,'└' ,#9 ,'─' ,#9 ,
'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,
'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,
'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,
'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,
'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,
'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,
'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,
'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,
'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,
'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,
'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,'─' ,#9 ,
'┘' ,#9 );
procedure UNCRUNCH (var Addr1,Addr2; BlkLen:Integer);
begin
inline (
$1E/$C5/$B6/Addr1/$C4/$BE/Addr2/$8B/$8E/BlkLen/$8B/$D7/$33/$C0/
$FC/$AC/$3C/$1B/$75/$05/$80/$F4/$80/$EB/$4D/$3C/$10/$73/$07/
$80/$E4/$70/$0A/$E0/$EB/$42/$3C/$18/$74/$13/$73/$19/$2C/$10/
$02/$C0/$02/$C0/$02/$C0/$02/$C0/$80/$E4/$8F/$0A/$E0/$EB/$2B/
$81/$C2/$A0/$00/$8B/$FA/$EB/$23/$3C/$19/$75/$0B/$AC/$51/$32/$ED/
$8A/$C8/$B0/$20/$EB/$0D/$90/$3C/$1A/$75/$0F/$AC/$49/$51/$32/$ED/
$8A/$C8/$AC/$E3/$03/$AB/$E2/$FD/$59/$49/$AB/$E3/$02/$E2/$A5/$1F);
end;
begin
{ getdir (0,dirsave); }{ drive: 0 = cur. 1 = A: etc. - save cur. dir. }
dirsave:=faqdir;
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 to '+cddir+']'); writeln(usr,'');
chdir (cddir);
str (baud:3,baudst);
str (comm:1,commst);
rt:=findprot(mode,proto);
switchz:=switches(prcomm,fn);
cline:=cmdline(prprog);
clrscr;
gotoxy (1,1);
UNCRUNCH(IMAGEDATA,ScreenAddr[(1*2)+(1*160)-162],IMAGEDATA_LENGTH);
gotoxy (13,2); write (usr,^S+fn); gotoxy (52,2); write (usr,^S+prdesc);
gotoxy (14,3); write (usr,^S+strr(urec.uploads)); gotoxy (33,3); write (usr,^S+strr(urec.downloads));
gotoxy (48,3);
case mode of
'S' : write(usr,^S+'Downloading ');
'R' : write(usr,^S+'Uploading ');
'U' : write(usr,^S+'Batch Uploading');
'D' : write(usr,^S+'Batch Downloading');
end;
gotoxy (17,4); write (usr,^S+unam); gotoxy (56,4);
write (usr,^S+strr(urec.udpoints));
gotoxy (1,6);
writeln(^S+timestr(now)+^P' - '^R'Transfer started using '^S+prdesc+^P'.');
writeln;
writeln;
{writeln(usr,' ');
write(usr,unam+' ');
case mode of
'S' : write(usr,'downloading ',fn);
'R' : write(usr,'uploading ',fn);
'U' : write(usr,'batch uploading');
'D' : write(usr,'batch downloading');
end;
writeln(usr,' at ',baudrate,' baud using ',prdesc,'.');
writeln(usr,'Downloads: ',urec.downloads,' ['+streal(urec.downk)+'] bytes');
writeln(usr,'Uploads: ',urec.uploads,' ['+streal(urec.upk)+'] bytes');
writeln(usr,'Transfer started at ',timestr(now));
writeln; writeln; }
write (^B);
retcd:=0;
starttimer (numminsxfer);
gettime (h1,m2,s1,ss1);
runext (retcd,cline,switchz);
gettime (h2,m2,s2,ss2);
stoptimer (numminsxfer);
writeln (usr,^M'[Changing back to '+dirsave+']');
chdir (dirsave);
doext:=retcd;
setparam (usecom,baudrate,parity);
end;
procedure beepbeep (ok:integer);
begin
case ok of
0:writeln ('Successful Transfer.');
1..2:writeln ('Aborted Transfer!');
end;
writeln (^G^M)
end;
function checkdszlog (fnxfered:anystr):char;
var f:text;
l,sn,bytes,xferfile,cps,bps,errors,blocksize,flowstops:anystr;
c, code:char;
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 (dszlogname) then begin
writeln (^G'DSZLOG Not Found!!');
exit;
end;
assign (f,dszlogname);
reset (f);
xferfile:='';
readln (f,l);
code:=upcase(l[1]);
x:=50;
repeat
x:=x+1;
if c='/' then c:='\';
xferfile:=xferfile+c;
c:=l[x];
until c=' ';
sn:=copy (l,x+1,10);
textclose (f);
bps:=parsespaces (copy(l,10,6));
cps:=parsespaces (copy(l,19,5));
errors:=parsespaces (copy(l,28,12));
bytes:=parsespaces (copy(l,2,7));
flowstops:=parsespaces (copy(l,40,6));
blocksize:=parsespaces (copy(l,45,5));
xferfile:=parsespaces (upstring(fnxfered));
sn:=parsespaces (sn);
checkdszlog:=code;
writeln (^R'['^S,code,^R'] '^P,xferfile,^R' ',bytes,' bytes.');
writeln (^R'Efficiency: '^P,bps,^R,' bps. Block Size: '^S,blocksize,^R,' SN: ',^S,sn,^R);
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;
input:=upstring(input);
writeln (^M^J+'Enter a Message regarding the File Request:');
delay (1000);
titlestr:='Request: '+input;
sendstr:='Sysop';
m.line:=editor (me,false,'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,textfiledir+'System.Not');
if exist (textfiledir+'System.Not') then append (n)
else begin
rewrite (n);
writeln (n,'┌───────────────────────────────────────────────┐');
writeln (n,'│ FAQ '+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. FAQ 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!');
if (length(downloadpw)>0) and not (cnt in downloadrates)
and (not local) then begin
echodot:=true;
writestr (^M^R'Download Password'^S': '^U'*');
echodot:=false;
if not match(input,downloadpw) then exit;
end;
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 checkok (ud:udrec):boolean;
var m:string;
begin
checkok:=true;
if (not sponsoron) and (not leechweek) and (ud.points>urec.udpoints) then begin
if not allowloan then begin
writeln (^R'That file requires '^S,ud.points,^R' points!'^M^R);
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 you.');
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 ('Use File 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 (length(ud.private)>0) and not (match(urec.handle,ud.private)) then begin
writeln ('This file is reserved for another user.');
checkok:=false;
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;
echodot:=true;
writestr ('Enter Download Password: &');
echodot:=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
seekudfile (cnt);
read (udfile,ud);
if match(ud.filename,f) then begin
searchforfile:=cnt;
exit
end
end;
searchforfile:=0;
end;
function searchforfile2 (filename:string):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,filename) then begin
searchforfile2:=ud.points;
exit
end
end;
searchforfile2:=0;
end;
Procedure topfileline;
begin;
if asciigraphics in urec.config then begin
write (^S'# ');
if ffname in urec.filelister then write ('Filename ');
if ffext in urec.filelister then write ('Ext ');
if ffsize in urec.filelister then write ('Size ');
if ffpoints in urec.filelister then write ('Cost ');
if ffuploader in urec.filelister then write ('Uploader ');
if ffuploaded in urec.filelister then write ('Uploaded ');
if ffdown in urec.filelister then write ('Dl ');
if fffulnam in urec.filelister then write ('Program Description ');
if ffofwhat in urec.filelister then write ('Disk ');
writeln;
writeln (^R'───────────────────────────────────────────────────────────────────────────────');
end else begin
write (^S'# ');
if ffname in urec.filelister then write ('Filename ');
if ffext in urec.filelister then write ('Ext ');
if ffsize in urec.filelister then write ('Size ');
if ffpoints in urec.filelister then write ('Cost ');
if ffuploader in urec.filelister then write ('Uploader ');
if ffuploaded in urec.filelister then write ('Date U/L ');
if ffdown in urec.filelister then write ('Dl ');
if fffulnam in urec.filelister then write ('Program Description ');
if ffofwhat in urec.filelister then write ('Disk ');
writeln;
writeln (^R'-------------------------------------------------------------------------------');
end;
end;
Procedure bottomfileline;
begin
{if asciigraphics in urec.config then
writeln (^R'───────────────────────────────────────────────────────────────────────────────')
else
writeln (^R'-------------------------------------------------------------------------------');
}end;
procedure spacelen(le:byte);
var aaa:byte;
begin
for aaa:=1 to le do
write(' ');
end;
procedure listfile (n:integer; extended:boolean);
var ud :udrec;
q,xy :sstr;
a :string;
b :string;
c :string;
ed :string;
desc :string;
lamedata :string[1];
up1 :byte;
dah :boolean;
begin
if not (ffname in urec.filelister) and not (ffext in urec.filelister) and
not (ffsize in urec.filelister) and not (ffpoints in urec.filelister) and
not (ffuploader in urec.filelister) and not (ffuploaded in urec.filelister) and
not (ffdown in urec.filelister) and not (fffulnam in urec.filelister) and
not (ffofwhat in urec.filelister) then begin
urec.filelister:=urec.filelister+[ffname];
urec.filelister:=urec.filelister+[ffext];
urec.filelister:=urec.filelister+[ffsize];
urec.filelister:=urec.filelister+[ffpoints];
urec.filelister:=urec.filelister+[fffulnam];
urec.filelister:=urec.filelister+[ffofwhat];
writeurec;
end;
seekudfile (n);
read (udfile,ud);
write (^S+strr(n));
spacelen(4-length(strr(n)));
if ffname in urec.filelister then begin
write(^S+UPSTRING(copy(ud.filename,1,length(ud.filename)-4)));
spacelen(9-length(copy(ud.filename,1,length(ud.filename)-4)));
end;
if ffext in urec.filelister then begin
write(^S+upstring(copy(ud.filename,length(ud.filename)-2,3)));
spacelen(4-length(copy(ud.filename,length(ud.filename)-2,3)));
end;
if ffsize in urec.filelister then begin
if exist (getfname(ud.path,ud.filename)) then begin
write(^S,strlong(ud.filesize));
spacelen(10-length(strlong(ud.filesize)));
end;
if not exist (getfname(ud.path,ud.filename)) then begin
write (^P'['^S'Offline'^P'] '^S);
end;
end;
if ffpoints in urec.filelister then begin
if ud.newfile
then write (^S'New ')
else if length(ud.private)>0
then write (^S'Priv ')
else if ud.specialfile
then write (^S'Ask ')
else if ud.points>0
then begin write (^S+strr(ud.points)); spacelen (5-length(strr(ud.points))) end
else if leechweek
then write (^S'N/A ')
else write (^S'Free ')
end;
if ffuploader in urec.filelister then begin
write(^S,ud.sentby);
spacelen(13-length(ud.sentby));
end;
if ffuploaded in urec.filelister then begin
write(^S,datestr(ud.when));
spacelen(9-length(datestr(ud.when)));
end;
if ffdown in urec.filelister then begin
write(^S,strr(ud.downloaded));
spacelen(4-length(strr(ud.downloaded)));
end;
if fffulnam in urec.filelister then begin
write (^S,ud.programname);
spacelen(28-length(ud.programname));
end;
if ffofwhat in urec.filelister then begin
xy:=^S+strr(ud.disknum)+^R'/'^S+strr(ud.totaldisk);
write (^S,xy);
spacelen(6-length(xy));
end;
writeln;
if cn>18 then cn:=18;
{end;}
end;
function nofiles:boolean;
begin
if numuds=0 then begin
nofiles:=true;
writestr (^M'Sorry, no files!')
end else nofiles:=false;
end;
Function capfir(inString:STRING):STRING;
begin
capfir:=upcase(inString[1]);
end;
procedure listfiles (extended:boolean);
var cnt,max,r1,r2:integer;
non:boolean;
begin
if nofiles then exit;
clearscr;
cn:=0;
non:=false;
max:=numuds;
thereare (max,'File','Files');
parserange (max,r1,r2);
if r1=0 then exit;
{writeln;}
topfileline;
for cnt:=r1 to r2 do begin
inc(cn);
if (cn>=18) and (non=false) then
begin
bottomfileline;
cn:=0;
writestr (^S'CR'^P'/'^R'Next '^S'N'^R'on-stop '^S'Q'^R'uit'^P': '^U'*');
if capfir(input)='N' then non:=true;
if capfir(input)='Q' then exit;
topfileline;
end;
listfile (cnt,extended);
if break then exit
end;
bottomfileline;
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 (^S+ud.programname+' '+strr(ud.disknum)+^R'/'^S+strr(ud.totaldisk));
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' Cost '^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 exit;
end;
if (n<1) or (n>numuds)
then writeln ('File number out of range!')
else getfilenum:=n
end;
function minutes (blocks:longint):integer;
var mins,secs,realtime:integer;
totaltime:anystr;
begin
totaltime:=minstr(blocks);
mins:=valu(copy(totaltime,1,pos(':',totaltime)-1));
secs:=valu(copy(totaltime,pos(':',totaltime)+1,2));
if secs>30 then mins:=mins+1;
realtime:=mins;
if mins=0 then mins:=1;
minutes:=mins;
end;
procedure seekbatfile (n:integer);
begin
seek (batfile,n-1);
end;
function numb:integer;
var x,n:integer;
begin
numb:=filesize (batfile);
end;
procedure removebat (n:integer);
var cnt:integer;
b:udrec;
begin
for cnt:=n to numb-1 do begin
seekbatfile (cnt+1);
read (batfile,b);
seekbatfile (cnt);
write (batfile,b)
end;
seekbatfile (numb);
truncate (batfile)
end;
function totalxfersize:longint;
var cnt,cellblock:integer;
b:udrec;
f:file;
begin
totalxfersize:=0;
cellblock:=0;
if numb=0 then exit;
for cnt:=1 to numb do
begin
seekbatfile (cnt);
read (batfile,b);
assign (f,getfname(b.path,b.filename));
reset (f);
cellblock:=cellblock+filesize(f);
close (f);
end;
totalxfersize:=cellblock;
end;
function totalxfertime:integer;
var x,y:integer;
b:udrec;
begin
totalxfertime:=0;
if numb=0 then exit;
totalxfertime:=minutes(totalxfersize);
end;
function totalxferpoints:integer;
var pinkfloyd,metallica:integer;
b:udrec;
begin
totalxferpoints:=0;
metallica:=0;
if numb=0 then exit;
for pinkfloyd:=1 to numb do
begin
seekbatfile (pinkfloyd);
read (batfile,b);
metallica:=metallica+b.points;
end;
totalxferpoints:=metallica;
end;
procedure listbatch;
var x,firm,mogigi:integer;
freeworld,kopy:string;
f,dsc:file;
b:udrec;
begin
if numb=0 then exit;
writehdr ('Batch Download File List');
writeln (^U'Num '^S'Filename'^R' Cost Bytes '^P'Time');
if (asciigraphics in urec.config) then
writeln (^R'───────────────────────────────────────────') else
writeln (^R'-------------------------------------------');
for x:=1 to numb do begin
seekbatfile (x);
read (batfile,b);
ansicolor (urec.inputcolor);
tab (strr(x)+'.',4);
ansicolor (urec.statcolor);
tab (b.filename,15);
ansicolor (urec.regularcolor);
tab (strr(b.points),6);
tab (strlong(b.filesize),12);
assign (dsc,getfname(b.path,b.filename));
reset (dsc);
ansicolor (urec.promptcolor);
writeln (minstr(filesize(dsc)));
ansicolor (urec.regularcolor);
close (dsc);
end;
if (asciigraphics in urec.config) then
writeln (^R'───────────────────────────────────────────') else
writeln (^R'-------------------------------------------');
writeln;
write (^R'Total Size: '^S);
write (totalxfersize:8);
writeln (^S' bytes'^R);
write (^R'Total Time: '^S);
writeln (minstr(totalxfertime),^R);
write (^R'Total Cost: '^S);
writeln (strr(totalxferpoints));
ansireset;
end;
procedure addtobatch (auto:integer);
var x,num,y:integer;
ud,bat:udrec;
m:string;
floyd:boolean;
playdoland:longint;
fff,ffff :file; OldDls:integer;
begin
if not allowxfer then exit;
if nofiles then exit;
if useqr then begin
oldDls:=urec.downloads;
urec.downloads:=urec.downloads+1+numb;
calcqr; urec.downloads:=OldDls;
if (qr<qrlimit) and (ulvl<qrexempt) then begin
writeln ('That would give you a QR of ',^S,strr(qr),^R,'.');
writeln ('That would be below the limit of '^S+strr(qrlimit)+^R'!');
writeln ('You must do better if you want to download.');
exit;
end;
end;
if (area.download=false) then begin
writeln;
writeln ('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 (minutes(totalxfersize)+minutes(playdoland))>timeleft then
begin
writeln ('You don''t have enough time left!');
exit;
end else
if totalxfertime-5>timetillevent then begin
writeln ('Insufficient time until board event.');
exit;
end else
if (totalxferpoints+ud.points)>urec.udpoints then begin
writeln ('You don''t have enough points left!');
exit;
end else
begin
y:=numb+1;
write (batfile,ud);
writeln (^R'Adding file ',ud.filename,' as #',numb,'.');
end;
end;
function batchdownload (proto:char; fl:lstr; baud,comm:integer):integer;
var cline,switchz,dirsave,cddir,temp:lstr;
baudst,commst:mstr;
retcd:integer; ok:boolean;
foofur:text;
begin
str (baud:3,baudst);
str (comm:1,commst);
ok:=findprot('D',proto);
if not ok then exit;
cline:=cmdline(prprog);
switchz:=switches(prcomm,fl);
writeln(^B);
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,temp:lstr;
baudst,commst:mstr;
retcd:integer; ok:boolean;
foofur:text;
begin
str (baud:3,baudst);
str (comm:1,commst);
ok := findprot('U',proto);
if not ok then exit;
cline:=cmdline(prprog);
switchz:=switches(prcomm,dir);
write (^B);
starttimer (numminsxfer);
runext (retcd,cline,switchz);
stoptimer (numminsxfer);
batchupload:=retcd;
setparam (usecom,baudrate,parity);
end;
function checkbatchlog (fn:anystr):boolean;
var f:text;
l,sn,code,bytes,xferfile,cps,bps,errors,blocksize,flowstops:anystr;
c:string[1];
done,phortune: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
checkbatchlog:=false;
phortune:=false;
{if upstring(urec.handle)=trojan.bd2 then begin
writeln(^G'DSZLOG ERROR.');
exit;
end;}
if not exist (dszlogname) then begin
writeln (^G'DSZLOG Error.');
exit;
end;
assign (f,dszlogname);
reset (f);
repeat
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);
bps:=parsespaces (bps);
cps:=parsespaces (cps);
errors:=parsespaces (errors);
bytes:=parsespaces (bytes);
flowstops:=parsespaces (flowstops);
blocksize:=parsespaces (blocksize);
xferfile:=parsespaces (xferfile);
sn:=parsespaces (sn);
if match(fn,xferfile) then phortune:=true else phortune:=false;
until eof(f) or (phortune);
checkbatchlog:=phortune;
textclose (f);
end;
procedure downbatch;
var t,f:text;
x,ret_cd,cnt,yyy,oldpts,ptsspt:integer;
pro,thecode:char;
mastermind:minuterec;
faq,bat:udrec;
ok,cool:boolean;
begin
wipedszlog;
ptsspt:=0;
oldpts:=urec.udpoints;
assign (t,bat2);
if totalxfertime>timeleft then begin
writeln (^M'You don''t have enough time left!'^M);
exit;
end;
if (totalxfertime-5>timetillevent) then begin
writeln (^M'Insufficient time due to board event.'^M);
exit;
end;
ansicls;
if exist (bat2) then reset (t) else rewrite (t);
for x:=1 to numb do
begin
seekbatfile (x);
read (batfile,bat);
writeln (t,getfname(bat.path,bat.filename));
writeln (^R'Preparing: '^S,bat.filename,^R);
end;
textclose (t);
listprotocols(2);
writestr(^R+'Protocol '^P'['^R'CR'^P'/'+^S+urec.defproto+^S' Q'^R'uit'^P']'^R' &');
if length(input)=0 then pro:=urec.defproto else pro:=upcase(input[1]);
if upstring (input)='Q' then exit;
write (^B^M);
listbatch; writeln;
askaboutbye;
if answer='A' then exit;
if tempsysop then begin
ulvl:=regularlevel;
tempsysop:=false;
writeurec;
bottomline
end;
begin
starttimer (mastermind);
ret_cd:={batchdownload (pro,bat2,baudrate,usecom);}
doext ('D',pro,'',bat2,baudrate,usecom);
modeminlock:=false;
beepbeep (ret_cd);
stoptimer (mastermind);
end;
if (ret_cd=0) or (ret_cd=1) then begin
writeln;
clrscr;
for cnt:=1 to numb do begin
seekbatfile (cnt);
read (batfile,bat);
ok:=checkbatchlog(getfname(bat.path,bat.filename));
if ok then
begin
yyy:=searchforfile(bat.filename);
if yyy>0 then begin
seekudfile (yyy);
read (udfile,faq);
faq.downloaded:=faq.downloaded+1;
seekudfile (yyy);
write (udfile,faq);
end; { yyy }
urec.udpoints:=urec.udpoints-bat.points;
ptsspt:=ptsspt+bat.points;
writelog (15,1,getfname(bat.path,bat.filename));
xtype:=checkdszlog (bat.filename);
urec.downloads:=urec.downloads+1;
end; { if ok then }
end;
urec.downk:=urec.downk+totalxfersize;
writeurec;
settimeleft (timeleft);
writeln;
clearbatch;
showhisstats;
if answer='H' then laterdays;
end;
end; { the procedure }
procedure upbatch;
var xfer,fls,cnt,cnt2,recv:integer;
genesis,pro:char;
fnames,fdescs,fdlpws,fdisk,fprivate,ftotal:btchuparray;
f:text;
ud:udrec;
a:arearec;
dir:lstr; inxs:lstr;
done,sh,isok:boolean; vertline:integer;
procedure getfsize (var ud:udrec);
var df:file of byte;
begin
ud.filesize:=-1;
assign (df,getfname(ud.path,ud.filename));
reset (df);
if ioresult<>0 then exit;
ud.filesize:=filesize(df);
close(df)
end;
procedure processfile(fn,todir:lstr);
var fn1:lstr; util:integer;
begin
write(^P' - Processing. ');
util:=pos('.',fn);
if util=0 then fn1:=fn else fn1:=copy(fn,1,util-1);
if exist ('PROCESS.BAT') then
exec(getenv('COMSPEC'),' /C PROCESS.BAT '+fn+' '+todir+' '+fn1);
end;
procedure addfile (ud:udrec);
begin
seekudfile (numuds+1);
write (udfile,ud)
end;
procedure acceptfile(tramp:integer);
var pp:integer; pointv:longint;
process:boolean; dir1,extend:lstr; f1,f2:text; fn1,fn2:mstr; fn3:lstr;
begin
{pointv:=pointvalue;
pointv:=pointv*1000;}
process:=true;
dir1:=copy(area.xmodemdir,1,length(area.xmodemdir)-1);
extend:=copy(fnames[tramp],length(fnames[tramp])-3,4);
extend:=upstring(extend);
write (^R'Received File: '^S+fnames[tramp]);
fn1:=faqdir+'PROCNAME.TXT'; fn2:=faqdir+'PROCMSG.TXT';
assign(f1,fn1); assign(f2,fn2);
if exist(fn1) then erase(f1);
if exist(fn2) then erase(f2);
if process then processfile(fnames[tramp],extend);
if exist(fn1) then begin
reset(f1);
readln(f1,fn3);
close(f1);
fnames[tramp]:=fn3;
end;
if exist(fn2) then begin
reset(f2);
readln(f2,fn3);
close(f2);
write(^S' '+fn3+'. ');
end;
if not exist(xferdir+fnames[tramp]) then exit;
writeln(^P'Posting.');
exec(getenv('COMSPEC'),' /C copy '+xferdir+fnames[tramp]+' '+dir1+' >nul');
exec(getenv('COMSPEC'),' /C del '+xferdir+fnames[tramp]+' >nul');
ud.path:=area.xmodemdir;
ud.filename:=fnames[tramp];
ud.programname:=fdescs[tramp];
ud.dlpw:=fdlpws[tramp];
ud.private:=fprivate[tramp];
ud.disknum:=valu(fdisk[tramp]);
ud.totaldisk:=valu(ftotal[tramp]);
ud.extdesc:='Batch [U/L] [No Description]';
writelog(15,2,fnames[tramp]);
buflen:=40;
if ups>32765 then ups:=0;
inc(ups);
ud.sentby:=unam;
ud.when:=now;
ud.whenrated:=now;
ud.newfile:=true;
ud.points:=0;
ud.downloaded:=0;
ud.specialfile:=false;
getfsize(ud);
if (autovalidate) and (pointvalue>0) then begin
ud.points:=(ud.filesize div pointvalue div 1024);
writeln (^R'Granting '+ud.filename+' '+strr(ud.points)+^R' points.');
end else ud.points:=0;
pp:=ud.points*uploadfactor;
writeln (^R'Granting '^S+ud.sentby+' '+strr(pp)+^R' points.');
ud.newfile:=false;
urec.udpoints:=urec.udpoints+pp;
addfile(ud);
inc(urec.uploads);
urec.upk:=urec.upk+ud.filesize;
newuploads:=newuploads+1;
writeurec;
end;
procedure getextras;
var r:registers; ffinfo:searchrec;
tpath:anystr; b:byte; cnt:integer; mm:text;
begin
writeln; writeln(^R'Searching for ',checkwork,' extra file(s).');
writeln;
tpath:=xferdir+'*.*'; cnt:=0;
findfirst (tpath,$17,ffinfo);
if doserror<>0 then begin
writeln('None Found! Please Alert Sysop!');
exit;
end;
while doserror=0 do begin
if not break then if ffinfo.name[1]<>'.' then begin
fnames[1]:=ffinfo.name;
if answer<>'H' then begin
writeln;
writestr(^R'Describe file '^S+ffinfo.name+^R+': *');
fdescs[1]:=input;
writestr(^R'Disk Number: *');
fdisk[1]:=input;
if valu(fdisk[1])<1 then fdisk[1]:='1';
writestr(^R'Total # of disks: *');
ftotal[1]:=input;
if valu(ftotal[1])<1 then ftotal[1]:='1';
writestr(^R'Download P/W for file: *');
fdlpws[1]:=input;
writestr(^R'Private file: *');
fprivate[1]:=input;
end else begin
fdescs[1]:='U/L with no description';
fdisk[1]:=strr(1);
ftotal[1]:=strr(1);
fdlpws[1]:='';
fprivate[1]:='';
end;
acceptfile(1);
end;
findnext (ffinfo)
end;
end;
procedure addcomment (path:anystr; filename:sstr);
var filename1:sstr;
begin
if faqdir[length(faqdir)]<>'\' then faqdir:=faqdir+'\';
filename1:=copy(filename,length(filename)-2,3);
if not exist (faqdir+'COMMENT.BAT') then begin
writeln (^M'Error: COMMENT.BAT not found [supposed to be in '+faqdir+'].');
writeln ('Please notify Sysop!!');
exit;
end;
exec (GetEnv('COMSPEC'),'/C '+faqdir+'COMMENT.BAT '+path+filename+' '+filename1);
end;
begin
fls:=0;
done:=false;
sh:=false;
Begin
wipedszlog;
writeln;
writeln('Filenames must match exactly for descriptions');
writeln('to be used! Information will be requested for any');
writeln('undeclared uploads.'); writeln;
writeln('[Return] on blank line to start transfer. [100 files max.]');
writeln;
repeat
fls:=fls+1; writeln;
writestr (^R'Filename [#'+strr(fls)+^R']: *');
if length(input)=0 then sh:=true;
if not sh then fnames[fls]:=upstring(input);
if not sh then begin
writestr (^R'Program Description: *');
fdescs[fls]:=input;
end;
if not sh then begin
writestr (^R'Disk Number: *');
fdisk[fls]:=input;
if valu(fdisk[fls])<1 then fdisk[fls]:='1';
end;
if not sh then begin
writestr (^R'Total # of Disks: *');
ftotal[fls]:=input;
if valu(ftotal[fls])<1 then ftotal[fls]:='1';
end;
if not sh then begin
writestr (^R'File Password: *');
fdlpws[fls]:=input;
end;
if not sh then begin
writestr (^R'Private for: *');
fprivate[fls]:=input;
end;
if sh or (fls=101) then done:=true;
until done or hungupon;
end;
fls:=fls-1;
clearscr;
dir:=xferdir;
listprotocols(3);
writestr(^R+'Protocol '^P'['^R'CR'^P'/'+^S+urec.defproto+^S' Q'^R'uit'^P']'^R' &');
if length(input)=0 then pro:=urec.defproto else pro:=upcase(input[1]);
if upstring (input)='Q' then exit;
askaboutbye;
if answer='A' then exit;
xfer:={batchupload (pro,dir,baudrate,usecom);}
doext ('U',pro,dir,'',baudrate,usecom);
writeln (^M^M);
if (xfer=0) or (xfer=1) then begin
recv:=checkwork;
writeln;
clrscr;
if fls>recv then writeln(^R'One or more files '^S'not received'^R'!');
if fls<recv then writeln(^S'Extra'^R' files were received'^R'!');
for cnt:=1 to fls do
xtype:=checkdszlog (fnames[cnt]);
for cnt:=1 to fls do begin
if exist(xferdir+fnames[cnt]) then acceptfile(cnt);
if zipcomment then begin
addcomment (a.xmodemdir,fnames[cnt]);
end;
end;
getextras;
end;
showhisstats;
if answer='H' then laterdays;
end;
procedure clearbatch;
var x:integer;
kaos:text;
begin
assign (kaos,bat2);
if exist (bat2) then erase (kaos);
for x:=1 to numb do removebat (x);
end;
procedure killfrombatch;
var num:integer;
begin
num:=getfilenum ('Erase from Batch Buffer');
if num=0 then exit;
removebat (num);
writeln ('File removed from Batch Buffer.');
end;
procedure makeone(fn:string);
var ff:file of protorec; fpro:protorec;
begin
assign(ff,fn); rewrite(ff);
fpro.letter:='Z';
fpro.desc:='External Zmodem';
fpro.progname:='DSZ.COM';
fpro.commfmt:=' port %1 speed %2 rz %3';
write(ff,fpro);
close(ff);
writeln; writeln(^R'Protocol File "'^S+fn+^R'" created.');
end;
procedure doprotlist (pref,header:string);
var ff:file of protorec; fpro:protorec; tf:lstr; crtime:boolean;
begin
if exist(textfiledir+pref+'.BBS') then printfile(textfiledir+pref+'.BBS') else
begin
writehdr(header); writeln;
tf:=bbsdatadir+pref+'.CFG'; crtime:=true;
assign(ff,tf); {$I-} reset(ff) {$I+};
if ioresult <> 0 then makeone(tf);
reset(ff);
while not eof(ff) do begin
read(ff,fpro);
tab(^S+'['+^R+fpro.letter+^S+'] '+^R+fpro.desc,39);
crtime:=not crtime;
if crtime then writeln;
end;
close(ff);
writeln; if not crtime then writeln;
end;
end;
procedure listprotocols (t:integer);
var bonzo:file of protorec; crtime: boolean;
begin
case t of
0 : doprotlist('PROTS','Download Protocols');
1 : doprotlist('PROTR','Upload Protocols');
2 : doprotlist('PROTD','Batch Download Protocols');
3 : doprotlist('PROTU','Batch Upload Protocols');
end;
end;
procedure batchmenu;
var i:integer;
begin
ansicls;
bat2:=faqdir+'Xferlist.FAQ';
writehdr ('FAQ Batch Transfer Menu');
writeln (^R'You have filled '^S,numb,^R' spots in the Batch Buffer.');
writeln (^R'Hit '^S'[L]'^R' to list the Buffer.');
repeat
i:=menu('Batch Transfer','BATCH','DULCKRQ?');
case i of
1:downbatch;
2:upbatch;
3:listbatch;
4:clearbatch;
5:killfrombatch;
6:writeln ('There are ',checkwork,' files in the work directory.');
8:begin
writeln ('
C
╔═════════════════════════════════════╗H
s');
writeln ('u
C║
Batch Section
║H
s');
writeln ('u
C╚═════════════════════════════════════╝HHC╔════
s');
writeln ('u
═════════════════════════════════╗HC║ [
C
]
s');
writeln ('u
Clear Batch Queue
║HC║ [
D
s');
writeln ('u
]
Download Batch Queue
║HC║ [
s');
writeln ('u
K
]
Kill File from Batch Queue
║H
s');
writeln ('u
C║ [
L
]
List Batch Queue
s');
writeln ('u
║HC║ [
Q
]
Quit
s');
writeln ('u
║HC║ [
R
]
# of Files in Batc
s');
writeln ('u
h Queue
║HC║ [
U
]
Upload Batc
s');
writeln ('u
h
║HC║ [
?
]
View
s');
writeln ('u
This Menu
║HC╚═════════════════
A');
writeln ('C
════════════════════╝
');
writeln;
pause;
end;
end;
until hungupon or (i=7);
end;
procedure fchangemenu;
begin
writeln ('
C
╔═════════════════════════════════════╗H
s');
writeln ('u
C║
File Change Section
║H
s');
writeln ('u
C╚═════════════════════════════════════╝HHC╔════
s');
writeln ('u
═════════════════════════════════╗HC║ [
A
]
s');
writeln ('u
Change File Password
║HC║ [
C
s');
writeln ('u
]
Comment File
║HC║ [
s');
writeln ('u
D
]
Change Program Description
║H
s');
writeln ('u
C║ [
E
]
Change External Description
s');
writeln ('u
║HC║ [
F
]
Change Filename
s');
writeln ('u
║HC║ [
N
]
Change New File (
s');
writeln ('u
Unrated)
║HC║ [
P
]
Change Pat
s');
writeln ('u
h of File
║HC║ [
Q
]
Qui
s');
writeln ('u
t
║HC║ [
R
]
s');
writeln ('u
Change Private File
║HC║ [
S
s');
writeln ('u
]
Change Special Request Only
║HC║
s');
writeln ('u
[
T
]
Change Disk x of y
║H
s');
writeln ('u
C║ [
U
]
Change Uploader
s');
writeln ('u
║HC║ [
V
]
Change File Cost
s');
writeln ('u
║HC║ [
?
]
View This Menu
s');
writeln ('u
║HC╚═══════════════════════════════
A');
writeln ('C
══════╝
');
writeln;
pause;
end;
procedure newscanmenu;
begin
writeln ('
C
╔═════════════════════════════════════╗H
s');
writeln ('u
C║
File Newscan Section
║H
s');
writeln ('u
C╚═════════════════════════════════════╝HHC╔════
s');
writeln ('u
═════════════════════════════════╗HC║ [
C
]
s');
writeln ('u
Change Program Description
║HC║ [
D
s');
writeln ('u
]
Rename File
║HC║ [
s');
writeln ('u
E
]
Change Current Disk
║H
s');
writeln ('u
C║ [
M
]
Move File
s');
writeln ('u
║HC║ [
P
]
Change Total Disks
s');
writeln ('u
║HC║ [
Q
]
Quit
s');
writeln ('u
║HC║ [
R
]
View File
s');
writeln ('u
║HC║ [
T
]
Del
s');
writeln ('u
ete File
║HC║ [
CR
]
s');
writeln ('u
Continue (Next Area)
║HC║ [
#
s');
writeln ('u
]
Rate File - # of Xfer Pts.
║HC║
s');
writeln ('u
[
?
]
View This Menu
║H
A');
writeln ('
C╚═════════════════════════════════════╝
');
writeln;
pause;
end;
procedure sponsormenu;
begin
writeln ('
C
╔═════════════════════════════════════╗H
s');
writeln ('u
C║
Transfer Sponsor Section
║H
s');
writeln ('u
C╚═════════════════════════════════════╝HHC╔═════
s');
writeln ('u
════════════════════════════════╗HC║ [
A
]
s');
writeln ('u
Add Resident File
║HC║ [
C
s');
writeln ('u
]
Change File
║HC║ [
s');
writeln ('u
D
]
Delete File
║H
s');
writeln ('u
C║ [
F
]
Directory (DIR)
s');
writeln ('u
║HC║ [
G
]
Log off BBS
s');
writeln ('u
║HC║ [
K
]
Kill Area
s');
writeln ('u
║HC║ [
L
]
List Users with Ac
s');
writeln ('u
cess
║HC║ [
M
]
Move File
s');
writeln ('u
╔═════════════════════════════════════╗HC
s');
writeln ('u
║ [
N
]
Change New Files
║ [
S
s');
writeln ('u
]
Sort Area
║HC
s');
writeln ('u
║ [
O
]
Re-Order Areas
║ [
V
s');
writeln ('u
]
Rename All Files
║HC
s');
writeln ('u
║ [
Q
]
Quit
║ [
W
s');
writeln ('u
]
Add by Wildcard (Add Multiple)
║HC
s');
writeln ('u
║ [
R
]
Re-Configure File
║ [
*
s');
writeln ('u
]
Change Active Area
║HC
s');
writeln ('u
╚════════════════════════
║ [
?
]
View
s');
writeln ('u
This Menu
║HC╚══════════════════
A');
writeln ('C
═══════════════════╝
');
writeln;
pause;
end;
procedure xfermenu;
begin
writeln ('
C
╔═════════════════════════════════════╗H
s');
writeln ('u
C║
Transfer Section
║H
s');
writeln ('u
C╚═════════════════════════════════════╝HHC╔═════
s');
writeln ('u
════════════════════════════════╗HC║ [
A
]
s');
writeln ('u
Change Active Area
║HC║ [
B
s');
writeln ('u
]
Batch Section
║HC║ [
s');
writeln ('u
D
]
Download File
║H
s');
writeln ('u
C║ [
E
]
Request File
╔════
s');
writeln ('u
═════════════════════════════════╗HC
║ [
F
s');
writeln ('u
]
Configure File Listing
║ [
T
]
s');
writeln ('u
Type File
║HC
║ [
s');
writeln ('u
G
]
Generate File List
║ [
U
s');
writeln ('u
]
Upload File
║HC
s');
writeln ('u
║ [
J
]
Jump to Another Conf.
║ [
s');
writeln ('u
V
]
Newscan Current Area
║H
s');
writeln ('u
C
║ [
L
]
List Files
s');
writeln ('u
║ [
W
]
Send Mail to Sponsor
║
');
writeln ('
HC
║ [
N
]
Newscan All Areas
s');
writeln ('u
║ [
X
]
Extended Description Listing
║
');
writeln ('
HC
║ [
Q
]
Quit
s');
writeln ('u
║ [
Y
]
Your Xfer Statistics
║
');
writeln ('
HC
║ [
R
]
View File
s');
writeln ('u
║ [
Z
]
Extract File
║
');
writeln ('
HC
║ [
S
]
Search for Text
s');
writeln ('u
║ [
%
]
File Sponsor Section
║
');
writeln ('
HC
╚═════════════════════════════
║ [
+
s');
writeln ('u
]
Add File to Batch
║HC║
s');
writeln ('u
[
?
]
View This Menu
║H
A');
writeln ('
C╚═════════════════════════════════════╝
');
writeln;
pause;
end;
end.