'EditMarkList door by Peter Zelezny.   for MAXsBBs all Versions

'1-OCT-94

'REM $OPTION Y
REM $OPTION K50
'REM $LINES ON
LIBRARY "exec.library"
LIBRARY "dos.library"
'LIBRARY "intuition.library"
DECLARE SUB CopyMem& LIBRARY
DECLARE FUNCTION AllocMem& LIBRARY
DECLARE FUNCTION FreeMem& LIBRARY
DECLARE FUNCTION FindTask& LIBRARY
DECLARE FUNCTION SetTaskPri& LIBRARY
DECLARE FUNCTION AllocSignal& LIBRARY
DECLARE FUNCTION AddPort& LIBRARY
DECLARE FUNCTION Forbid& LIBRARY
DECLARE FUNCTION Permit& LIBRARY
DECLARE FUNCTION FindPort& LIBRARY
DECLARE FUNCTION PutMsg& LIBRARY
DECLARE FUNCTION WaitPort& LIBRARY
DECLARE FUNCTION GetMsg& LIBRARY
DECLARE FUNCTION RemPort& LIBRARY
DECLARE FUNCTION FreeSignal& LIBRARY
DECLARE FUNCTION Execute& LIBRARY
DECLARE FUNCTION xOpen& LIBRARY
DECLARE FUNCTION xRead& LIBRARY
DECLARE SUB xClose& LIBRARY

ON ERROR GOTO error.handler

DIM SHARED PortAddress&, TaskAddr&, Dummy%, MsgPortName$, MsgPortName2$
DIM SHARED Sig%, ControlPort&, ErrCode%, Arg1&, Arg2&, Reply&
DIM SHARED i&, j%, Flag%, esc$, a%, L&, NameMemAddr&

DATA "$VER: FLE_EditMarkList 0.80"
e$=CHR$(27)+"["
clear$=e$+"2J"+e$+"1H"
cr$=CHR$(13)
door$="EditMarkList"

IF COMMAND$="" THEN ? "File Lister Express EditMarkList Door.":END

IF port$="" THEN port$=COMMAND$
MsgPortName$="DoorControl"+PORT$+CHR$(0)
MsgPortName2$="DoorReply"+PORT$+CHR$(0)
CALL GetPort
IF ControlPort&=0 THEN end

'######################################################################
'Your Programme goes in here!!!!!
'######################################################################

GOSUB LOADCONFIG
DIM Path$(500),tagged$(100),tagsec(100),tagpos(100)
findInsert username$,"f"
OPEN "I",#1,"doors:filebase/config/sections.txt"
WHILE NOT EOF(1)
  INPUT #1,sec,axs,ma,mas,desc,diz,flen
  LINE INPUT #1,nam$
  LINE INPUT #1,pat$
  INPUT #1,f$,uf$
 path$(sec)=pat$
WEND
close 1
dfunc 115,306,""
PS ""
gosub LOADTAG
gosub SORT
gosub PRINTTAG
st$=" "
while st$<>""
dfunc 115,312,""
st$=""
inputmsg st$,20
if st$<>"" then gosub checkfile
wend
goto exitt

LOADTAG:
 x=0
 f$="doors:filebase/taggedfiles/"+username$
 if FEXISTS(f$) then
 open "I",#1,f$
 while not eof(1)
  x=x+1
  input #1,a$,b,c
  tagged$(x)=UCASE$(a$)
  tagsec(x)=b
  tagpos(x)=c
 wend
 close 1
 end if
 MARKEDFILES=x
RETURN

PRINTTAG:
 e=0
 for x=1 to MARKEDFILES
	a$=tagged$(x)
	b=tagsec(x)
	c=tagpos(x)
	x$=LTRIM$(STR$(x))
	IF x<10 THEN x$="0"+x$
	dfunc 115,343,""
	IF e=0 THEN PS cr$+x$ ELSE PS ""+x$
	e=e+1
	IF e=3 THEN e=0
	dfunc 115,150,""
	PS a$+STRING$(22-LEN(a$)," ")
 next x
 dfunc 115,311,""
 PS STR$(MARKEDFILES)
