/*-REXX-*/

/* QWKView -- a simple set of routines to display QWK packet information */
/* and optionally allow you to delete unwanted incoming messages (spam) */
/* Command line format also designed for use with List / FV [LA] etc. */
/* Freeware by Ben Jones (http://www.ozaru.net) -- use at your peril! ;-) */

'@echo off'
call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
call SysLoadFuncs
/* Don't know if these are actually needed, but just in case ... */

ARG function MessNumber

filein="messages.dat"	/* unarchived from BBSID.qwk */
batch=128		/* length of packet in QWK */
EOF=0

select
when function = "L" then Call ListMess
when function = "R" then Call RenumberMess
when function = "D" then Call DelMess(MessNumber)
when function = "V" then Call ViewMess(MessNumber)
when function = "" then Say "Usage: (L)ist (R)enumber (D)elete Num (V)iew Num"
otherwise Say function "?! Usage: (L)ist (R)enumber (D)elete Num (V)iew Num"
end		/* select */

return		/* end of whole programme */

/****************************/

ListMess: 
/* Lists titles etc. of all messages */

Header=charin(filein,1,128)
Say "List of messages in" filein	/* partly needed for use with LIST */

Do forever
Byte1=charin(filein,,1)
If Byte1=="" then leave		/* EOF */
NumberRaw=charin(filein,,7)		/* ignored, as may be non-unique */
DispNum=Format(NumberRaw,3)	/* for display; only up to 999 messages! */
DateTime=charin(filein,,13)
To=charin(filein,,25)
From=charin(filein,,25)
Subject=charin(filein,,23)	/* display limited 3+1+25+1+25+1+23 = 79 chars + CR */
Subject2=charin(filein,,2)

Say DispNum To From Subject

PassRef=charin(filein,,20)	/* ignored */
LengthRaw=charin(filein,,6)
Length=LengthRaw*batch
Flag=charin(filein,,1)	/* ignored */
Conference=charin(filein,,2)	/* some day should be able to change it */
 /* Also ought to write Control.Dat file properly ... some day */
NetTag=charin(filein,,3)	/* ignored */
RestOfMessage=charin(filein,,Length-128)

End	/* do forever, i.e. until EOF */

Say "End of list"	/* partly needed for use with LIST */

Return

/****************************/

RenumberMess: 
/* Renumbers all messages to be unique */

fileout="new\messages.dat"
"if not exist new\control.dat copy control.dat new\control.dat"

Header=charin(filein,1,128)
RetCode=charout(fileout,Header)
NewNum=0			/* let's start numbering at 1 */
Say "Renumbering messages in" filein

Do forever
Byte1=charin(filein,,1)
If Byte1=="" then leave		/* EOF */
NumberRaw=charin(filein,,7)		/* ignored, as may be non-unique */
NewNum=format(NewNum+1,7)	/* unique number, right length */
 /* NOTE -- this number ignores conferences -- not ideal, but ... */
DispNum=Format(NewNum,3)	/* for display; only up to 999 messages! */
DateTime=charin(filein,,13)
To=charin(filein,,25)
From=charin(filein,,25)
Subject=charin(filein,,23)	/* display limited 3+1+25+1+25+1+23 = 79 chars + CR */
Subject2=charin(filein,,2)

PassRef=charin(filein,,20)	/* ignored */
LengthRaw=charin(filein,,6)
Length=LengthRaw*batch
Flag=charin(filein,,1)	/* ignored */
Conference=charin(filein,,2)	/* some day should be able to change it */
 /* Also ought to write Control.Dat file properly ... some day */
NetTag=charin(filein,,3)	/* ignored */
RestOfMessage=charin(filein,,Length-128)

 RetCode=charout(fileout,Byte1)
 RetCode=charout(fileout,NewNum)
 RetCode=charout(fileout,DateTime)
 RetCode=charout(fileout,To)
 RetCode=charout(fileout,From)
 RetCode=charout(fileout,Subject)
 RetCode=charout(fileout,Subject2)
 RetCode=charout(fileout,PassRef)
 RetCode=charout(fileout,LengthRaw)
 RetCode=charout(fileout,Flag)
 RetCode=charout(fileout,Conference)
 RetCode=charout(fileout,NetTag)
 RetCode=charout(fileout,RestOfMessage)
/* Ought to check here for disk full etc. */

End	/* do forever, i.e. until EOF */

Say "Finished:" NewNum "messages"

Return

/****************************/

DelMess:
/* uses MessNumber */

fileout="new\messages.dat"
"if not exist new\control.dat copy control.dat new\control.dat"

Header=charin(filein,1,128)
RetCode=charout(fileout,Header)

Do forever
DeleteThisOne="N"
Byte1=charin(filein,,1)
If Byte1=="" then leave
NumberRaw=charin(filein,,7)
DispNum=Format(NumberRaw,3)
DateTime=charin(filein,,13)
To=charin(filein,,25)
From=charin(filein,,25)
Subject=charin(filein,,23)
Subject2=charin(filein,,2)
PassRef=charin(filein,,20)	/* ignored */
LengthRaw=charin(filein,,6)
Length=LengthRaw*batch
Bytes2=charin(filein,,6)	/* ignored */
RestOfMessage=charin(filein,,Length-128)

If Format(DispNum) == Format(MessNumber) then do
 Say DispNum To From Subject
 Say "OK to delete this message?"
 Pull DeleteThisOne
End

If DeleteThisOne == "Y" then Say "Message" MessNumber "deleted; copying others"
Else do
 RetCode=charout(fileout,Byte1)
 RetCode=charout(fileout,NumberRaw)
 RetCode=charout(fileout,DateTime)
 RetCode=charout(fileout,To)
 RetCode=charout(fileout,From)
 RetCode=charout(fileout,Subject)
 RetCode=charout(fileout,Subject2)
 RetCode=charout(fileout,PassRef)
 RetCode=charout(fileout,LengthRaw)
 RetCode=charout(fileout,Bytes2)
 RetCode=charout(fileout,RestOfMessage)
/* Ought to check here for disk full etc. */
End

End	/* forever */

/* after reaching EOF */

/* "if exist" fileback "del" fileback
ren filein fileback
ren fileout filein */

return

/****************************/

ViewMess: 
/* uses MessNumber */

Header=charin(filein,1,128)

Do forever
Byte1=charin(filein,,1)
If Byte1=="" then leave
NumberRaw=charin(filein,,7)
Number=Format(NumberRaw,3)
Bytes2=charin(filein,,108)	/* ignored */
LengthRaw=charin(filein,,6)
Length=LengthRaw*batch
Bytes3=charin(filein,,6)	/* ignored */
RestOfMessage=charin(filein,,Length-128)

If format(Number) == format(MessNumber) then do
	pos=0
	do forever
	 FindE3=pos("E3"x,RestOfMessage,pos+1)
	 /* "E3" = carriage return code; double = blank line after headers */
	 If FindE3==0 then leave
	 pos=FindE3
	 RestOfMessage=overlay("0D"x,RestOfMessage,pos)
	 RestOfMessage=insert("0A"x,RestOfMessage,pos)
	end	/* inner "forever" */
say RestOfMessage
return
end	/* if number==messnumber */
end	/* outer "forever" loop */