title	Archive Directory Lister
	name	('ADIR')
	maclib	base80

; This program simply lists the contents of several known
; CP/M archives.
; Currently supported:
;	.LBR		Not really an archive
;	.ARK/.ARC	Standard CP/M archive
;	.PMA		Best known CP/M archive
;	.ZIP		MSDOS archive (1.01)

; Copyright (c)	Werner Cirsovius
;		Hohe Weide 44
;		D-20253 Hamburg
;		Phone: +49-40-4223247

.date	equ	102

_DATE	equ	28

LBRlen	equ	32
LBRmem	equ	reclng / LBRlen

ARCtyp	equ	1ah

	entry	$memry
	ext	curdrv,dirmax,files,strcn0,prfn,indexa,open
	ext	filsiz,conout,shr32,dout32,@leng,conchd,crlf
	ext	cnvday,putbcd,sort,setdma,dskred,conino,dskget
	ext	rdbuf,rdbfp

	dseg
$memry:
	dw	0
Fptr:
	ds	2
heap:
	ds	2
RDptr:
	ds	2
drv:
	ds	1
;
HEADln	equ	2		; Two lines in header
$HEAD:
	db	'   Filename   Bytes      Date     Time'
	db	cr,lf
	db	'============= '
S@B	equ	$
	db	'========'
S@L	equ	$-S@B
	db	' ======== ========'
	db	cr,lf,null
$NO.DATE:
	db	'xx-xx-xx xx:xx:xx',null
$DATE:
	db	'00-00-00 00:00:00',null
$NO.FILE:
	db	'No file found ',null
$OPN.ERR:
	db	'Cannot open file ',null
$NO.MEM:
	db	' No member file found',null
$INV:
	db	'Invalid .',null
$FILE:
	db	' file ',null
$MORE:
	db	'[MORE]'
M$L	equ	$-$MORE
	db	null
$NO.MORE:
	db	cr
	ds	M$L,' '
	db	cr,null
$$LBR:
	db	'LBR',null
$$PMA:
	db	'PMA',null
$$ZIP:
	db	'ZIP',null
$$ARC:
	db	'ARC',null
$$ARK:
	db	'ARK'
$EXE:
	dw	NOR.DIR
	dw	LBR.DIR
	dw	PMA.DIR
	dw	ZIP.DIR
	dw	ARx.DIR
SCB$PAG:
	db	1ch,0
maxpag:
	ds	1
curpag:
	ds	1
$NUM32:
	ds	4
Err$$:
	ds	2
LBRcnt:
	ds	2
LBRprt:
	ds	1
D.FCB:
	ds	FCBlen
FOFFS:
	ds	4
ARxbuf	equ	$
A@FN:
	ds	13
A@CL:
	ds	4
A@DAT:
	ds	2
A@TIM:
	ds	2
A@CRC:
	ds	2
A@UL:
	ds	4
ARClen	equ	$-ARxbuf
PMAbuf	equ	$
P@LEN:
	ds	1
P@CKS:
	ds	1
P@MET:
	ds	5
P@CL:
	ds	4
P@UL:
	ds	4
P@D_T:
	ds	4
P@ATT:
	ds	1
P@LEV:
	ds	1
P@FLEN:
	ds	1
PMAlen	equ	$-PMAbuf
P@CRC:
	ds	2
	cseg
;
; Found no archive file - Simple print file name and length
;
NOR.DIR:
	ld	a,' '
	call	prcFN		; Give name of file
	ld	hl,$NUM32
	call	shr32		; Calculate by size
	call	PrSize		; Print size
	ld	hl,FCB
	ld	de,D.FCB
	push	de
	ld	bc,.fdrv+.fname+.fext
	ldir			; Unpack FCB
	pop	de
	ld	c,.date
	call	BDOS		; Get date and time
	ld	ix,D.FCB+_DATE
	ld	a,(ix+0)
	or	(ix+1)		; Test date defined
	or	(ix+2)
	or	(ix+3)
	ld	de,$NO.DATE
	call	nz,PrDR.D$T	; Convert date and time
	call	strcn0
	call	isMore?		; Give new line and check screen
	ret
