/**************************************************************************\
        MCFileLister by MultiCom Production 
\**************************************************************************/
ver="$VER: MCFileLister 1.10 by MultiCom Production"

parse arg ucod
options results ; signal on SYNTAX ; signal on ERROR ; signal on IOERR
tx=transmit ; sx=sendstring ; gc=getchar ; mg=maygetchar
changewhere "Filelister";old=result
path=gu(1311992);acc=gu(15)
version;cnet=substr(result,16,4)
cn=(cnet>="4.13")

a='rexxsupport.library';if ~show('l',a) then if ~addlib(a,0,-30) then exit

L.=0
if exists(path"FLCfg") then do
	call open(1,path"FLCfg",'R')
	TempDir=readln(1)
	L.Desc.0=readln(1)
	L.Flag.0=readln(1)
	L.Header.0=readln(1)
	L.Footer.0=readln(1)
	Lists=readln(1)
	if Lists>0 then do
		do i=1 to Lists
			L.Name.i=readln(1)
			L.Desc.i=readln(1)
			L.Flag.i=readln(1)
			L.Day.i=readln(1)
			L.UsFl.i=readln(1)
			L.Access.i=readln(1)
			L.Pth.i=readln(1)
			L.Header.i=readln(1)
			L.Footer.i=readln(1)
		end
	end
	call close(1)
end
bbs=gu(2307050)
if ucod="U" then signal USERCONFIG
if Lists=0 then do
	tx "f1z1cf"center(substr(ver,7),79)"z0"
	sx "cfÚce"copies("Ä",70)"cc¿"
	sx "ce³"center("No lists configured!!!",70)"cc³"
	tx "ceÀcc"copies("Ä",70)"Ù"
	exit
end
GLists=Lists
do i=1 to Lists
	lname.i=L.Name.i
	ldesc.i=L.Desc.i
	ltype.i=substr(L.Flag.i,1,1)+1
	lsort.i=substr(L.Flag.i,2,1)+1
	lshowup.i=substr(L.Flag.i,3,1)
	lshowinv.i=substr(L.Flag.i,4,1)
	lshowpvt.i=substr(L.Flag.i,5,1)
	lday.i=L.Day.i
	a=d2c(L.UsFl.i);a=c2b(a)
	lusfl.i=left(a,32,"0")
	laccess.i=L.Access.i
	lpath.i=L.Pth.i
	lheader.i=L.Header.i
	lfooter.i=L.Footer.i
end
signal GENERATE

USERCONFIG:
Type.0="(Text)";Type.1="(Guide)";Type.2="(HTML)";Type.3="(HTML w/ tables)"
do i=0 to 3;type.i=left(type.i,16);end
Sort.0="(Name)";Sort.1="(Date)"
uu=gu(1307954);c2=(cnet>="4.11");arc=gu(1100644)
if exists(uu"_FLcfg") then do
	call open(1,uu"_FLcfg","R")
	a=readln(1)
	setup=readln(1)
	today=readln(1)
	call close(1)
	parse var a sidste''dage
end
else do
	sidste=date('i');dage='14';setup="00";today=0
end
a=substr(gu(11),5,11);lastcl=translate(a,"0 "," -")
tx "f1z1cf"center(substr(ver,7),79)"z0";maint=gu(17)
sx "cfÚceÄÄÄcc¿  cfÚce"copies("Ä",40)"cc¿"
do i=1 to 12
	sx "["i+4";15Hce³   cc³  ce³"copies(" ",40)"cc³"
end
sx "ceÀccÄÄÄÙ  ceÀcc"copies("Ä",40)"Ù"
sx "caFcbFull filelist"
sx "caDcb<x> days back"
sx "caLcbSince last filelist    c9("date('n',sidste)")"
if maint~=0 then sx "caGcbGlobal filelist (Includes EVERYTHING!)"
a=substr(setup,1,1);sx "caTcbChange type of list    c9"type.a
a=substr(setup,2,1);sx "caScbChange sort by method  c9"sort.a
sx "caCcbChange archive-method  c9("gu(2309386+arc*(288+cn*128))")"
sx "caQcbQuit"