RETURN

checkfile:
 if LEN(st$)>2 then CHECKFILEBASE
 sr=val(st$)
 if sr>100 or sr<1 then return
 fil$=tagged$(sr)
 if fil$="" then CHECKFILEBASE
 tagged$(sr)=""
 PS cr$
 dfunc 115,304,""
 dfunc 115,150,""
 PS " "+fil$+STRING$(20-LEN(fil$)," ")
return

checkfilebase:
PS cr$+"Searching entire filebase... "
nindex$="files:datafiles/NamesIndex.Data"
datafile$="files:datafiles/FileList.Data"
OPEN "R",#1,datafile$,607
field #1,20 as filename$,540 as descr$,20 as uploader$,6 AS PASS$,2 AS UPTIME$,6 as dait$,4 as filesize$,1 as flag$,2 as dns$,2 as sec$,4 as dummy$
NFIL=LOF(1)/607
handle&=xOpen&(SADD(nIndex$+CHR$(0)),1005)
if handle&=0 then return
st$=UCASE$(st$)
t=0:co=26:blah=0
buf&=SADD(STRING$(21,0))

FOR y = 1 TO NFIL
 	co=co+1
 	IF co>32 THEN
   	 	blah=blah+1
    		IF blah=1 THEN a$="-"
    		IF blah=2 THEN a$="/"
    		IF blah=3 THEN a$="³"
    		IF blah=4 THEN a$="\":blah=0
    		co=0
    		PS CHR$(8)+a$
 	END IF
 	x=xRead&(handle&,buf&,20&)
 	a$=LEFT$(UCASE$(PEEK$(buf&)),20)
	IF a$=st$ THEN GOSUB addtolist: GOTO finsearch
	IF INSTR(a$,st$) THEN
		gosub iscorrect
		if t=1 then finsearch
	end if
next y

dfunc 115,147,""
finsearch:
xClose&(Handle&)
close 1
return

ISCORRECT:
 a$=UCASE$(A$)
 PS cr$+cr$
 dfunc 115,150,""
 PS a$+cr$
 dfunc 115,256,""
 sr$=""
 hotkey sr$,sr$
 sr$=UCASE$(sr$)
 if sr$="S" then PS "Stop": t=1: return
 if sr$="Y" then CALL YES: gosub ADDTOLIST: t=1: return
 PS CR$
 FOR yy=1 TO 4
	PS ""
 NEXT yy
 PS ""
 if sr$="N" then return
 goto ISCORRECT


ADDTOLIST:
	get #1,y
	fil$=PEEK$(sadd(filename$))
	fil$=UCASE$(fil$)
	currentpos=y
	flag=asc(flag$)
	s=CVI(Sec$)
	f$=path$(s)+fil$
	IF FEXISTS(f$) then
   	 	open "I",#2,f$
   	 	size$=STR$(LOF(2))
   	 	close 2
   	 	gosub ADDTOTAGLIST
	ELSE
   	 	dfunc 115,164,""
	END IF
	RETURN

ADDTOTAGLIST:
 findinsert a$,"l"
 UserAccess%=val(a$)
 if flag=1 and UserAccess%<5000 then PS "File "+file$+" is not public!"+cr$:return
 f$=fil$
 if f$="" then return
 t=0
 for g=1 to 100
   if UCASE$(tagged$(g))=UCASE$(f$) then gosub UNTAG: return
   if tagged$(g)="" and t=0 then t=g
 next g
 if t=0 then PS CHR$(7): return
 PS ""
 tagged$(t)=f$
 tagsec(t)=s
 tagpos(t)=currentpos
 dfunc 115,303,""
 dfunc 115,150,""
 PS " "+fil$+STRING$(20-LEN(fil$)," ")
 dfunc 115,151,""
 PS size$
RETURN