;
; Found library file
;
; Structure of library file:
; Each record holds four directory entries, the very first entry
; in the very first record is the 'directory' entry.
;
; Byte offset	Normal member	Directory
; +++++++++++	+++++++++++++	+++++++++
;	0	00 Active	00
;		FE Deleted
;		FF Unused
;	1-8	File name	Blanks
;	9-11	File extension	Blanks
;	12-13	Index		0000
;	14-15	Length		Directory records
;	16-17	CRC		Don't care
;	18-31	Filler		Don't care
;
LBR.DIR:
	call	NOR.DIR		; Give main file
	ld	hl,$$LBR
	ld	(Err$$),hl	; Set error pointer
	call	fread		; Read from file
	ret	c		; .. error
	ld	hl,(RDptr)	; Get read buffer
	call	LBR.DIR?	; Verify directory entry ok
	ret	c		; .. nope
	ld	a,FALSE
	ld	(LBRprt),a	; .. no member yet
	ld	b,LBRmem-1
LBR.loop:
	ld	a,(hl)
	or	a		; Test active entry
	call	z,prLBR		; .. yeap
	ld	de,LBRlen
	add	hl,de
	djnz	LBR.loop
	ld	hl,(LBRcnt)	; Test more
	dec	hl
	ld	(LBRcnt),hl
	ld	a,l
	or	h
	jr	z,isLBRpr	; .. nope
	call	fread		; Read next from file
	ret	c		; .. error
	ld	hl,(RDptr)	; Get read buffer
	ld	b,LBRmem
	jr	LBR.loop
isLBRpr:
	ld	a,(LBRprt)	; Test any member
	or	a
	ret	nz		; .. yeap
	ld	de,$NO.MEM
	call	strcn0		; .. tell no member
	call	isMore?		; Give new line and check screen
	ret
;
; Print library member
;
prLBR:
	ld	a,TRUE
	ld	(LBRprt),a	; .. set member
	push	bc
	push	hl
	ld	e,l
	ld	d,h
	ld	a,'+'
	call	prcFN		; Give name of file
	push	de
	pop	iy
	ld	ix,$NUM32
	ld	a,(iy+3)	; Get record size
	ld	(ix+2),a	; Save size*256
	ld	a,(iy+4)
	ld	(ix+1),a
	xor	a
	ld	(ix+0),a
	ld	(ix+3),a
	ld	hl,$NUM32
	call	shr32		; Calculate by size
	call	PrSize		; Print size
	ld	de,$NO.DATE
	call	strcn0
	call	isMore?		; Give new line and check screen
	pop	hl
	pop	bc
	ret
;
; Test directory entry ^HL ok
;
LBR.DIR?
	ld	e,l		; Copy pointer
	ld	d,h
	ld	bc,LBR.err	; Set error
	push	bc
	ld	b,1
	xor	a
	call	cmpLBR		; Verify entries ok
	ret	nz		; .. nope
	ld	b,.fname+.fext
	ld	a,' '
	call	cmpLBR		; Verify entries ok
	ret	nz		; .. nope
	ld	b,2
	xor	a
	call	cmpLBR		; Verify entries ok
	ret	nz		; .. nope
	ld	c,(hl)		; Fetch directory record count
	inc	hl
	ld	b,(hl)
	ld	(LBRcnt),bc	; .. save count
	ld	hl,LBRlen
	add	hl,de		; .. point to next entry
	pop	bc
	or	a
	ret
;
; Compare Accu B-times in ^HL - Z set says ok
;
cmpLBR:
	cp	(hl)		; Compare
	ret	nz		; .. error
	inc	hl
	djnz	cmpLBR
	ret
;
; Process library file error
;
LBR.err:
	ld	de,$INV
	call	strcn0		; Tell invalid header
	ld	de,$$LBR
	call	strcn0
	ld	de,$FILE
	call	PrcErr		; .. process error
	ret