USER:;bufferflush
USERMENU:;gc;a=result;if a="###PANIC" then signal USERBYE
if a="G" & maint=0 then signal USERMENU
if index("FCDLTSQG",a)=0 then signal USERMENU
if a="T" then signal CHANGETYPE
if a="S" then signal CHANGESORT
if a="C" then signal CHANGEARC
if a="Q" then signal USERBYE
GLists=1
if sidste=date('i') then today=today+1
else today=1
lname.1=gu(2307314)"F"d2x(date('i'))||d2c(today+64)
ldesc.1=L.Desc.0
ltype.1=substr(setup,1,1)+1
lsort.1=substr(setup,2,1)+1
lshowup.1=substr(L.Flag.0,1,1)
lshowinv.1=substr(L.Flag.0,2,1)
lshowpvt.1=substr(L.Flag.0,3,1)
lday.1=0
b='';do i=0 to 3;p=gu(1100652+i);b=b||c2b(d2c(p+(p<0)*256));end
lusfl.1=reverse(b)
laccess.1=gu(15)
lpath.1=uu
lheader.1=L.Header.0
lfooter.1=L.Footer.0
if a="F" then signal USERFULL
if a="D" then signal USERDAYS
if a="L" then signal USERLAST
if a="G" then signal USERGLOBAL

USERBYE:
call open(1,uu"_FLcfg","W")
call writeln(1,sidste""dage)
call writeln(1,setup)
call writeln(1,today)
call close(1)
tx "cfReturning to "bbs
exit

CHANGETYPE:
a=substr(setup,1,1);a=a+1;if a=4 then a=0;setup=overlay(a,setup,1)
sx "c9"type.a
signal USER

CHANGESORT:
a=substr(setup,2,1);a=1-a;setup=overlay(a,setup,2)
sx "c9"sort.a
signal USER

CHANGEARC:
tot=gu(2409366)
do forever
	arc=arc+1;if arc>tot-1 then arc=0
	if gu(2309538+arc*(288+c2*128))~="" then leave
end
sx "c9("gu(2309386+arc*(288+c2*128))")"
signal USER

USERFULL:
ldesc.1=ldesc.1" - Full filelist"
signal GENERATE

USERDAYS:
sx "cfNumber of days to include:"
lday.1=ENTER(18,37,dage,"f",0,68,3);dage=lday.1
if lday.1>1 then ldesc.1=ldesc.1" - Last "lday.1" days"
if lday.1=1 then ldesc.1=ldesc.1" - Last day"
signal GENERATE

USERLAST:
lday.1=date('i')-date('i',sidste);if lday.1=0 then lday.1=1
ldesc.1=ldesc.1" - Since "date('n',sidste)
signal GENERATE

USERGLOBAL:
laccess.1=32;lshowup.1=1;lshowinv.1=1;lshowpvt.1=1
ldesc.1=ldesc.1" - Includes EVERYTHING";acc=32
signal GENERATE


GENERATE:
if GLists>1 then do
	acc=32
	pack="C:LHA a "
	suf=".LHA"
end
else do
	p=gu(2309538+arc*(288+c2*128))
	parse var p pack"%s" .
	suf=gu(2309386+arc*(288+c2*128))
end

sidste=date('i');tx "f1z1cf"center(substr(ver,7),79)"z0"
sx "cfÚce"copies("Ä",70)"cc¿"
sx "ce³"copies(" ",70)"cc³"
sx "ceÀcc"copies("Ä",70)"Ù"

dag=date('i')
sub.=0;dir.=0;mx=0
sx "ca"center("Reading subboard-config",70)
do i=0 to gu(2407238)-1
	sbb=import(offset(null(),i*(488+cn*208)+gu(2401068)),488)
	besk=chop(substr(sbb,1,31))
	if besk="[none]" then do;sub.count=i-1;leave;end
	child=number(substr(sbb,327+cn*138,2))
	next=number(substr(sbb,329+cn*138,2))
	sub.check.child=1;sub.check.next=1
end

chk=-1
do i=0 to sub.count
	if sub.check.i=0 then do;chk=i;leave;end
end
if chk=-1 then exit
call SUBSTRUC(chk)



dt=date('n');dtcd=left(dt,2)"-"substr(dt,4,3)"-"right(dt,2);tmc=time('n')
head='Generated 'dtcd' 'tmc

