(*****************************************************************************)

(*> <*)

(*> SYSOP5 .PAS - Written by Eric Oman <*)

(*> <*)

(*> SysOp functions: Text file base editor, Voting question editor, and <*)

(*> Vote printer. <*)

(*> <*)

(*****************************************************************************)

{$A+,B+,D-,E+,F+,I+,L+,N-,O+,R-,S+,V-}

unit sysop5;

interface

uses

crt, dos,

{rcg11172000 no overlay under Linux.}

{overlay,}

common;

procedure tfileedit;

implementation

var f1:file of byte;

procedure tfileedit;

var b,b1:tfilerec;

gfil:file of tfilerec;

s:astr;

ok,done,abort,next,changed:boolean;

gftit:array[1..150] of record

tit:string[40];

filen:string[12];

arn:integer;

gfile:boolean;

acs,ulacs:acstring;

gdate:string[8];

end;

gfs:array[0..100] of record

tit:string[40];

arn:integer;

acs,ulacs:acstring;

gdate:string[8];

end;

numgentrys,numgsecs,lgftn,numgft,c:integer;

c1,c2,c3,c4:integer;

s1,s2,s3,s4:astr;

ch:char;

i:integer;

function align(fn:astr):astr;

var f,e,t:astr; c,c1:integer;

begin

c:=pos('.',fn);

if c=0 then begin

f:=fn; e:=' ';

end else begin

f:=copy(fn,1,c-1); e:=copy(fn,c+1,3);

end;

while length(f)<8 do f:=f+' ';

while length(e)<3 do e:=e+' ';

if length(f)>8 then f:=copy(f,1,8);

if length(e)>3 then e:=copy(e,1,3);

c:=pos('*',f); if c<>0 then for c1:=c to 8 do f[c1]:='?';

c:=pos('*',e); if c<>0 then for c1:=c to 3 do e[c1]:='?';

c:=pos(' ',f); if c<>0 then for c1:=c to 8 do f[c1]:=' ';

c:=pos(' ',e); if c<>0 then for c1:=c to 3 do e[c1]:=' ';

align:=f+'.'+e;

end;

procedure gettit(n:integer);

var r:integer; b:tfilerec;

begin

numgft:=0;

r:=n+1;

if r<=numgentrys then begin

seek(gfil,r); read(gfil,b);