;
; Each member in file is prefixed by a header defined as follows:
;
; Byte offset	Normal member		End of file
; +++++++++++	+++++++++++++		+++++++++++
;	0	Length of header	0
;	1	Checksum for header	-------
;	2-6	'-pm0-' stored		-------
;		'-pm2-' compressed
;	7-10	Compressed file size	-------
;	11-14	Uncompressed file size	-------
;	15-16	File time (MS-DOS)	-------
;	17-18	File date (MS-DOS)	-------
;	19	Attributes (MS-DOS)	-------
;		20H Archive
;		02H Hidden
;		01H Read only
;	20	Header level (Always 0)	-------
;	21	Length of file name	-------
;	22-xx	File name.ext		-------
;	.0-.1	CRC			-------
;	.2-.x	Memo (Length-header)	-------
;	...	Compressed data		-------
;
PMA.DIR::
	call	NOR.DIR		; Give main file
	ld	hl,PMAbuf
	ld	b,PMAlen
	call	sget		; Get part of PMA file header
	ret	c		; .. error
	ld	a,(P@FLEN)	; Get length of file name
	ld	b,a
	ld	hl,(heap)	; .. and file pointer
	call	sget		; Read file name
	ret	c
	ex	de,hl
	ld	hl,P@CRC
	ld	b,2
	call	sget		; Read CRC
	ret	c
	ex	de,hl

	ret
;
; At the end of the compressed data there is an end record, sync'd
; by the hex series 50.4B.05.06. This refers to byte 0:
;
; Byte offset	Meaning
; +++++++++++	+++++++
;	0-3	Sync
;	10-11	Number of files in ZIP file
;	16-19	Offset to directory
;
; The directory consists a number of decriptors as follows:
;
; Byte offset		Meaning
; +++++++++++	+++++++++++++++++++++++++++++
;	0-3	Central file header signature
;	4-5	Program version
;	6-7	Version needed to extract
;	8-9	General purpose bitflag
;	10-11	Compression method
;	12-13	Modification time (MS-DOS)
;	14-15	Modification date (MS-DOS)
;	16-19	CRC (32 bit)
;	20-23	Compressed file size
;	24-27	Uncompressed file size
;	28-29	Length of filename
;	30-31	Extra field length
;	32-33	File comment length
;	34-35	Starting disk number
;	36-37	Internal file attributes
;	38-41	External file attributes
;	42-45	Relative offset of local header
;	46-xx	Filename (Length in offset 28-29)
;	yy-zz	Extra field (Length in offset 30-31)
;
;	....	Next descriptor
;
ZIP.DIR::
	call	NOR.DIR		; Give main file
	ret
;
; Each member in file is prefixed by a header defined as follows:
;
; Byte offset	Normal member		End of file
; +++++++++++	+++++++++++++		+++++++++++
;	0	1A			1A
;	1	1 Stored (obs.)		0
;		2 Stored
;		3 Packed
;		4 Squeezed
;		5 Crunched (obs.)
;		6 Crunched (obs.)
;		7 Crunched (obs.)
;		8 Crunched
;		9 Squashed
;	2-14	Name.ext, 00 closed	-------
;	15-18	Compressed file size	-------
;	19-20	File date (MS-DOS)	-------
;	21-22	File time (MS-DOS)	-------
;	23-24	CRC			-------
;	26-28	Uncompressed file size	-------
;	29-x	Compressed data		-------
;
ARx.DIR::
	call	NOR.DIR		; Give main file
	call	fget		; Get mark of file
	ret	c		; .. error
	cp	ARCtyp		; Verify ARC file
	jp	nz,f.err
	call	fget		; Get type of file
	ret	c		; .. error
	or	a		; Test end of file
	ret	z		; .. yeap
	ld	hl,ARxbuf
	ld	b,ARClen
	call	sget		; Get ARx file header
	ret	c		; .. error
	ret
;
; Strip off attributes from file ^HL
;
noAtt:
	push	hl
	ld	b,.fdrv+.fname+.fext
cl.att:
	res	7,(hl)		; Clear attributes
	inc	hl
	djnz	cl.att
	pop	hl
	ret
;
; Test file ^HL extension .LBR - Z set says yes
;
isLBR?:
	ld	a,0+1
	ld	de,$$LBR
	jr	is???