file.=0;size.=0;privt.=0;dato.=0;age.=0;beskr.=0
do q=1 to dir.count
	if GLists=1 then do
		showupl=lshowup.1;usflag=lusfl.1;showinv=lshowinv.1
	end
	if checkaccess(q,acc)=0 then iterate
	sx "ca"center("Scanning subboard: "dir.desc.q,70)
	tpe=2
	if exists(dir.spth.q'data/_Items3') then tpe=1
	if tpe=1 then do
		sh=exists(dir.spth.q'data/_Short')
		call open(3,dir.spth.q'data/_Items3','R')
		if sh then call open(4,dir.spth.q'data/_Short','R')
		call open(5,dir.spth.q'data/_Headers3','R')
		do j=1 until eof(3)
			a=readch(3,168)
			if a="" then leave
			hd=readch(5,34);parse var a file.q.j'00'x
			if length(file.q.j)>16 then file.q.j=left(file.q.j,15)||"*"
			size.q.j=c2d(substr(hd,5,4));killed=c2d(right(hd,1))
			misng=c2d(substr(a,83,1))
			if size.q.j==0|killed|misng then do;j=j-1;iterate;end
			privt.q.j=c2d(substr(a,71,1))
			dt=substr(hd,13,4)
			dtc='19'c2d(left(dt,1))right(c2d(substr(dt,2,1)),2,"0")right(c2d(substr(dt,3,1)),2,"0")
			age.q.j=dag-date("i",dtc,'s')
			dtc=date('N',dtc,'s');dato.q.j=left(dtc,2)"-"substr(dtc,4,3)"-"right(dtc,2)			
			free.q.j=c2d(substr(a,75,1))
			if sh then do
				call seek(4,c2d(substr(a,161,4)),'B');v=readch(4,c2d(substr(a,165,4)))
				parse var v dsc'00'x
			end
			if ~sh then do
				a=statef(dir.spth.q||file.q.j)
				parse var a . . . . . . . dsc
			end
			dsc=strip(dsc)
			if dsc="" then dsc="[No description]"
			cnt=1
			do forever
				p=index(dsc,"0A"x)
				if p=0 & length(dsc)<45 then leave
				if p>45 | p=0 then p=lastpos(" ",dsc,45)
				beskr.q.j.cnt=left(dsc,p-1);cnt=cnt+1
				dsc=substr(dsc,p+1)
			end
			beskr.q.j.cnt=dsc;beskr.q.j.count=cnt
		end
		call close(3)
		if sh then call close(4)
		call close(5)
	end
	else if tpe=2 then do
		dr=showdir(dir.spth.q,'F')
		if dr~="" then do
			do j=1 to words(dr)
				file.q.j=word(dr,j)
				a=statef(dir.spth.q||file.q.j);parse var a . size.q.j . . a . . dsc
				dsc=strip(dsc)
				if dsc="" then dsc="[No description]"
				age.q.j=dag-a
				dtc=date('N',a);dato.q.j=left(dtc,2)"-"substr(dtc,4,3)"-"right(dtc,2)
				cnt=1
				do forever
					p=index(dsc,"0A"x)
					if p=0 & length(dsc)<45 then leave
					if p>45 | p=0 then p=lastpos(" ",dsc,45)
					beskr.q.j.cnt=left(dsc,p-1);cnt=cnt+1
					dsc=substr(dsc,p+1)
				end
				beskr.q.j.cnt=dsc;beskr.q.j.count=cnt
			end
		end
		else j=1
	end
	tot.q=j-1
