🚀 go-pugleaf

[DeskCheck Source]

[Moderator's Note:  See the mod.mac.binaries posting for a description of
DeskCheck and the binary application.  The source is presented here in
ascii form so that people with or without Macs can take a look at it.]

---
#!/bin/sh
# shar:	Shell Archiver
#	Run the following text with /bin/sh to create:
#	DeskCheck/DeskCheck.asm
#	DeskCheck/FCensus.asm
sed 's/^X//' << 'SHAR_EOF' > DeskCheck/DeskCheck.asm
X
XDebug	equ	0		; make non-zero for debugging
X
X	String_Format	0	; no string padding
X
X
X;	DeskCheck.asm: Find out whether everyone's bundle is legit.
X;	Ephraim Vishniac / P.O. Box 1357 / East Arlington, MA 02174
X;	This program is in the public domain.
X
X;
X
X	Include	Traps.D
X	Include	SysEquX.D
X	Include	FSEqu.D
X	Include	ToolEqu.D
X	Include	SysErr.D
X	Include	PackMacs.Txt
X
X;	Our Macros
X
XMACRO	DoAlert		AlertNumber =
X	IF Debug
X	_Debugger
X	ENDIF
X	; Alert (AlertNumber:INT, NIL:ProcPtr) : INT;
X	clr.w		-(sp)			; space for result
X	move.w		#{AlertNumber},-(sp)	; alert number
X	clr.l		-(sp)			; NIL filter
X	_Alert
X	move.w		(sp)+,d0		; d0 = button hit
X	cmp.w		#OKitem,d0		; standard test
X	|
X
XMACRO	DebugPoint =
X	IF Debug
X	_Debugger
X	ENDIF
X	|
X
XMACRO	UseUs =
X	move.w		OurMap(a5),CurMap	; make ours the current map
X	|
X
XMACRO	UseThem =
X	move.w		TheirMap(a5),CurMap	; make theirs the current map
X	|
X
XMACRO	SetParamText =
X	move.l	ParamZero(a5),-(sp)	; push our paramtext pointers
X	move.l	ParamOne(a5),-(sp)
X	move.l	ParamTwo(a5),-(sp)
X	move.l	ParamThree(a5),-(sp)
X	_ParamText
X	|
X
Xmacro   DNAME   Name =
X        dc.b    '{Name|0:8}'
X	.align	2
X	|
X
X
X;	Our alerts
X
XGreeting	equ	128	; say hello
XFarewell	equ	129	; say goodbye
XSetVolFailed	equ	130	; couldn't SetVol
XOpenResFailed	equ	131	; couldn't OpenResFile
XBundleBitClear	equ	132	; has bundles, but no bundle bit
XNumberOfTypes	equ	133	; bundles has unusual number of types
XNoSigResource	equ	134	; couldn't load signature resource
XNovelType	equ	135	; neither ICN#, nor FREF
XMissingBundle	equ	136	; bundle is too short
XExcessBundle	equ	137	; bundle runs too long
XFunnyIcon	equ	138	; ICN# isn't 256 bytes
XSmallFREF	equ	139	; FREF is less than six bytes
XBigFREF		equ	140	; FREF is more than 262 bytes
XMissingResource	equ	141	; can't find some bundled resource
XDoVolumeAlert	equ	142	; should we do this volume?
XNoIcons		equ	143	; no ICN# list in bundle
XNoFREFs		equ	144	; no FREF list in bundle
XBadLocalID	equ	145	; local ID unresolved
XOrphanType	equ	146	; no FREF with this file type
XOrphanCreator	equ	147	; no BNDL with matching signature
X
X
X;	Our dialogs
X
XCurrentFile	equ	150
X
X;	Other miscellaneous equates
X
XOKitem		equ	1	; Item number for OK button
XQuitItem	equ	2	; Item number for Quit button
X
X;	Our globals
X
XOurMap		ds.w	1	; a word from our sponsor
XTheirMap	ds.w	1	; equal time for the other guy
XDialogPtr	ds.l	1	; current dialog
XOtherBNDLs	ds.w	1	; 'background count' of BNDL resources
XParamZero	ds.l	1	; our param zero text pointer
XParamOne	ds.l	1	; our param one text pointer
XParamTwo	ds.l	1	; our param two text pointer
XParamThree	ds.l	1	; our param three text pointer
XFileType	ds.l	1	; File Type of current file
XFileCreator	ds.l	1	; File Creator of current file
XTypeMatch	ds.b	1	; flag for file type matched
XCreatorMatch	ds.b	1	; flag for file creator matched
X
X	XDef	FCensus
X
XDeskCheck
X;------------------------------- Init Managers ----------------------------
X
X	pea	-4(A5)			; Quickdraw's global area
X	_InitGraf			; Init Quickdraw
X	_InitFonts			; Init Font Manager
X	move.l	#$FFFF,D0		; Flush all events
X	_FlushEvents
X	_InitWindows			; Init Window Manager
X	_InitMenus			; Init Menu Manager
X	_TEInit				; Init Text Edit
X	clr.l	-(SP)			; No restart procedure
X	_InitDialogs			; Init Dialog Manager
X	_InitCursor			; Turn on arrow cursor
X
X;------------------------------- Init Globals -----------------------------
X	move.w	CurMap,OurMap(a5)	; record our resource refnum
X
X	; we need to discount bundles in our file and the system
X	clr.w	-(sp)
X	move.l	#'BNDL',-(sp)		; How many bundles?
X	_CountResources
X	move.w	(sp)+,OtherBNDLs(a5)	; save for later
X
X	clr.l	ParamZero(a5)		; clear our param text pointers
X	clr.l	ParamOne(a5)
X	clr.l	ParamTwo(a5)
X	clr.l	ParamThree(a5)
X
X;-------------------------------Desk Check---------------------------------
X;	Just do a census of all files on all volumes, running them
X;	through our bundle checker.
X
X	DoAlert	Greeting		; say hello
X	bne	SayByeBye		; if not OK, split
X	
X	DebugPoint
X
X	jsr	CheckAllVols		; else test all volumes
X	DoAlert	FareWell		; say goodbye
XSayByeBye
X	_ExitToShell
X
X
X;	CheckAllVols: Check each mounted volume
X
XCAVinfo		equ	-ioVQElSize	; a handy parm block
XVolumeName	equ	CAVinfo-256	; name of current volume
XLastLocal	set	VolumeName
X
XCheckAllVols
X	link	a6,#LastLocal
X	lea	CAVinfo(a6),a0		; a0 = parm block
X	clr.l	ioCompletion(a0)	; no completion routine
X	lea	VolumeName(a6),a1	; storage for volume name
X	move.l	a1,ioFileName(a0)	; set in parm block
X	clr.w	ioVolIndex(a0)		; clear index
X@0	lea	CAVinfo(a6),a0		; a0 = parm block
X	clr.l	VolumeName(a6)		; no volname yet
X	add.w	#1,ioVolIndex(a0)	; advance to next volume
X	_GetVolInfo
X	cmp.w	#nsvErr,d0		; out of volumes?
X	beq	@1			; exit if so
X	move.l	ioFileName(a0),ParamZero(a5)	; set param text zero
X	SetParamText
X	DoAlert	DoVolumeAlert		; should we do this one?
X	bne	@0
X	lea	CAVinfo(a6),a0		; a0 = parm block
X	jsr	CheckOneVol		; else check this volume
X	bra	@0			; and loop back
X@1	clr.l	ParamZero(a5)
X	unlk	a6
X	rts
X	DName	CHECKALLVOLS
X
X;	CheckOneVol: Survey a single volume
X;	Entry:	a0 = _GetVolInfo poop on the volume to check
X
XTheItemType	set	-2		; Dialog item type
XTheItem		set	TheItemType-4	; Dialog item handle
XTheBox		set	TheItem-8	; Dialog item box
XLastLocal	set	TheBox
X
XCheckOneVol
X	link	a6,#LastLocal
X	move.w	ioVRefNum(a0),-(sp)	; save volume reference number
X	move.l	ioFileName(a0),-(sp)	; save volume name pointer
X
X	clr.l	-(sp)			; space for result
X	move.w	#CurrentFile,-(sp)	; dialog number
X	clr.l	-(sp)			; take what we get
X	move.l	#-1,-(sp)		; put this window in front
X	_GetNewDialog			; Pop the question
X	move.l	(sp),DialogPtr(a5)	; save the dialog pointer
X	_SetPort			; make ours the current port
X	move.l	DialogPtr(a5),-(sp)
X	_DrawDialog			; force complete dialog drawing
X
X	move.l	DialogPtr(a5),-(sp)
X	move.w	#4,-(sp)		; item number 4
X	pea	TheItemType(a6)		; storage for item type
X	pea	TheItem(a6)		; storage for item handle
X	pea	TheBox(a6)		; storage for item box
X	_GetDItem
X	move.l	(sp)+,a1		; file name pointer
X	move.l	TheItem(a6),-(sp)	; item handle
X	move.l	a1,-(sp)		; point to file name
X	_SetIText			; set file name in dialog
X
X	move.l	#2,-(sp)		; root directory
X	pea	CheckOneFile		; our file inspector
X	jsr	FCensus			; scan everything
X
X	move.l	DialogPtr(a5),-(sp)	; push the dialog pointer
X	_DisposDialog			; and kill the dialog
X
X	unlk	a6
X	rts
X	DName	CHECKONEVOL
X
X;	CheckOneFile(ParamBlock:ParmBlkPtr; dirID:longint):boolean
X;	Do the actual tests on a given file.
X;	A6 offsets
XOldA6		set	0
XReturnAddr	set	OldA6+4
XDirID		set	ReturnAddr+4	; directory ID
XFileInfo	set	DirID+4		; param block from _GetFileInfo
XReturnValue	set	FileInfo+4	; return value (0 = continue)
XArgsSz		set	ReturnValue-DirID
X;
XParmBlk		set	OldA6-ioHVQElSize	; local parm block
XErrString	set	ParmBlk-32	; Str31 for error codes
XTheItemType	set	ErrString-2	; Dialog item type
XTheItem		set	TheItemType-4	; Dialog item handle
XTheBox		set	TheItem-8	; Dialog item box
XLastLocal	set	TheBox
X
XCheckOneFile
X	link	a6,#LastLocal
X	clr.w	ReturnValue(a6)		; always continue search
X	
X	move.l	DialogPtr(a5),-(sp)
X	move.w	#2,-(sp)		; item number 2
X	pea	TheItemType(a6)		; storage for item type
X	pea	TheItem(a6)		; storage for item handle
X	pea	TheBox(a6)		; storage for item box
X	_GetDItem
X	move.l	TheItem(a6),-(sp)	; item handle
X	move.l	FileInfo(a6),a1		; point to GetFileInfo stuff
X	move.l	ioFileName(a1),-(sp)	; point to file name
X	_SetIText			; set file name in dialog
X
X	; is there a resource fork?
X	move.l	FileInfo(a6),a1		; point to _GetFileInfo stuff
X	tst.l	ioFlRLgLen(a1)		; is there a resource fork?
X	beq	@9			; skip if not
X
X	lea	ParmBlk(a6),a0		; point to parm block
X	clr.l	ioCompletion(a0)
X	clr.l	ioFileName(a0)
X	move.w	ioVRefNum(a1),ioVRefNum(a0) ; volume from file info
X	move.l	DirID(a6),ioWDDirID(a0)	; directory ID from file info
X	tst	FSFCBLen		; HFS running?
X	bmi	@0			; branch if not
X	_HSetVol			; HFS, set volume and directory
X	bra	@1
X@0	_SetVol				; MFS, just set volume
X@1	move.w	ioResult(a0),d0		; did it work?
X	beq	@2			; skip if vol ok
X
X	ext.l	d0
X	lea	ErrString(a6),a0
X	move.l	a0,ParamZero(a5)	; move to param text ptrs
X	_NumToString
X	SetParamText
X	DoAlert	SetVolFailed
X	bra	@9
X
X@2	move.l	FileInfo(a6),a1		; point to _GetFileInfo stuff
X	clr.w	-(sp)			; for _OpenResFile result
X	move.l	ioFileName(a1),-(sp)	; push given file name
X	move.b	#0,ResLoad		; don't load resources
X	_OpenResFile			; give it a shot
X	move.b	#-1,ResLoad		; do load resources
X	move.w	(sp)+,d0		; pop reference number
X	bpl	@3			; skip if reasonable number
X
X	move.w	ResErr,d0		; get the error code
X	ext.l	d0
X	lea	ErrString(a6),a0
X	move.l	a0,ParamZero(a5)	; move to param text ptrs
X	_NumToString
X	SetParamText
X	UseUs				; do we need this?
X	DoAlert	OpenResFailed
X	bra	@9
X
X	; While the other file is open, we have to bracket our
X	; alerts and stuff with 'UseUs' - 'UseThem'
X
X@3	cmp.w	SysMap,d0		; did we just open the system?
X	beq	@9			; skip ahead if so
X	cmp.w	OurMap(a5),d0		; is it us?
X	beq	@9			; skip ahead if so
X	move.w	d0,TheirMap(a5)		; refnum of file under test
X
X	; Here's where we actually examine the file contents...
X
X	; Does this bozo have a bundle?
X	clr.w	-(sp)
X	move.l	#'BNDL',-(sp)		; How many bundles?
X	_CountResources
X	move.w	(sp)+,d3		; well?
X	cmp.w	OtherBNDLs(a5),d3	; discount other bundles
X	beq	@5			; skip if no more, close it up
X
X	move.l	FileInfo(a6),a1		; point to _GetFileInfo stuff
X	move.l	ioFlUsrWds+fdType(a1),FileType(a5)	; save file type
X	move.l	ioFlUsrWds+fdCreator(a1),FileCreator(a5) ; ditto creator
X	clr.b	TypeMatch(a5)		; no matches yet
X	clr.b	CreatorMatch(a5)
X
X	move.w	ioFlUsrWds+fdFlags(a1),d0 ; d0 = file flags
X	btst	#fHasBundle,d0		; test bundle bit
X	bne	@4			; skip if set, that makes sense
X
X	move.w	D3,D0
X	sub.w	OtherBNDLs(a5),D0
X	ext.l	d0
X	lea	ErrString(a6),a0
X	move.l	a0,ParamZero(a5)	; move to param text ptrs
X	_NumToString
X	SetParamText
X	UseUs
X	DoAlert	BundleBitClear
X	UseThem
X
X@4	move.w	D3,D0			; retrieve number of bundles
X	jsr	TestBundles		; else go test the bundles
X	tst.b	TypeMatch(a5)		; found FREF with our Type?
X	bne	@6			; skip if so
X
X	lea	ErrString+1(a6),a0	; fudge alignment of string
X	move.l	a0,ParamZero(a5)	; it's param text zero
X	move.b	#4,(a0)+		; set string length
X	move.l	FileType(a5),(a0)	; and string contents
X	SetParamText	
X	UseUs
X	DoAlert	OrphanType
X	UseThem
X@6	tst.b	CreatorMatch(a5)	; found BNDL with our Creator?
X	bne	@5			; skip if so
X
X	lea	ErrString+1(a6),a0	; fudge alignment of string
X	move.l	a0,ParamZero(a5)	; it's param text zero
X	move.b	#4,(a0)+		; set string length
X	move.l	FileCreator(a5),(a0)	; and string contents
X	SetParamText	
X	UseUs
X	DoAlert	OrphanCreator
X	UseThem
X
X	; Here's where we close up the file
X@5	move.w	TheirMap(a5),-(sp)	; retrieve test file refnum
X	_CloseResFile			; and close it up
X
X	move.w	CurMap,d0		; check the current map
X	cmp.w	OurMap(a5),d0		; is it us?
X	beq	@9			; skip if so, we're good
X	DebugPoint
X
X	; so much for this file.  Restore default volume
X@9	UseUs				; in case we opened the System...
X	clr.l	ParamZero(a5)		; the string storage is gone
X	unlk	a6
X	move.l	(sp)+,a0		; a0 = return address
X	lea	ArgsSz(sp),sp		; pop arguments
X	jmp	(a0)			; return
X	DName	CHECKONEFILE
X
X;	TestBundles: Test all the bundles of the current resource file
X;	d0 = number of BNDL available
X;	We only need to check ones native to the top map [TheirMap(a5)]
X
XOldA6		set	0
XReturnAddr	set	OldA6+4
X
XResIndex	set	OldA6-2		; current resource index
XBNDLHandle	set	ResIndex-4	; handle to current bundle
XLastLocal	set	BNDLHandle
X
X
XTestBundles
X	link	a6,#LastLocal
X	move.w	d0,ResIndex(a6)		; resources to check
X
X@0	clr.l	-(sp)
X	move.l	#'BNDL',-(sp)		; resource type
X	move.w	ResIndex(a6),-(sp)	; resource index
X	_GetIndResource			; get the bundle
X	move.l	(sp)+,BNDLHandle(a6)	; save handle
X	
X	; is it one that we want?
X	clr.w	-(sp)
X	move.l	BNDLHandle(a6),-(sp)	; current bundle
X	_HomeResFile
X	move.w	(sp)+,d0
X	cmp.w	TheirMap(a5),d0		; is it theirs?
X	bne	@1			; skip if not
X
X	move.l	BNDLHandle(a6),a0	; get the bundle handle
X	_HNoPurge			; make it unpurgeable
X	move.l	BNDLHandle(a6),a0	; get the bundle handle
X	_HLock				; lock it down
X
X	move.l	BNDLHandle(a6),a0	; get the bundle handle
X	jsr	TestOneBundle		; and check it out
X
X@1	sub.w	#1,ResIndex(a6)		; decrement resource index
X	bne	@0			; and try again
X
X	unlk	a6
X	rts
X	DName	TESTBUNDLES
X
X;	TestOneBundle: Examine one BNDL for validity, sanity, etc.
X;	a0 = handle to the bundle
X
XOldA6		set	0
XReturnAddr	set	OldA6+4
X
XBNDLHandle	set	OldA6-4		; handle to current bundle
XBundleIDStr	set	BNDLHandle-32	; Str31 for resource ID
XBundleSize	set	BundleIDStr-4	; size of bundle
XBundleID	set	BundleSize-2	; bundle's resource ID
XBundleType	set	BundleID-4	; bundle's resource type
XBundleName	set	BundleType-256	; bundle's resource name
XOtherString	set	BundleName-32	; for other stuff
XICNlist		set	OtherString-4	; pointer to ICN# list
XFREFlist	set	ICNlist-4	; pointer to FREF list
XLastLocal	set	FREFlist
X
XTestOneBundle
X	link	a6,#LastLocal
X	movem.l	d2-d5/a2-a4,-(sp)	; save some registers
X	clr.l	ICNlist(a6)		; clear list pointers
X	clr.l	FREFlist(a6)
X
X	move.l	a0,BNDLHandle(a6)	; store bundle handle for later
X	move.l	(a0),a4			; a4 = bundle pointer
X
X	move.l	a0,-(sp)		; push handle
X	pea	BundleID(a6)		; pointer to resource ID var
X	pea	BundleType(a6)		; pointer to resource type var
X	pea	BundleName(a6)		; pointer to resource name var
X	_GetResInfo
X
X	lea	BundleIDStr(a6),a0	; string for bundle's res ID
X	move.l	a0,ParamZero(a5)	; save for use in ParamText
X	move.w	BundleID(a6),d0		; get the resource ID
X	ext.l	d0
X	_NumToString
X	SetParamText
X
X	; Examine the bundle for size-wise sanity
X	clr.l	-(sp)
X	move.l	BNDLHandle(a6),-(sp)
X	_SizeRsrc			; how big is it?
X	move.l	(sp)+,D4		; save for later
X	move.l	D4,BundleSize(a6)	; might need original figure...
X	sub.w	#8,D4			; at least minimum length?
X	bmi	@5			; branch if not
X	move.l	(a4),D0			; D0 = signature type
X	move.w	4(a4),d1		; D1 = signature ID
X	jsr	TestSignature		; check it out!
X
X	move.w	6(a4),d3		; D3 = # types - 1
X	cmp.w	#1,D3			; usual number?
X	beq	@0			; skip if so
X	move.w	d3,d0
X	add.w	#1,d0			; actual number of types
X	lea	OtherString(a6),a0	; other string
X	move.l	a0,ParamOne(a5)
X	ext.l	d0
X	_NumToString
X	SetParamText
X	UseUs
X	DoAlert	NumberOfTypes
X	UseThem
X@0	lea	8(a4),a4		; a4 = header of first resource list
X
X@1	sub.w	#6,D4			; length of list header
X	bmi	@5			; skip out if too short
X	cmpi.l	#'ICN#',(a4)		; icons?
X	bne	@6			; skip if not, try something else
X	move.l	a4,ICNlist(a6)		; save ICN# list pointer
X	bra	@2			; and go check the list
X@6	cmpi.l	#'FREF',(a4)		; file references?
X	bne	@7			; skip if not, it's something weird
X	move.l	a4,FREFlist(a6)		; save FREF list pointer
X	bra	@2			; and go check the list
X@7	lea	OtherString(a6),a0	; point to other string
X	move.w	#4,(a0)
X	move.l	(a4),2(a0)		; fill in resource type
X	lea	1(a0),a0		; use odd-aligned string
X	move.l	a0,ParamOne(a5)
X	SetParamText
X	UseUs
X	DoAlert	NovelType
X	UseThem
X@2	move.w	4(a4),d2		; resources - 1 of this type
X	lea	6(a4),a3		; a3 = start of resource list
X@3	sub.w	#4,d4			; size of list item
X	bmi	@5			; skip out if too short
X	move.l	(a4),D0			; resource type
X	move.w	2(a3),D1		; resource ID
X	jsr	TestOneResource		; test it!
X	lea	4(a3),a3		; next item in list
X	dbra	d2,@3			; collect them all
X	move.l	a3,a4			; next list
X	dbra	d3,@1			; collect all of those, too
X	tst.w	d4			; All used up?
X	beq	@4			; skip if so, that's just right
X	; The bundle runs on longer than expected
X	UseUs
X	DoAlert	ExcessBundle
X	UseThem
X@4	move.l	ICNlist(a6),a0		; pick up ICN# and FREF pointers
X	move.l	FREFlist(a6),a1
X	jsr	TestLocalIDs
X
X	clr.l	ParamZero(a5)
X	clr.l	ParamOne(a5)
X	movem.l	(sp)+,d2-d5/a2-a4	; restore some registers
X	unlk	a6
X	rts
X	DName	TESTONEBUNDLE
X
X@5	UseUs
X	DoAlert	MissingBundle
X	UseThem
X	bra	@4
X
X
X;	TestSignature: Does the 'signature' resource exist?
X;	D0 = resource type
X;	D1.w = resource ID
X
XOldA6		set	0
XReturnAddr	set	OldA6+4
X
XSigType		set	OldA6-4		; type of signature resource
XTypeStr		set	SigType-1	; for type string
XFillerOne	set	TypeStr-1	; restore alignment
XSigID		set	FillerOne-2	; resource ID for signature
XIDString	set	SigID-32	; Str31 for resource ID
X
XLastLocal	set	IDString
X
XTestSignature
X	link	a6,#LastLocal
X	move.l	d0,SigType(a6)		; save signature's resource type
X	move.w	d1,SigID(a6)		; save resource ID
X	cmp.l	FileCreator(a5),d0	; FREF matches creator?
X	seq	d0
X	or.b	d0,CreatorMatch(a5)	; set match flag if so
X
X	clr.l	-(sp)
X	move.l	SigType(a6),-(sp)	; resource type
X	move.w	SigID(a6),-(sp)		; resource ID
X	_GetResource			; Fetch!
X	move.l	(sp)+,d0		; pop the handle
X	beq	@2			; problem if NIL
X	tst.w	ResErr			; something wrong?
X	bne	@2			; skip if so
X	clr.w	-(sp)			; check home file of resource
X	move.l	d0,-(sp)
X	_HomeResFile
X	move.w	(sp)+,d0		; pop res file reference
X	cmp.w	TheirMap(a5),d0		; right file?
X	beq	@0			; branch if so, it's good
X
X@2	move.b	#4,TypeStr(a6)		; set resource type string
X	lea	TypeStr(a6),a0
X	move.l	a0,ParamOne(a5)
X	SetParamText
X
X	move.w	SigID(a6),d0		; d0 = signature's res ID
X	ext.l	d0
X	lea	IDString(a6),a0
X	move.l	a0,ParamTwo(a5)
X	_NumToString
X	SetParamText
X
X	UseUs
X	DoAlert	NoSigResource
X	UseThem
X
X@0	clr.l	ParamOne(a5)
X	clr.l	ParamTwo(a5)
X	unlk	a6
X	rts
X	DName	TESTSIGNATURE
X
X;	TestOneResource: Do a sanity check on one resource.
X;		For all kinds, be sure it exists.
X;		For ICN# and FREF, do some other stuff
X;	D0 = resource type
X;	D1.W = resource ID
X
XOldA6		set	0
XReturnAddr	set	OldA6+4
X
XResHandle	set	OldA6-4		; handle to current resource
XResType		set	ResHandle-4	; resource type
XResTypeStr	set	ResType-1	; for using above as string
XFillerOne	set	ResTypeStr-1	; restore alignment
XResID		set	FillerOne-2	; resource ID
XResIDStr	set	ResID-32	; Str31 for resource ID
XResSize		set	ResIDStr-4	; size of resource
XSizeString	set	ResSize-32	; Str31 for resource size
XLastLocal	set	SizeString
X
XTestOneResource
X	link	a6,#LastLocal
X	movem.l	d2-d5/a2-a4,-(sp)	; save some registers
X
X	move.l	d0,ResType(a6)
X	move.w	d1,ResID(a6)
X
X	move.b	#4,ResTypeStr(a6)	; build type string
X	lea	ResTypeStr(a6),a0
X	move.l	a0,ParamOne(a5)		; set indirect pointer
X
X	move.w	ResID(a6),d0		; resource ID
X	lea	ResIDStr(a6),a0		; ID string
X	move.l	a0,ParamTwo(a5)
X	ext.l	d0
X	_NumToString
X	SetParamText
X
X	clr.l	-(sp)
X	move.l	ResType(a6),-(sp)	; resource type
X	move.w	ResID(a6),-(sp)		; resource ID
X	_GetResource			; Fetch!
X	move.l	(sp)+,ResHandle(a6)	; save the handle
X	tst.l	ResHandle(a6)		; NIL handle?
X	beq	@4			; error if so, resource is missing
X	tst.w	ResErr			; something wrong?
X	bne	@4			; skip if so
X	clr.w	-(sp)			; else check home resource file
X	move.l	ResHandle(a6),-(sp)
X	_HomeResFile
X	move.w	(sp)+,d0		; pop res file ref
X	cmp.w	TheirMap(a5),d0		; right file?
X	beq	@0			; branch if so, we'll take it
X
X@4	UseUs
X	DoAlert	MissingResource
X	UseThem
X	bra	@9
X@0	clr.l	-(sp)
X	move.l	ResHandle(a6),-(sp)
X	_SizeRsrc			; How big is this sucker?
X	move.l	(sp)+,ResSize(a6)	; save for later testing
X
X	move.l	ResSize(a6),d0		; set up length string
X	lea	SizeString(a6),a0
X	move.l	a0,ParamThree(a5)
X	_NumToString
X	SetParamText
X
X	move.l	ResType(a6),d0		; d0 = resource type
X	cmpi.l	#'ICN#',d0		; Icon list?
X	bne	@2			; skip if not
X	
X	move.l	ResSize(a6),d0		; check resource size
X	cmp.l	#256,d0			; must be 256 bytes
X	beq	@9			; exit if so, it's good
X	UseUs
X	DoAlert	FunnyIcon
X	UseThem
X	bra	@9
X@2	cmpi.l	#'FREF',d0		; FREF?
X	bne	@9			; exit if not, we don't care
X	move.l	ResSize(a6),d0		; check resource size
X	cmpi.l	#6,d0			; reasonable size?
X	bcc	@3			; branch if minimum or more
X	UseUs
X	DoAlert	SmallFREF		; the FREF is too small
X	UseThem
X	bra	@9
X@3	cmpi.l	#263,d0			; not too big?
X	bcs	@9			; branch if in bounds
X	UseUs
X	DoAlert	BigFREF
X	UseThem
X
X@9	clr.l	ParamOne(a5)
X	clr.l	ParamTwo(a5)
X	clr.l	ParamThree(a5)
X	movem.l	(sp)+,d2-d5/a2-a4	; restore some registers
X	unlk	a6
X	rts
X	DName	TESTONERESOURCE
X
X;	TestLocalIDs: See if the local IDs referred to by the FREFs are
X;			resolved in the ICN# list.
X;	a0 = ptr to ICN# list from bundle
X;	a1 = ptr to FREF list from bundle
X
XFREFIDStr	set	-32		; Str31 for FREF ID #
XLocalIDStr	set	FREFIDStr-32	; Str31 for local ID #
XFREFHandle	set	LocalIDStr-4	; handle of current FREF
XLastLocal	set	FREFHandle
X
XTestLocalIDs
X	link	a6,#LastLocal		; some local storage
X	movem.l	a2-a4/d2-d4,-(sp)	; save some regs
X	
X	move.l	a0,d0			; is there an ICN# list?
X	bne	@0			; skip if so
X	UseUs
X	DoAlert	NoIcons
X	UseThem
X	bra	@9
X@0	move.l	a1,d0			; is there an FREF list?
X	bne	@1			; skip if so
X	UseUs
X	DoAlert	NoFREFs
X	UseThem
X	bra	@9
X@1	move.l	a0,a4			; a4 = ICN# list pointer
X	move.w	4(a1),d4		; d4 = # FREFs - 1
X	lea	6(a1),a3		; a3 = first FREF item
X@2	clr.l	-(sp)
X	move.l	#'FREF',-(sp)
X	move.w	2(a3),-(sp)
X	_GetResource			; get the FREF
X	move.l	(sp)+,d0		; pop the handle
X	beq	@5			; skip if NIL handle
X	tst.w	ResErr
X	bne	@5			; skip if resource error
X	move.l	d0,FREFHandle(a6)	; save FREF handle
X	clr.w	-(sp)			; check home res file
X	move.l	d0,-(sp)
X	_HomeResFile
X	move.w	(sp)+,d0		; pop home res file
X	cmp.w	TheirMap(a5),d0		; from a good home?
X	bne	@5			; exit if not
X
X	move.l	FREFHandle(a6),a0	; a0 = FREF handle
X	move.l	(a0),a0			; a0 = FREF pointer
X
X	move.l	(a0),d0			; d0 = file type from FREF
X	cmp.l	FileType(a5),d0		; match our file type?
X	seq	d0
X	or.b	d0,TypeMatch(a5)	; set type match flag if so
X
X	move.w	4(a0),d0		; d0 = local ID from FREF
X	move.w	4(a4),d3		; d3 = # ICN#s - 1
X	lea	6(a4),a2		; a2 = first ICN# item
X@3	cmp.w	(a2),d0			; local IDs match?
X	beq	@5			; skip if so, test next FREF
X	lea	4(a2),a2		; else move to next ICN# item
X	dbra	d3,@3			; search through ICN# list
X
X	; If we fall out, we have an unsatisfied local ID in d0
X
X	ext.l	d0
X	lea	LocalIDStr(a6),a0	; string for local resource ID
X	move.l	a0,ParamTwo(a5)
X	_NumToString
X	move.w	2(a3),d0		; FREF resource ID
X	ext.l	d0
X	lea	FREFIDStr(a6),a0	; string for FREF resource ID
X	move.l	a0,ParamOne(a5)
X	_NumToString
X	SetParamText
X	UseUs
X	DoAlert	BadLocalID
X	UseThem
X	clr.l	ParamOne(a5)
X	clr.l	ParamTwo(a5)
X@5	lea	4(a3),a3		; next FREF item in list
X	dbra	d4,@2			; test entire FREF list
X@9	movem.l	(sp)+,a2-a4/d2-d4	; restore registers
X	unlk	a6
X	rts
X	DName	TESTLOCALIDS
X
SHAR_EOF
sed 's/^X//' << 'SHAR_EOF' > DeskCheck/FCensus.asm
X
X;	FCensus: HFS/MSF file census routine from Feb '86 MacTutor
X;	Provides info on each file on a volume, whether MFS or HFS.
X
X;	Proc FCensus(vRefNum:integer; DirID:longint; Inspector:ProcPtr);
X
X;	vRefNum: volume reference number (or drive number) of volume
X
X;	dirID: ID of directory to start.  Root dir = 2.
X
X;	Inspector: user-supplied function
X;		MyInspector(ParamBlock:ParmBlkPtr; dirID:longint):boolean
X;		ParamBlock is a GetFileInfo block
X;		dirID is the ID of the file's directory
X;		If returned value = True, search ends.
X;		If returned value = False, search continues.
X
X	Include	Traps.D
X	Include	SysEquX.D
X	Include	FSEqu.D
X	Include	SysErr.D
X		
X		.MACRO _TFSCORE
X		IF '%1' <> ''
X		LEA    %1,A0
X		ENDIF
X		IF '%3' = ''
X		DC.W   $A200+%2
X		ENDIF
X		IF '%3' = 'REGS'
X		DC.W   $A300+%2
X		ENDIF
X		IF '%3' = 'ASYNC'
X		DC.W   $A600+%2
X		ENDIF
X		IF '%3' = 'SYS'
X		DC.W   $A600+%2
X		ENDIF
X		IF '%3' = 'IMMED'
X		DC.W   $A200+%2
X		ENDIF
X		.ENDM
X
X
X		.MACRO _GetCatInfo 
X		MOVEQ		#9,D0
X		_TFSCore	%1,96,%2
X		.ENDM
X
X
X;	A6 offsets
XOldA6		set	0
XReturnAddr	set	OldA6+4
XInspec		set	ReturnAddr+4
XDirID		set	Inspec+4
XvRefNum		set	DirID+4
XArgsSz		set	vRefNum+2-Inspec
X;
XParmBlk		set	OldA6-ioHVQElSize	; local parm block
XNameStr		set	ParmBlk-256		; Str255 buffer
XIndex		set	NameStr-2		; directory index
X
X	XRef	FCensus
X
XFCensus
X	Link	a6,#Index
X	clr.l	-(sp)			; sentinel for end of DirID list
XNextDir
X	clr	Index(a6)		; init index = 0
XNextFile
X	lea	ParmBlk(a6),a0		; a0 = parm block pointer
X	clr.l	ioCompletion(a0)
X	clr.l	ioFileName(a0)
X	move	vRefNum(a6),ioVRefNum(a0)	; set volume
X	move.l	dirID(a6),ioDirID(a0)	; set directory ID
X	lea	NameStr(a6),a1		; a1 = name string buffer pointer
X	move.l	a1,ioFileName(a0)	; set file name pointer
X	addq	#1,Index(a6)		; advance index
X	move	Index(a6),ioFDirIndex(a0)	; set index
X	tst	FSFCBLen		; HFS running?
X	bmi.s	@0			; branch if not
X	_GetCatInfo
X	bra.s	@1
X@0	_GetFileInfo			; MFS, get partial story
X@1	beq.s	NodeKind		; no error, check things out
X	cmp	#fnfErr,d0		; end of directory?
X	bne.s	FCExit			; no, unexpected problem
X	move.l	(sp)+,dirID(a6)		; pop next directory off stack
X	bne.s	NextDir			; branch if there is one
X	bra.s	FCExit			; branch if there isn't one
XNodeKind
X	btst	#ioDirFlg,ioFlAttrib(a0)	; directory?
X	beq.s	CallInspec		; a file, call Inspector
X	move.l	ioDirID(a0),-(sp)	; directory, push on stack
X	bra.s	NextFile		; look for next file
XCallInspec
X	clr	-(sp)			; for returned value
X	pea	ParmBlk(a6)		; param block for inspector
X	move.l	dirID(a6),-(sp)		; pass dirID
X	move.l	Inspec(a6),a0		; address of user function
X	jsr	(a0)			; call inspector
X	tst.b	(sp)+			; time to quit?
X	beq.s	NextFile		; no, keep going
XFCExit
X	unlk	a6
X	move.l	(sp)+,a0		; a0 = return address
X	lea	ArgsSz(sp),sp		; pop arguments
X	jmp	(a0)			; return
X	dc.b	'FCensus'
X	.align	2
SHAR_EOF
exit
---