;
; Test file ^HL extension .PMA - Z set says yes
;
isPMA?:
	ld	a,0+1+1
	ld	de,$$PMA
	jr	is???
;
; Test file ^HL extension .ZIP - Z set says yes
;
isZIP?:
	ld	a,0+1+1+1
	ld	de,$$ZIP
	jr	is???
;
; Test file ^HL extension .ARC - Z set says yes
;
isARC?:
	ld	a,0+1+1+1+1
	ld	de,$$ARC
	jr	is???
;
; Test file ^HL extension .ARK - Z set says yes
;
isARK?:
	ld	a,0+1+1+1+1
	ld	de,$$ARK
is???:
	ld	b,.fext		; Set length
	push	hl
	pop	ix		; Get file pointer
	ex	af,af'
..is..:
	ld	a,(de)
	cp	(ix+.fdrv+.fname)
	ret	nz		; .. no match
	inc	de
	inc	ix
	djnz	..is..
	ex	af,af'
	ld	c,a		; Set index
	ret
;
; Test file ^HL extension .ARC or .ARK - Z set says yes
;
isARx?:
	call	isARC?		; Test .ARC
	call	nz,isARK?	; .. maybe .ARK
	ret
;
; Execute file ^HL indexed by reg C
;
exeFile:
	ld	a,(drv)		; Get drive
	inc	a
	ld	(hl),a		; .. set into FCB
	ld	a,c		; Get index
	ld	de,FCB
	ld	bc,.fdrv+.fname+.fext
	ldir			; Unpack into standard FCB
	ld	hl,0
	ld	(FOFFS),hl	; Init file offset
	ld	(FOFFS+2),hl
	ld	hl,$EXE
	call	indexa		; Fet address
	push	de		; .. save
	ld	de,FCB
	call	open		; Open file
	call	nc,filsiz	; .. get size on success
	ld	ix,$NUM32
	ld	(ix+0),a	; Save size*256
	ld	(ix+1),h
	ld	(ix+2),l
	ld	(ix+3),0
	ret	nc		; .. execute
	pop	de
	ld	de,$OPN.ERR
	call	PrcErr		; .. error
	ret
;
; Give name of file in ^DE and type in Accu
;
prcFN:
	call	conout		; .. print type
	ld	b,.fname
	call	..prf		; Print name
	ld	a,'.'
	call	conout		; .. delimiter
	ld	b,.fext
	call	..prf		; .. and extension
;
; Print blank on console
;
prblank:
	ld	a,' '
	call	conout		; Give final delimiter
	ret
;
; Print part of FCB in ^DE - Length in reg B
;
..prf:
	inc	de
	ld	a,(de)		; Get part
	and	NoMSB		; Less attribute
	call	conout
	djnz	..prf
	ret
;
; Print size of file or member
;
PrSize:
	ld	de,(heap)	; Get data pointer
	push	de
	push	de
	ld	b,null
	ld	hl,$NUM32
	call	dout32		; Convert number to ASCII
	pop	hl
	call	@leng		; Get length of string
	ld	a,S@L
	sub	b		; Test blanks to be printed
	ld	b,a
	ld	e,' '
	call	nz,conchd	; .. yeap
	pop	de		; Get number
	call	strcn0		; .. and print
	call	prblank		; Give final blank
	ret
;
; Process DR date and time stamp in ^IX - Return string pointer in ^DE
;
PrDR.D$T:
	ld	l,(ix+0)	; Fetch count
	ld	h,(ix+1)
	push	ix
	call	cnvday		; Convert it
	pop	iy
	ld	hl,$DATE	; Init pointer
	push	hl
	ld	a,(ix+2)	; .. YY
	call	..putbcd
	ld	a,(ix+1)	; .. MM
	call	..putbcd
	ld	a,(ix+0)	; .. DD
	call	..putbcd
	ld	a,(iy+2)	; .. HH
	call	..putbcd
	ld	a,(iy+3)	; .. MM
	call	..putbcd
	xor	a		; .. SS
	call	..putbcd
	pop	de
	ret