end
do q=1 to GLists
	showupl=lshowup.q;usflag=lusfl.q;showinv=lshowinv.q;prgs=0
	sx "ca"center("Creating list: "lpath.q||lname.q,70)
	if ltype.q=2 then do
		call open(2,TempDir||lname.q'.top',"W")
		call writeln(2,'@DATABASE "'lname.q'.Guide"')
		call writeln(2,'@$VER: 'dtcd' 'tmc||'0A'x)
		call writeln(2,'@node "MAIN" " 'ldesc.q'"')
		call open(1,TempDir||lname.q".gde","W")
	end				
	if ltype.q=3 | ltype.q=4 then do
		call open(2,TempDir||lname.q'.top',"W")
		call writeln(2,'<!--File generated 'dtcd' by MCFilelister-->')
		call writeln(2,'<HTML>')
		call writeln(2,'<HEAD>')
		call writeln(2,'<TITLE>'ldesc.q'</TITLE>')
		call writeln(2,'</HEAD>')
		call open(1,TempDir||lname.q".htm","W")
	end
	if ltype.q=1 then call open(1,TempDir||lname.q".txt","W")
	fcod=2;if ltype.q=1 then fcod=1
	if lheader.q~="" then do
		if exists(lheader.q) then do
			if ltype.q=3 | ltype.q=4 then call writech(2,"<PRE>")
			call open(3,lheader.q,"R")
			do forever
				a=readln(3)
				if eof(3) then leave
				call writeln(fcod,a)
			end
			call close(3)
			if ltype.q=3 | ltype.q=4 then call writech(2,"</PRE>")
		end
	end
	if ltype.q=1 then do
		call writeln(1,center(ldesc.q,79))
		call writeln(1,center(head,79))
	end	
	if ltype.q=2 then do
		call writeln(2,'      @{b}'head'@{ub}')
		call writeln(2,'      'copies("-",length(head))||'0A'x)
	end
	if ltype.q=3 | ltype.q=4 then do
		call writeln(2,'<H2><P ALIGN=CENTER>'ldesc.q'</H2>')
		call writeln(2,'<H3>'head'</H3>')
	end
	do j=1 to dir.count	
		if checkaccess(j,laccess.q)=0 then iterate 
		if tot.j=0 then iterate
		call open(3,"ram:Sortlist","W")
		tt=0
		do i=1 to tot.j
			if privt.j.i & ~lshowpvt.q then iterate
			if age.j.i>lday.q & lday.q>0 then iterate
			tt=tt+1
			if lsort.q=1 then call writeln(3,file.j.i""i)
			if lsort.q=2 then call writeln(3,right(age.j.i,5,"0")""i)
		end
		call close(3)
		if tt=0 then do;call delete("ram:Sortlist");iterate;end
		if prgs=0 then do;sx "cf*";prgs=1;end
		else do;sx "cf ";prgs=0;end
		address command 'sort ram:Sortlist ram:Sortlist'
		if ltype.q=1 then do
			call writeln(1,copies("-",79))
			call writeln(1,center(upper(dir.desc.j),79))
			call writeln(1,copies("-",79))
		end
		if ltype.q=2 then do
			call writeln(1,'@node "'j'" " 'dir.desc.j'"'||'0A'x)
			call writeln(2,'      @{"'center(dir.desc.j,mx+2)'" Link 'j' }')
		end
		if ltype.q=3 then do
			call writeln(1,'<H3>'dir.desc.j'</H3>')
			call writeln(1,'<PRE>'copies("-",79))
		end
		if ltype.q=4 then do
			call writeln(1,'<TABLE BORDER=1 CELLPADDING=1 WIDTH="100%">')
			call writeln(1,'<A NAME="'j'"><TR>')
			call writeln(1,'<TD COLSPAN=4>')
			call writeln(1,'<P ALIGN=CENTER><B><I><FONT SIZE=4>'dir.desc.j'</FONT></I></B>')
			call writeln(1,'</TD></TR>')
			call writeln(2,'<A HREF="#'j'">'dir.desc.j'</A><BR>')
		end
		if ltype.q~=4 then do
			call writeln(1,'Filename             Size Upl.Date  Description')
			call writeln(1,copies("-",79))
		end
		call open(3,'ram:Sortlist','R')
		do i=1 to tt
			a=readln(3)
			parse var a b''nr
			if ltype.q~=4 then do
				call writeln(1,left(file.j.nr,17)" "right(size.j.nr,7)" "dato.j.nr" "beskr.j.nr.1)
			end
			if ltype.q=4 then do
				call writeln(1,'<TD>')
				call writeln(1,'<P>'file.j.nr)
				call writeln(1,'</TD><TD>')
				call writeln(1,'<P ALIGN=RIGHT>'size.j.nr)
				call writeln(1,'</TD><TD>')
				call writeln(1,'<P ALIGN=CENTER>'dato.j.nr)				
				call writeln(1,'</TD><TD>')
				if beskr.j.nr.count>1 then call writeln(1,'<P>'beskr.j.nr.1'<BR>')
				if beskr.j.nr.count=1 then call writeln(1,'<P>'beskr.j.nr.1)
			end
			if beskr.j.nr.count>1 then do
				do k=2 to beskr.j.nr.count
					if ltype.q~=4 then do
						call writeln(1,copies(" ",36)||beskr.j.nr.k)
					end
					if ltype.q=4 then do
						if k<beskr.j.nr.count then call writeln(1,beskr.j.nr.k'<BR>')
						if k=beskr.j.nr.count then call writeln(1,beskr.j.nr.k)
					end
				end
			end
			if ltype.q=4 then call writeln(1,'</TD></TR>')
		end
		if ltype.q=1 then call writeln(1,'')
		if ltype.q=2 then call writeln(1,'@endnode')
		if ltype.q=3 then call writeln(1,'</PRE>')
		if ltype.q=4 then call writeln(1,'</TABLE></P>')
		call close(3)
		call delete('ram:Sortlist')
	end
	if ltype.q=3 | ltype.q=4 then do
		call writeln(2,'</P>')
		call writeln(2,'<P>')
	end
	if lfooter.q~="" then do
		if exists(lfooter.q) then do
			fcod=2;if ltype.q=1 then fcod=1
			call open(3,lfooter.q,"R")
			if ltype.q=3 | ltype.q=4 then call writech(2,"<PRE>")
			do forever
				a=readln(3)
				if eof(3) then leave
				call writeln(fcod,a)
			end
			if ltype.q=3 | ltype.q=4 then call writech(2,"</PRE>")
			call close(3)
		end
	end		
	call writeln(1,'<P>&nbsp;</P>')
	call writeln(1,'</BODY>')
	call writeln(1,'</HTML>')
	call close(1)
	if ltype.q=2 then do
		call writeln(2,'@endnode')
		call close(2)
		address command 'join "'TempDir||lname.q'.top" "'TempDir||lname.q'.gde" as "'TempDir||lname.q'.guide"'
		call delete(TempDir||lname.q'.top')
		call delete(TempDir||lname.q'.gde')
	end
	if ltype.q=3 | ltype.q=4 then do
		call close(2)
		address command 'join "'TempDir||lname.q'.top" "'TempDir||lname.q'.htm" as "'TempDir||lname.q'.html"'
		call delete(TempDir||lname.q'.top')
		call delete(TempDir||lname.q'.htm')
	end
	if ltype.q=1 then TempFl=TempDir||lname.q".TXT"
	if ltype.q=2 then TempFl=TempDir||lname.q".GUIDE"
	if ltype.q=3 | ltype.q=4 then TempFl=TempDir||lname.q".HTML"
	del='delete "'TempFl'"'
	if suf~=".TXT" then do
		pck=pack' "'lpath.q||lname.q'" "'TempFl'"'
	end
	else do
		if ltype.q=1 then suf=".txt"
		if ltype.q=2 then suf=".guide"
		if ltype.q=3 | ltype.q=4 then suf=".html"
		pck='copy "'TempFl'" "'lpath.q||lname.q||suf'"'
	end
	if exists(lpath.q||lname.q||suf) then call delete(lpath.q||lname.q||suf)
	not='filenote "'lpath.q||lname.q||suf'" "'ldesc.q'"'
	sx '$ 'pck'}$ 'del'}$ 'not'}'