UNTAG:
 PS ""
 dfunc 115,304,""
 dfunc 115,150,""
 PS " "+fil$+STRING$(20-LEN(fil$)," ")
 dfunc 115,151,""
 PS size$
 tagged$(g)=""
 for t=100 to 1 step -1
  if tagged$(t)<>"" then
    tagged$(g)=tagged$(t)
    tagsec(g)=tagsec(t)
    tagpos(g)=tagpos(t)
    tagged$(t)=""
    return
  end if
 next t
RETURN

LOADCONFIG:
OPEN "I",#1,"doors:filebase/config/FLE.Config"
line input #1,a$
taskpri=VAL(a$)
IF taskpri<>0 THEN x=SetTaskPri&(TaskAddr&,TaskPri)
RETURN

SORT:
n=MARKEDFILES
if n=0 then RETURN
a=n
if a<10 then a=10
DIM S(a)
	S(1)=1 : S(2)=N : T=1
aaa:	IF T=0 THEN RETURN
	T=T-1 : I=2*T : L=S(I+1) : M=S(I+2):X$=tagged$(L): XX=tagsec(L) : YY=tagpos(L): J=L : K=M+1
bbb:	K=K-1 : IF K=J THEN ddd
	IF X$<=tagged$(K) THEN bbb
	tagged$(J)=tagged$(K): tagsec(J)=tagsec(K): tagpos(J)=tagpos(K)
ccc:	J=J+1:IF K=J THEN ddd
	IF X$>=tagged$(J) THEN ccc
	tagged$(K)=tagged$(J) : tagsec(K)=tagsec(J): tagpos(K)=tagpos(J): GOTO bbb
ddd:	tagged$(J)=X$ : tagsec(J)=XX : tagpos(J)=YY: IF M-J<2 THEN eee
	I=2*T : S(i+1)=j+1 : S(I+2)=M : T=T+1 
eee:	IF K-L<2 THEN aaa
	I=2*T : S(I+1)=L : S(I+2)=K-1 : T=T+1
GOTO aaa

'######################################################################
'And ends here
'######################################################################
  
Exitt:
 t=0
 f$="doors:filebase/taggedfiles/"+username$
 OPEN "O",#1,f$
 for z=1 to 100
  a$=tagged$(z)
  a=tagsec(z)
  b=tagpos(z)
  if a$="" then tyu
  ? #1,a$: ? #1,a: ? #1,b
  t=1
  tyu:
 next z
 CLose 1
 if t=0 then IF FEXISTS(f$) then kill f$
 CALL FreePort
 LIBRARY CLOSE
 SYSTEM

Error.Handler:
 OPEN "A",#1,"bbs:logfiles/ErrorLOG.text"
 ? #1,date$+" "+time$+" ["+username$+"] ["+door$+"]"
 PS cr$+cr$+"AN ERROR HAS OCCURED!"+cr$+cr$+""
 if prob$<>"" then
    PS "Error Description: "+prob$+cr$
    ? #1,"    Error Type: "+prob$
 else
    PS "Error Number:"+STR$(ERR)+" (L:"+STR$(ERL)+")"
       ? #1,"    Error #:"+STR$(ERR)+" (L:"+STR$(ERL)+")"
 end if
 close 1
 PS cr$+cr$+"Please notify %a asap!!"+cr$+cr$+"%Z"
 GOTO exitt

SUB getport STATIC
PortAddress&=AllocMem&(140&,&H10001)
IF PortAddress&=0 THEN
  PRINT "Couldn't allocate the memory!"
  ErrCode%=2
  GOTO Out
END IF  
TaskAddr&=FindTask&(0)
POKEL PortAddress&+16,TaskAddr&
Sig% = AllocSignal&(-1)
IF Sig%<0 THEN
  ErrCode%=3
  GOTO Out