while (r<=numgentrys) and (b.filen[1]<>#1) do begin

inc(numgft);

gftit[numgft].tit:=b.title;

gftit[numgft].filen:=b.filen;

gftit[numgft].arn:=r;

gftit[numgft].gfile:=TRUE;

gftit[numgft].acs:=b.acs;

gftit[numgft].ulacs:=b.ulacs;

gftit[numgft].gdate:=b.gdate;

inc(r);

if (r<=numgentrys) then begin seek(gfil,r); read(gfil,b); end;

end;

end;

gftit[numgft+1].arn:=r;

end;

procedure getsec;

var r:integer; b:tfilerec;

begin

numgsecs:=0;

gfs[0].tit:='Main Section';

gfs[0].arn:=0;

for r:=1 to numgentrys do begin

seek(gfil,r); read(gfil,b);

if b.filen[1]=#1 then begin

inc(numgsecs);

gfs[numgsecs].tit:=b.title;

gfs[numgsecs].arn:=r;

gfs[numgsecs].acs:=b.acs;

gfs[numgsecs].ulacs:=b.ulacs;

gfs[numgsecs].gdate:=b.gdate;

end;

end;

gfs[numgsecs+1].arn:=numgentrys+1;

end;

procedure lgft;

var i:integer;

b:tfilerec;

s:astr;

begin

if numgft=0 then print('** No T-Files **')

else begin

abort:=FALSE; next:=FALSE;

i:=1;

(*

NNN:Description :Filename :SL :AR:Date

===:========================================:============:===:==:========

NNN:Description :Filename :Date :ACS

===:========================================:============:========:==========

*)

printacr(#3#0+'NNN'+sepr2+'Description '+

sepr2+'Filename '+sepr2+'Date '+sepr2+'ACS',abort,next);

printacr(#3#4+'===:========================================:============:========:==========',abort,next);

while (i<=numgft) and (not abort) do begin

seek(gfil,gftit[i].arn); read(gfil,b);

s:=#3#0+mn(i,3)+' '+#3#3+mln(b.title,40)+' '+#3#3+align(b.filen)+' '+

mln(b.gdate,8)+' '+mln(b.acs,10);

printacr(s,abort,next);

inc(i);

end;

end;

end;

procedure gfed;

var sel,i,j,k:integer;

begin

prt('Section number to delete? (1-'+cstr(numgsecs)+') : '); inu(sel);

if ((sel>=1) and (sel<=numgsecs)) then begin

nl;

sprompt(#3#3+gfs[sel].tit);

if pynq(' Delete it? ') then begin

if sel=numgsecs then j:=numgentrys+1 else j:=gfs[sel+1].arn;

i:=(j-gfs[sel].arn);

for k:=j to numgentrys do begin

seek(gfil,k); read(gfil,b);

seek(gfil,k-i); write(gfil,b);

end;

seek(gfil,0);

dec(numgentrys,i); b.gdaten:=numgentrys;

write(gfil,b);

end;

end

else print('Illegal section number.');

end;

function newindexno:longint;

var b:tfilerec;

i,j:integer;

begin

reset(gfil);

j:=-1;

for i:=1 to filesize(gfil) do begin

read(gfil,b);

if (b.permindx>j) then j:=b.permindx;

end;

inc(j);

newindexno:=j;

end;

procedure gfei;

var sel,i:integer;

c:char;

begin

prt('Section number to insert before? (1-'+cstr(numgsecs+1)+') : '); inu(sel);

if (sel>=1) and (sel<=(numgsecs+1)) then begin

if (sel<=numgsecs) then sel:=gfs[sel].arn else sel:=numgentrys+1;

b.gdate:=date;

b.gdaten:=daynum(date);

b.tbstat:=[];

b.permindx:=newindexno;

b.tbdepth:=0;

prt('Section title: '); inputwc(b.title,40);

prt('Section ACS: '); inputl(b.acs,20);

b.filen:=#1#0#0#0#0#0;

for i:=numgentrys downto sel do begin

seek(gfil,i); read(gfil,b1);

seek(gfil,i+1); write(gfil,b1);

end;

seek(gfil,sel); write(gfil,b);

inc(numgentrys); b.gdaten:=numgentrys;

seek(gfil,0); write(gfil,b);

end

else print('Illegal section number.');

end;

procedure gfem;

var i1,i2,ii:integer;

c:char;

s:astr;

c1,c2,c3,c4:integer;

bb:byte;

bbb:boolean;

procedure gfedi(i:integer);

var j:integer;

begin

i:=gftit[i].arn;

for j:=i+1 to numgentrys do begin

seek(gfil,j); read(gfil,b);

seek(gfil,j-1); write(gfil,b);

end;

seek(gfil,0); read(gfil,b);

dec(b.gdaten);

seek(gfil,0); write(gfil,b);

dec(numgentrys);

getsec;

end;

procedure gfeii(i:integer; b:tfilerec);

var j,k:integer;

begin

j:=gftit[i].arn;

for k:=numgentrys downto j do begin

seek(gfil,k); read(gfil,b1);

seek(gfil,k+1); write(gfil,b1);

end;

seek(gfil,j); write(gfil,b);

inc(numgentrys);

seek(gfil,0); read(gfil,b);

inc(b.gdaten);

seek(gfil,0); write(gfil,b);

getsec;

seek(gfil,gfs[ii].arn); read(gfil,b);

b.gdate:=date;

b.gdaten:=daynum(date);

seek(gfil,gfs[ii].arn); write(gfil,b); {* update section date *}

getsec;

end;

procedure gfepi;

var i,j,k:integer;

begin

prt('Move which entry? (1-'+cstr(numgft)+') : '); inu(i);

if (i>=1) and (i<=numgft) then begin

prt('Move before which entry? (1-'+cstr(numgft+1)+') : '); inu(j);

if (j>=1) and (j<=numgft+1) and (j<>i) and (j<>i+1) then begin

seek(gfil,gftit[i].arn); read(gfil,b);

gfeii(j,b);

if j>i then gfedi(i) else gfedi(i+1);

end;

end;

end;

begin

prt('Begin editing at which? (1-'+cstr(numgsecs)+') : '); inu(ii);

c:=' ';

if (ii>=1) and (ii<=numgsecs) then begin

getsec;

while (c<>'Q') and (not hangup) do begin

repeat

if c<>'?' then begin

cls;

print('Tfile section #'+cstr(ii)+' of '+cstr(numgsecs));

nl;

abort:=FALSE; next:=FALSE;

printacr('1. Section title: '+#3#3+gfs[ii].tit,abort,next);

printacr('2. Section ACS : "'+gfs[ii].acs+'"',abort,next);

printacr('3. Upload ACS : "'+gfs[ii].ulacs+'"',abort,next);

printacr('4. Section date : '+gfs[ii].gdate,abort,next);

nl;

gettit(gfs[ii].arn);

lgft;

end;

nl;

prt('Tfile edit (?=help) : ');

onek(c,'Q?[]DFIJLMPT1234'^M);

nl;

case c of

'?':begin

sprint(#3#1+'<CR>Redisplay screen');

lcmds(25,3,'[Back section',']Forward section');

lcmds(25,3,'Jump to section','First section in list');

lcmds(25,3,'Quit and save','Last section in list');

lcmds(25,3,'1Title change','2Section ACS change');

lcmds(25,3,'3Upload ACS change','4Date change');

lcmds(25,3,'Insert Tfile','Delete Tfile');

lcmds(25,3,'Position Tfile','Modify individual entries');

lcmds(25,3,'Type file to screen','');

end;

'M':begin

prt('Begin editing at which? (1-'+cstr(numgft)+') : '); ini(bb);

if (not badini) and (bb>=1) and (bb<=numgft) then begin

i2:=bb;

while (c<>'Q') and (not hangup) do begin

repeat

if (c<>'?') then begin

cls;

print('Tfile section #'+cstr(ii)+' of '+cstr(numgsecs));

print('Tfile #'+cstr(i2)+' of '+cstr(numgft));

nl;

with gftit[i2] do begin

sprint('1. Title : '+#3#3+tit);

print('2. Filename : '+filen);

print('3. ACS required: "'+acs+'"');

print('4. Date : '+gdate);

end;

end;

nl;

prt('Edit menu: (?=help) : ');

onek(c,'Q?1234[]'^M);

nl;

case c of

'?':begin

sprint(' #:Modify item <CR>Redisplay screen');

lcmds(14,3,'[Back Tfile',']Forward Tfile');

lcmds(14,3,'Quit and save','');

end;

'1'..'4':begin

seek(gfil,gftit[i2].arn); read(gfil,b);

case c of

'1':begin

prt('New title: ');

inputwnwc(b.title,40,changed);

end;

'2':begin

prt('New filename: ');

input(b.filen,12);

end;

'3':begin

prt('New ACS: ');

inputwn(b.acs,20,bbb);

end;

'4':begin

prt('New date: '); input(s,8);

if (s<>'') and (daynum(s)>0) then begin

b.gdate:=s;

b.gdaten:=daynum(s);

end;

end;

end;

seek(gfil,gftit[i2].arn); write(gfil,b);

gettit(gfs[ii].arn);

end;

'[':if i2>1 then dec(i2) else c:=' ';

']':if i2<numgft then inc(i2) else c:=' ';

end;

until (c in ['Q','[',']']) or (hangup);

end;

end;

c:=' ';

end;

'D':begin

gettit(gfs[ii].arn);

prt('Delete which? (1-'+cstr(numgft)+') : '); inu(c1);

if (c1>=1) and (c1<=(numgft)) then begin

nl;

sprompt(#3#3+gftit[c1].tit);

if pynq(' Delete it? ') then begin

seek(gfil,gftit[c1].arn); read(gfil,b);

assign(f1,systat.tfilepath+b.filen);

{$I-} reset(f1); {$I+}

if ioresult=0 then begin

close(f1);

if pynq('"'+b.filen+'" - Erase file too? ') then erase(f1);

end;

gfedi(c1);

end;

end;

end;

'I':begin

gettit(gfs[ii].arn);

prt('Insert before which (1-'+cstr(numgft+1)+') ['+

cstr(numgft+1)+'] : ');

input(s1,3);

if (s1='') then c1:=numgft+1 else c1:=value(s1);

if (c1>=1) and (c1<=numgft+1) then begin

nl;

prt('Enter filename : ');

mpl(12); input(b.filen,12);

ok:=TRUE;

if b.filen='' then ok:=FALSE;

if pos('.',b.filen)<>0 then begin

ok:=FALSE;

assign(f1,systat.tfilepath+b.filen);

{$I-} reset(f1); {$I+}

ok:=(ioresult=0);

if ok then close(f1);

end;

if ok then begin

nl;

b.gdate:=date;

b.gdaten:=daynum(date);

b.tbstat:=[];

b.permindx:=newindexno;

b.tbdepth:=0;

prt('Enter title : '); inputwc(b.title,40);

prt('Enter ACS : '); inputl(b.acs,20);

gfeii(c1,b);

systat.tfiledate:=date;

savesystat;

end else begin

print('Illegal filename.');

pausescr;

end;

end;

end;

'P':gfepi;

'T':begin

gettit(gfs[ii].arn);

prt('Type which? (1-'+cstr(numgft)+') : '); inu(c1);

if (c1>=1) and (c1<=(numgft)) then begin

seek(gfil,gftit[c1].arn); read(gfil,b);

nofile:=FALSE;

if pos('.',b.filen)=0 then

printf(systat.tfilepath+b.filen)

else begin

assign(f1,systat.tfilepath+b.filen);

{$I-} reset(f1); {$I+}

nofile:=(ioresult<>0);

if (not nofile) then begin

close(f1);

pfl(systat.tfilepath+b.filen,abort,next,TRUE);

end;

end;

if nofile then print('File not found!');

pausescr;

end;

end;

'1'..'4':begin

seek(gfil,gfs[ii].arn); read(gfil,b);

case c of

'1':begin

prt('New title: ');

inputwnwc(b.title,40,changed);

end;

'2':begin

prt('New ACS: ');

inputwn(b.acs,20,bbb);

end;

'3':begin

prt('New Upload ACS: ');

inputwn(b.ulacs,20,bbb);

end;

'4':begin

prt('New date: '); mpl(8); input(s,8);

if (daynum(s)>0) then begin

b.gdate:=s;

b.gdaten:=daynum(s);

end;

end;

end;

seek(gfil,gfs[ii].arn); write(gfil,b);

getsec;

end;

'[':if (ii>1) then dec(ii) else c:=' ';

']':if (ii<numgsecs) then inc(ii) else c:=' ';

'F':if (ii<>1) then ii:=1 else c:=' ';

'J':begin

prt('Jump to entry: ');

input(s,3);

if ((value(s)>=1) and (value(s)<=numgsecs)) then

ii:=value(s) else c:=' ';

end;

'L':if (ii<>numgsecs) then ii:=numgsecs else c:=' ';

end;

until ((c in ['Q','[',']','F','J','L']) or (hangup));

end;

end;

end;

begin

assign(gfil,systat.gfilepath+'gfiles.dat');

{$I-} reset(gfil); {$I+}

if ioresult<>0 then begin

rewrite(gfil);

b.gdaten:=0;

write(gfil,b);

end;

seek(gfil,0); read(gfil,b);

numgentrys:=b.gdaten;

repeat

if (ch<>'?') then begin

getsec;

cls; done:=FALSE; abort:=FALSE; next:=FALSE;

(*

NNN:Section Name :SL :AR:Date

===:========================================:===:==:========

NNN:Section Name :Date :ACS :UL ACS

===:========================================:========:==========:==========

*)

printacr(#3#0+'NNN'+sepr2+'Section Name '+

sepr2+'Date '+sepr2+'ACS '+sepr2+'UL ACS',abort,next);

printacr(#3#4+'===:========================================:========:==========:==========',abort,next);

i:=1;

while (i<=numgsecs) and (not abort) do

with gfs[i] do begin

s:=#3#0+mn(i,3)+' '+#3#3+mln(tit,40)+' '+#3#3+mln(gdate,8)+' '+

#3#9+mln(acs,10)+' '+mln(ulacs,10);

printacr(s,abort,next);

inc(i);

end;

end;

nl;

prt('Text-file base editor (?=help) : ');

onek(ch,'QDIM?'^M);

case ch of

'?':begin

nl;

print('<CR>Redisplay screen');

lcmds(12,3,'Delete base','Insert base');

lcmds(12,3,'Modify base','Quit');

end;

'Q':done:=TRUE;

'D':gfed;

'I':gfei;

'M':gfem;

end;

until (done) or (hangup);

close(gfil);

end;

end.