end
tx ""
if ucod~="U" then exit
call open(1,uu"_FLcfg","W")
call writeln(1,sidste""dage)
call writeln(1,setup)
call writeln(1,today)
call close(1)
if gu(1209644)=gu(2407246) then do
	tx "b1cfNo space in selectbuffer - you need to download the filelist NOW! <ENTER>";gc
	if gu(47)~=-1 then do
		setobject "d";putuser 1307358
		setprotocol ""
		addkeys "0d"x
		xdn uu||lname.1||suf
	end
	call delete(uu||lname.1||suf)
	exit
end
call open(fp,uu||lname.1||suf,'R')
by=x2c(d2x(seek(fp,0,'E'),8))
call close(fp)

SH=by||left(lname.1||suf,32,'00'x)left(uu,96,'00'x)copies('00'x,6)'0102'x||by'0001'x||copies('00'x,10)
if carrier() then do
 call export(x2c(d2x(gu(1401978)+gu(1209644)*156,8)),SH)
 setobject gu(1209644)+1;putuser 1209644
 tx "c3     Filelist added to select-buffer as "lname.1||suf"q1"
end
else do
 if exists(uu"_select3") then mode="A";else mode="W"
 call open(fp,uu"_select3",mode);call writech(fp,sh);call close(fp)