END IF
POKE PortAddress&+8,4
POKEL PortAddress&+10,SADD(MsgPortName2$)
POKE PortAddress&+15,Sig%
POKE PortAddress&+42,5
POKEW PortAddress&+52,106
POKEL PortAddress&+48,PortAddress&
Reply&=AddPort&(PortAddress&)
Dummy%=Forbid&
ControlPort&=FindPort&(SADD(MsgPortName$))
Dummy%=Permit&
Out:
END SUB

SUB FreePort STATIC
On ErrCode% goto Sig1,Sig2,Sig3,Sig4
CALL GetMsgPrt (Arg1&,Arg2&)
POKEW Arg2&,20
Reply&=PutMsg&(ControlPort&,Arg1&)
Pause:
Reply&=WaitPort&(PortAddress&)
Reply&=GetMsg&(PortAddress&)
IF Reply&=0 THEN GOTO Pause
Sig4:
Dummy%=RemPort&(PortAddress&)
Dummy%=PEEK(PortAddress&+15)
Dummy%=FreeSignal&(Dummy%)
Sig3:
Dummy%=FreeMem(PortAddress&,140&)
Sig2:
Sig1:
END SUB

SUB GetMsgPrt(Arg1&, Arg2&) STATIC
Arg1&=PortAddress&+34
Arg2&=PortAddress&+54
POKEL Arg2&+2,0
END SUB

SUB PS(St$) STATIC
CALL GetMsgPrt (Arg1&, Arg2&)
POKEW Arg2&,1
POKEW Arg2&+2,0   
CopyMem& SADD(st$),Arg2&+4&,LEN(st$)
POKE Arg2&+4&+LEN(st$),0
CALL PutWaitMsg
END SUB

SUB PutWaitMsg STATIC
LOCAL Temp&, Locn&, Tempp&
Reply&=PutMsg&(ControlPort&,Arg1&)
Pause1:
Reply&=WaitPort&(PortAddress&)
Reply&=GetMsg&(PortAddress&)
IF Reply&=0 THEN GOTO Pause1
Tempp&=PEEKW(Reply&+24&+80&)
IF Tempp&<>0 THEN GOTO Exitt                'lost carrier
END SUB

SUB DFunc (F%,E%,st$) STATIC
CALL GetMsgPrt (Arg1&, Arg2&)
POKEW Arg2&,f% 'dn=124
POKEW Arg2&+2,E%
if st$<>""
FOR i&=1 TO LEN(st$)
  POKE Arg2&+3+i&,ASC(MID$(st$,i&,1))
NEXT
POKE Arg2&+3+i&,0
end if
CALL PutWaitMsg
END SUB

SUB FindInsert(st$,ins$) STATIC
CALL GetMsgPrt (Arg1&, Arg2&)
POKEW Arg2&,203
POKEW Arg2&+2,ASC(ins$)
CALL PutWaitMsg
st$=PEEK$(Arg2&+3+1&)
END SUB

SUB FIxString (a$,b$) STATIC
b$=PEEK$(SADD(a$))
'z=INSTR(a$,CHR$(0))
'if z<>0 then b$=LEFT$(a$,z-1) else b$=a$
END SUB

SUB YES
DFunc 115,21,""
end sub

SUB NO
DFunc 115,22,""
end sub

SUB hotkey (F$,K$) STATIC
CALL GetMsgPrt (Arg1&, Arg2&)
POKEW Arg2&,8
POKEW Arg2&+2,0
CopyMem& SADD(f$),Arg2&+4&,LEN(f$)
POKE Arg2&+4&+LEN(f$),0
CALL PutWaitMsg
K$=UCASE$(CHR$(PEEK(Arg2&+4)))
END SUB

SUB InputMsg(St$,MaxChars%) STATIC
CALL GetMsgPrt( Arg1&, Arg2&)
POKEW Arg2&,6
POKEW Arg2&+2,MaxChars%
CopyMem& SADD(st$),Arg2&+4&,LEN(st$)
POKE Arg2&+4&+LEN(st$),0
CALL PutWaitMsg
st$=PEEK$(Arg2&+3+1&)
END SUB