;
; Put BCD value in Accu to ^HL
;
..putbcd:
	call	putbcd		; .. put it
	inc	hl		; .. skip next
	ret
;
; Give header for output
;
TypeHead:
	ld	de,$HEAD
	call	strcn0		; .. print
	ld	a,(maxpag)	; Get page length
	sub	HEADln+1	; .. remember header length
	ld	(curpag),a	; .. save
	ret
;
; Give new line and check screen
;
isMore?:
	call	crlf		; Give new line
	ld	a,(curpag)	; .. count dowm
	dec	a
	ld	(curpag),a
	ret	nz
	push	de
	ld	de,$MORE
	call	strcn0		; Tell expecting key
	call	conino
	cp	'C'-'@'		; Test break
	jp	z,OS		; .. yeap
	ld	de,$NO.MORE
	call	strcn0
	call	TypeHead	; Give new header
	pop	de
	ret
;
; Set envoronment
;
setenv:
	ld	a,(FCB)		; Get drive
	dec	a
	call	m,curdrv	; .. map default
	ld	(drv),a		; .. save
	ld	hl,($memry)	; Get start of data
	call	boundary	; Get page boundary
	ld	(RDptr),hl	; .. save for buffer
	ld	(rdbuf),hl
	ld	bc,2*reclng
	add	hl,bc		; .. fix for buffer
	ld	(Fptr),hl	; .. set data pointer
	ld	c,.scbfun
	ld	de,SCB$PAG
	call	BDOS		; Get page length
	ld	(maxpag),a	; .. save
	ret
;
; Get page boundary into ^HL
;
boundary:
	inc	l
	dec	l		; Test already boundary
	ret	z		; .. yeap
	ld	l,0
	inc	h		; .. fix
	ret
;
; Fill buffer ^HL with bytes of file - Length in reg B - C set on error
;
sget:
	call	fget		; Get from file
	ret	c		; .. error
	ld	(hl),a
	inc	hl
	djnz	sget
	ret
;
; Read byte from file
;
fget:
	call	dskget		; .. get it
	jr	f.err?		; .. test error
;
; Read sequential record from file - C set on error
;
fread:
	ld	de,FCB
	call	dskred		; Read from file
f.err?:
	ret	nc		; .. no error
f.err:
	ld	de,$INV
	call	strcn0		; Tell what's invalid
	ld	de,(Err$$)
	call	strcn0
	ld	de,$FILE
;
; Process file error and give new line - C set on exit
;
PrcErr:
	call	FilErr
	call	isMore?		; Give new line and check screen
	scf			; Indicate error
	ret
;
; Process file error, message in ^DE
;
FilErr:
	call	strcn0		; Give message
	ld	de,FCB
	call	prfn		; .. and file
	ret
;
; &&& Start the utility &&&
;
_main:
	ld	sp,(TPAtop)	; Get my stack
	call	setenv		; Set environment
	ld	a,(drv)		; Get logged drive
	call	dirmax		; Get max count
	ld	c,l
	ld	b,h
	ld	hl,(Fptr)	; Get start of data
	push	hl
	ld	de,FCB
	call	files		; Read the files
	ld	(heap),de	; Save address
	pop	hl		; Get back start of data
	jr	c,NoFile	; Nothing found
	push	hl
	push	bc
	call	sort		; Sort file list
	ld	de,(RDptr)	; Get read buffer
	call	setdma		; .. set it
	pop	bc
	pop	hl
	call	TypeHead	; Give header
Mloop:
	push	bc
	push	hl
	call	noAtt		; Strip off attributes
	ld	de,FCB+.fdrv+.fname
	ld	c,0
	call	isLBR?		; Now test a bit
	call	nz,isARx?
	call	nz,isPMA?
	call	nz,isZIP?
	call	exeFile		; .. then do what you can
	pop	hl
	ld	de,.fdrv+.fname+.fext
	add	hl,de		; .. point to next
	pop	bc
	dec	bc
	ld	a,c
	or	b
	jr	nz,Mloop	; .. loop on
	jp	OS
NoFile:
	ld	de,$NO.FILE
	call	FilErr		; Process error
	jp	OS		; .. and exit

	end	_main