end
exit

SUBSTRUC:
procedure expose dir. mx cn
arg list
ct=cn*138
do forever
	sbb=import(offset(null(),list*(488+cn*208)+gu(2401068)),488)
	sub=c2d(substr(sbb,161+ct,1))
	besk=chop(substr(sbb,1,31+cn*29))
	child=number(substr(sbb,327+ct,2))
	next=number(substr(sbb,329+ct,2))
	type=c2d(substr(sbb,270+ct,1))
	exch=c2d(substr(sbb,157+ct,1))
	sti=chop(substr(sbb,53+cn*83,40+cn*30))
	dirc=chop(substr(sbb,333+ct,40+cn*30))
	if sub=0 & type=1 then do		
		dir.count=dir.count+1;d=dir.count
		if exch=0 then do
			dir.dct.d=" ";dir.spth.d=sti
		end
		if exch=1 then do
			dir.dct.d="*";dir.spth.d=dirc
		end
		dir.desc.d=besk
		mx=max(mx,length(besk))
		dir.access.d=reverse(c2b(substr(sbb,167+ct,4)))
		dir.flflag.d=reverse(c2b(substr(sbb,163+ct,4)))
		dir.dwlacc.d=reverse(c2b(substr(sbb,183+ct,4)))
		dir.uplacc.d=reverse(c2b(substr(sbb,179+ct,4)))
		dir.inv.d=c2d(substr(sbb,267+ct,1))
	end
	if child>0 then call SUBSTRUC(child)
	if next=-1 then leave
	list=next
end
return()

CHECKACCESS: procedure expose dir. showupl usflag showinv
parse arg dnr,acc
if acc<32 then do
	chk=1
	if substr(dir.access.dnr,acc+1,1)="0" then chk=0
	if showinv=0 & dir.inv.dnr=1 then chk=0
	if chk=1 then do
		p=0
		do forever
			p=index(dir.flflag.dnr,"1",p+1);if p=0 then leave
			if substr(usflag,p,1)="0" then do;chk=0;leave;end
		end
	end
	if chk=1 then do
		up=0;dw=0
		if substr(dir.dwlacc.dnr,acc+1,1)="1" then dw=1
		if substr(dir.uplacc.dnr,acc+1,1)="1" then up=1
		if up=0 & dw=0 then chk=0
		if up=1 & dw=0 & showupl=0 then chk=0
	end
end
else chk=1
return chk

CHOP:
parse arg str
p=index(str,'0'x)
if p<2 then return "[none]"
if p>1 then p=p-1
return left(str,p)

NUMBER:
parse arg cod
a=c2d(left(cod,1))*256+c2d(right(cod,1))
if a=65535 then a=-1
return a

CARRIER:;getcarrier;return result="TRUE"

ENTER: procedure
parse arg y,x,tekst,c,z,a,l
sendstring "["||y||";"||x||"Hl1305640 #"tekst"}c"c"z"z||copies(" ",l)"["||y||";"||x||"Hi"a" "l"}z0"
getuser 70;return(result)

GU: procedure
arg g;getuser g;return result

SYNTAX:;ERROR:;IOERR:;e0='Error in line: 'left(sigl,4)' File:';e1='Error Code 'rc' <'errortext(rc)'>';e2=sourceline(sigl)
getuser 1311992 ;e0=e0||result;getuser 1311960;e0=e0||result;call log(e0);call log(e1);call log(e2);bufferflush;exit
LOG:;er=ARG(1);transmit er;do a=0 to length(er)%45;logentry substr(er,a*45+1,45);end;return
/** Last Edited: 19-OCT-96 ************************************************\
\************************************* InfoNet Service +45 - 43 53 57 53 **/