463 lines
16 KiB
ObjectPascal
463 lines
16 KiB
ObjectPascal
(*****************************************************************************)
|
|
(*> <*)
|
|
(*> SYSOP1 .PAS - Written by Eric Oman <*)
|
|
(*> <*)
|
|
(*> SysOp functions: Protocol editor. <*)
|
|
(*> <*)
|
|
(*****************************************************************************)
|
|
{$A+,B+,E+,F+,I+,L+,N-,O+,R-,S+,V-}
|
|
unit sysop1;
|
|
|
|
interface
|
|
|
|
procedure ee_help;
|
|
procedure exproedit;
|
|
|
|
implementation
|
|
|
|
uses
|
|
crt, dos,
|
|
|
|
{rcg11172000 no overlay under Linux.}
|
|
{overlay,}
|
|
|
|
common,
|
|
file1,
|
|
menus2;
|
|
|
|
var menuchanged:boolean;
|
|
x:integer;
|
|
|
|
procedure ee_help;
|
|
begin
|
|
sprint(' #:Modify item <CR>Redisplay screen');
|
|
lcmds(15,3,'[Back entry',']Forward entry');
|
|
lcmds(15,3,'Jump to entry','First entry in list');
|
|
lcmds(15,3,'Quit and save','Last entry in list');
|
|
end;
|
|
|
|
procedure exproedit;
|
|
var wrd:word;
|
|
i1,i2,ii,xloaded:integer;
|
|
c:char;
|
|
abort,next:boolean;
|
|
st:astr;
|
|
|
|
procedure xed(i:integer);
|
|
var x:integer;
|
|
begin
|
|
if (i>=0) and (i<=filesize(xf)-1) then begin
|
|
if (i>=0) and (i<filesize(xf)-1) then
|
|
for x:=i to filesize(xf)-2 do begin
|
|
seek(xf,x+1); read(xf,protocol);
|
|
seek(xf,x); write(xf,protocol);
|
|
end;
|
|
seek(xf,filesize(xf)-1); truncate(xf);
|
|
end;
|
|
end;
|
|
|
|
function newindexno:longint;
|
|
var xpr:protrec;
|
|
i,j:integer;
|
|
begin
|
|
reset(xf);
|
|
j:=-1;
|
|
for i:=1 to filesize(xf) do begin
|
|
read(xf,xpr);
|
|
if (xpr.permindx>j) then j:=xpr.permindx;
|
|
end;
|
|
inc(j);
|
|
newindexno:=j;
|
|
end;
|
|
|
|
procedure xei(i:integer);
|
|
var x:integer;
|
|
begin
|
|
if (i>=0) and (i<=filesize(xf)) and (filesize(xf)<maxprotocols) then begin
|
|
for x:=filesize(xf)-1 downto i do begin
|
|
seek(xf,x); read(xf,protocol);
|
|
write(xf,protocol); (* to next record *)
|
|
end;
|
|
with protocol do begin
|
|
xbstat:=[xbxferokcode];
|
|
ckeys:='!';
|
|
descr:=#3#4+'('+#3#3+'!'+#3#4+') New Protocol';
|
|
acs:='';
|
|
templog:='';
|
|
uloadlog:=''; dloadlog:='';
|
|
ulcmd:='QUIT'; dlcmd:='QUIT';
|
|
for x:=1 to 6 do begin ulcode[x]:=''; dlcode[x]:=''; end;
|
|
envcmd:='';
|
|
dlflist:='';
|
|
maxchrs:=128;
|
|
logpf:=0; logps:=0;
|
|
permindx:=newindexno;
|
|
for x:=1 to 11 do res[x]:=0;
|
|
end;
|
|
seek(xf,i); write(xf,protocol);
|
|
end;
|
|
end;
|
|
|
|
function udq:integer;
|
|
var c:char;
|
|
begin
|
|
prt('What type? (U)pload (D)ownload : ');
|
|
onek(c,'DU'); nl;
|
|
if (c='U') then udq:=1 else udq:=2;
|
|
end;
|
|
|
|
{rcg11172000 had to change this to get it compiling under Free Pascal...}
|
|
{function substone(src,old,new:astr):astr;}
|
|
function substone(src,old,_new:astr):astr;
|
|
var p:integer;
|
|
begin
|
|
p:=pos(old,src);
|
|
if (p>0) then begin
|
|
insert(_new,src,p+length(old));
|
|
delete(src,p,length(old));
|
|
end;
|
|
substone:=src;
|
|
end;
|
|
|
|
function showpmci(s:astr):astr;
|
|
begin
|
|
s:=substone(s,'%B',#3#3+'%B'+#3#1);
|
|
s:=substone(s,'%C',#3#3+'%C'+#3#1);
|
|
s:=substone(s,'%F',#3#3+'%F'+#3#1);
|
|
s:=substone(s,'%G',#3#3+'%G'+#3#1);
|
|
s:=substone(s,'%L',#3#3+'%L'+#3#1);
|
|
s:=substone(s,'%P',#3#3+'%P'+#3#1);
|
|
s:=substone(s,'%T',#3#3+'%T'+#3#1);
|
|
showpmci:=s;
|
|
end;
|
|
|
|
procedure xem;
|
|
var s:astr;
|
|
i,j,i1,i2,ii:integer;
|
|
c,c1:char;
|
|
bb:byte;
|
|
changed,b:boolean;
|
|
|
|
function cfip(pt:integer; s:astr):astr;
|
|
begin
|
|
if (pt<1) or (pt>5) then cfip:=s else cfip:='';
|
|
end;
|
|
|
|
function nnon(s:astr):astr;
|
|
begin
|
|
if (s<>'') then nnon:='"'+s+'"' else nnon:='*None*';
|
|
end;
|
|
|
|
procedure pprint(s:astr);
|
|
var i:integer;
|
|
begin
|
|
s:=showpmci(s);
|
|
cl(1);
|
|
for i:=1 to length(s) do
|
|
if ((s[i]=#3) and (i<>length(s))) then begin
|
|
cl(ord(s[i+1]));
|
|
inc(i);
|
|
end else
|
|
outkey(s[i]);
|
|
nl;
|
|
end;
|
|
|
|
begin
|
|
xloaded:=-1;
|
|
prt('Begin editing at which? (0-'+cstr(filesize(xf)-1)+') : '); inu(ii);
|
|
c:=' ';
|
|
if (ii>=0) and (ii<=filesize(xf)-1) then begin
|
|
while (c<>'Q') and (not hangup) do begin
|
|
if (xloaded<>ii) then begin
|
|
seek(xf,ii); read(xf,protocol);
|
|
xloaded:=ii; changed:=FALSE;
|
|
end;
|
|
with protocol do
|
|
repeat
|
|
if (c<>'?') then begin
|
|
cls;
|
|
abort:=FALSE; next:=FALSE; i:=1;
|
|
while ((i<=15) and (not abort)) do begin
|
|
case i of
|
|
1:print('Protocol #'+cstr(ii)+' of '+cstr(filesize(xf)-1));
|
|
2:print('!. Type/protocl:'+
|
|
aonoff(xbactive in xbstat,'Active','NOT ACTIVE')+' - '+
|
|
aonoff(xbisbatch in xbstat,'Batch protocol','Single protocol')+
|
|
aonoff(xbisresume in xbstat,' - RESUME protocol',''));
|
|
3:pprint('1. Keys/descrip:"'+ckeys+'" / "'+descr+'"');
|
|
4:print('2. ACS required: "'+acs+'"');
|
|
5:pprint('3. Temp. log : '+nnon(templog));
|
|
6:pprint('4. <U>L log : '+nnon(uloadlog));
|
|
7:pprint(' <D>L log : '+nnon(dloadlog));
|
|
8:pprint('5. <U>L command: '+nnon(ulcmd));
|
|
9:pprint(' <D>L command: '+nnon(dlcmd));
|
|
10:print('6. Codes mean :'+aonoff(xbxferokcode in xbstat,
|
|
'Transfer OK','Transfer bad'));
|
|
11:begin
|
|
s:='7. <U>L codes :';
|
|
for j:=1 to 6 do
|
|
s:=s+mln('('+cstr(j)+')"'+ulcode[j]+'" ',10);
|
|
print(copy(s,1,length(s)-1));
|
|
end;
|
|
12:begin
|
|
s:=' <D>L codes :';
|
|
for j:=1 to 6 do
|
|
s:=s+mln('('+cstr(j)+')"'+dlcode[j]+'" ',10);
|
|
print(copy(s,1,length(s)-1));
|
|
end;
|
|
13:pprint('E. Environ. cmd: '+nnon(envcmd));
|
|
14:pprint('I. DL File list: '+nnon(dlflist));
|
|
15:print('C. Max DOS chrs:'+cstr(maxchrs)+
|
|
' P. Log position: Filename: '+cstr(logpf)+
|
|
' - Status: '+cstr(logps));
|
|
end;
|
|
inc(i);
|
|
wkey(abort,next);
|
|
end;
|
|
end;
|
|
nl;
|
|
prt('Edit menu (?=help) : '); onek(c,'Q!1234567CEIP[]FJL?'^M);
|
|
nl;
|
|
case c of
|
|
'!':begin
|
|
repeat
|
|
print('1. Protocol active :'+syn(xbactive in xbstat));
|
|
print('2. Is batch protocol :'+syn(xbisbatch in xbstat));
|
|
print('3. Is resume protocol:'+syn(xbisresume in xbstat));
|
|
nl;
|
|
prt('Select (1-3,Q=Quit) : '); onek(c,'Q123'^M);
|
|
nl;
|
|
if (c in ['1'..'3']) then begin
|
|
changed:=TRUE;
|
|
case c of
|
|
'1':if (xbactive in xbstat) then
|
|
xbstat:=xbstat-[xbactive]
|
|
else xbstat:=xbstat+[xbactive];
|
|
'2':if (xbisbatch in xbstat) then
|
|
xbstat:=xbstat-[xbisbatch]
|
|
else xbstat:=xbstat+[xbisbatch];
|
|
'3':if (xbisresume in xbstat) then
|
|
xbstat:=xbstat-[xbisresume]
|
|
else xbstat:=xbstat+[xbisresume];
|
|
end;
|
|
end;
|
|
until ((not (c in ['1'..'3'])) or (hangup));
|
|
c:=#0;
|
|
end;
|
|
'1':begin
|
|
prt('New command keys: '); mpl(14); input(s,14);
|
|
if (s<>'') then begin
|
|
if (s<>ckeys) then changed:=TRUE;
|
|
ckeys:=s;
|
|
end;
|
|
nl;
|
|
print('New description:');
|
|
prt(':'); cl(1); inputwc(s,40);
|
|
if (s<>'') then begin
|
|
if (s<>descr) then changed:=TRUE;
|
|
descr:=s;
|
|
end;
|
|
end;
|
|
'2':begin
|
|
prt('New ACS: '); mpl(20);
|
|
inputwn(acs,20,changed);
|
|
end;
|
|
'3':begin
|
|
print('New temp. log:');
|
|
prt(':'); inputwn(templog,25,changed);
|
|
end;
|
|
'4':case udq of
|
|
1:begin
|
|
print('New permanent upload log:');
|
|
prt(':'); inputwn(uloadlog,25,changed);
|
|
end;
|
|
2:begin
|
|
print('New permanent download log:');
|
|
prt(':'); inputwn(dloadlog,25,changed);
|
|
end;
|
|
end;
|
|
'5':begin
|
|
s:=#0#0#0; j:=udq;
|
|
prt('Type: (A)scii (C)ommand (E)xternal (O)ff : ');
|
|
onek(c,^M'ACEO'); nl;
|
|
case c of
|
|
'A':s:='ASCII';
|
|
'C':begin
|
|
prt('(B)atch (N)ext (Q)uit : ');
|
|
onek(c,'BNQ'^M);
|
|
case c of
|
|
'B':s:='BATCH';
|
|
'N':s:='NEXT';
|
|
'Q':s:='QUIT';
|
|
end;
|
|
end;
|
|
'E':begin
|
|
if (j=1) then print('New upload commandline:')
|
|
else print('New download commandline:');
|
|
prt(':'); inputwn(s,78,changed);
|
|
end;
|
|
'O':if pynq('Set to NULL string? ') then s:='';
|
|
end;
|
|
if (s<>#0#0#0) then begin
|
|
changed:=TRUE;
|
|
case j of
|
|
1:ulcmd:=s;
|
|
2:dlcmd:=s;
|
|
end;
|
|
end;
|
|
c:=#0;
|
|
end;
|
|
'6':begin
|
|
if (xbxferokcode in xbstat) then
|
|
xbstat:=xbstat-[xbxferokcode]
|
|
else xbstat:=xbstat+[xbxferokcode];
|
|
changed:=TRUE;
|
|
end;
|
|
'7':begin
|
|
case udq of
|
|
1:begin
|
|
print('New upload codes:'); nl;
|
|
for i:=1 to 6 do begin
|
|
prt('Code #'+cstr(i)+' ["'+ulcode[i]+'"] : ');
|
|
inputwn(ulcode[i],6,changed);
|
|
end;
|
|
end;
|
|
2:begin
|
|
print('New download codes:'); nl;
|
|
for i:=1 to 6 do begin
|
|
prt('Code #'+cstr(i)+' ["'+dlcode[i]+'"] : ');
|
|
inputwn(dlcode[i],6,changed);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
'C':begin
|
|
prt('New max DOS chrs in commandline: '); inu(i);
|
|
if (not badini) then begin
|
|
if (i<>maxchrs) then changed:=TRUE;
|
|
maxchrs:=i;
|
|
end;
|
|
end;
|
|
'E':begin
|
|
print('New environment setup commandline:');
|
|
prt(':'); inputwn(envcmd,60,changed);
|
|
end;
|
|
'I':begin
|
|
print('New batch file list:');
|
|
prt(':'); inputwn(dlflist,25,changed);
|
|
end;
|
|
'P':begin
|
|
prt('New "Filename" log position? ['+cstr(logpf)+'] : ');
|
|
inu(i);
|
|
if (not badini) then begin
|
|
if (i<>logpf) then changed:=TRUE;
|
|
logpf:=i;
|
|
end;
|
|
prt('New "Status" log position? ['+cstr(logps)+'] : ');
|
|
inu(i);
|
|
if (not badini) then begin
|
|
if (i<>logpf) then changed:=TRUE;
|
|
logps:=i;
|
|
end;
|
|
end;
|
|
'[':if (ii>0) then dec(ii) else c:=' ';
|
|
']':if (ii<filesize(xf)-1) then inc(ii) else c:=' ';
|
|
'F':if (ii<>0) then ii:=0 else c:=' ';
|
|
'J':begin
|
|
prt('Jump to entry: ');
|
|
input(s,3);
|
|
if ((value(s)>=0) and (value(s)<=filesize(xf)-1)) then
|
|
ii:=value(s) else c:=' ';
|
|
end;
|
|
'L':if (ii=filesize(xf)-1) then c:=' ' else ii:=filesize(xf)-1;
|
|
'?':ee_help;
|
|
end;
|
|
until (pos(c,'Q[]FJL')<>0) or (hangup);
|
|
if (changed) then begin
|
|
seek(xf,xloaded); write(xf,protocol);
|
|
changed:=FALSE;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure xep;
|
|
var i,j,k:integer;
|
|
begin
|
|
prt('Move which protocol? (0-'+cstr(filesize(xf)-1)+') : '); inu(i);
|
|
if ((not badini) and (i>=0) and (i<=filesize(xf)-1)) then begin
|
|
prt('Move before which protocol? (0-'+cstr(filesize(xf))+') : '); inu(j);
|
|
if ((not badini) and (j>=0) and (j<=filesize(xf)) and
|
|
(j<>i) and (j<>i+1)) then begin
|
|
xei(j);
|
|
if (j>i) then k:=i else k:=i+1;
|
|
seek(xf,k); read(xf,protocol);
|
|
seek(xf,j); write(xf,protocol);
|
|
if (j>i) then xed(i) else xed(i+1);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function nar(c:char):char;
|
|
begin
|
|
if c='@' then nar:=' ' else nar:=c;
|
|
end;
|
|
|
|
begin
|
|
reset(xf); xloaded:=-1; c:=#0;
|
|
repeat
|
|
if (c<>'?') then
|
|
begin
|
|
cls; abort:=FALSE;
|
|
printacr(#3#3+' NNN'+sepr2+'ACS '+sepr2+'Description',abort,next);
|
|
printacr(#3#4+' ===:==========:=============================================================',abort,next);
|
|
ii:=0;
|
|
seek(xf,0);
|
|
while (ii<=filesize(xf)-1) and (not abort) do begin
|
|
read(xf,protocol);
|
|
with protocol do begin
|
|
printacr(aonoff((xbactive in xbstat),#3#5+'+',#3#1+'-')+
|
|
#3#0+mn(ii,3)+' '+#3#9+mln(acs,10)+' '+
|
|
#3#1+descr,abort,next);
|
|
inc(ii);
|
|
end;
|
|
end;
|
|
end;
|
|
nl;
|
|
prt('Protocol editor (?=help) : ');
|
|
onek(c,'QDIMP?'^M);
|
|
case c of
|
|
'?':begin
|
|
nl;
|
|
print('<CR>Redisplay screen');
|
|
lcmds(16,3,'Delete protocol','Insert protocol');
|
|
lcmds(16,3,'Modify protocol','Position protocol');
|
|
lcmds(16,3,'Quit','');
|
|
end;
|
|
'D':begin
|
|
prt('Protocol to delete? (0-'+cstr(filesize(xf)-1)+') : '); inu(ii);
|
|
if (ii>=0) and (ii<=filesize(xf)-1) then begin
|
|
seek(xf,ii); read(xf,protocol);
|
|
nl; sprint('Protocol: '+#3#4+protocol.descr);
|
|
if pynq('Delete this? ') then
|
|
begin
|
|
sysoplog('* Deleted protocol: '+protocol.descr); xed(ii);
|
|
end;
|
|
end;
|
|
end;
|
|
'I':begin
|
|
prt('Protocol to insert before? (0-'+cstr(filesize(xf))+') : '); inu(ii);
|
|
if (ii>=0) and (ii<=filesize(xf)) then
|
|
begin
|
|
xei(ii); sysoplog('* Inserted new protocol');
|
|
end;
|
|
end;
|
|
'M':xem;
|
|
'P':xep;
|
|
end;
|
|
until ((c='Q') or (hangup));
|
|
close(xf);
|
|
end;
|
|
|
|
end.
|