{ memory allocation }
{$F-,I-,R-,S-,V-,M 6,1,2,15}

{ Units used by the program }
USES
	AmigaDOS, DOS, Exec, Amiga;
	
CONST
	RD_Array : Array[0..3] of LongInt = (0);
	OPT_FILE                          = 0;
	OPT_ALL                           = 1;
	OPT_QUIET                         = 2;
	OPT_FORCE                         = 3;
	
VAR
	s: STRING;
	err : LONG;
	
{ V39 Dos function }
function SetOwner(name : STRPTR; owner_info: longint): Long; Forward;

function SetOwner; xassembler;
asm
	move.l	a6,-(sp)
	lea		8(sp),a6
	move.l	(a6)+,d2
	move.l	(a6)+,d1
	move.l	DOSBase,a6
	jsr		-$3E4(a6)
	move.l	d0,$10(sp)
	move.l	(sp)+,a6
end;

{ DeleteFile() - Delete a file                           }
{ "filename" - STRPTR to the name of the file to delete. }
{ "dir" - Lock on the directory that the file is within. }
{ "Size" - Size of the file.                             } 
Procedure DeleteFile(filename : STRPTR; dir : BPTR; Size : LONG);

VAR
	oldcd, f, l       : BPTR;
	OK                : Boolean;
	ch, pos, n        : LONG;
	comm, newname, nn : String;
	ch1, ch2, ch3     : Char;
	ds                : tDateStamp;
	oldname           : STRPTR;
	
begin
	Comm := 'This file has been "Erased" (LSK)'#0;
	oldcd := CurrentDir(dir);
	s := FExpand(PtrToPas(filename));
	s := 'File : "'+PtrToPas(filename)+'" Expanded : "'+s+'" - '#0;
	err := PutStr(@s[1]);
	{Write('-File-> "',PtrToPas(filename),'" (Size : ',Size,')');}
			
	f := Open(filename, MODE_NEWFILE);
	if f <> NULL then begin
		{ position at start of file, JTBS }
		pos := Seek_(f, 0, OFFSET_BEGINING);
		For n := 1 to Size do begin
			{ fill file with nothing!!! }
			ch := FPutC(f, 0); 
		end;
		
		{ set file size to 0 }
		n := SetFileSize(f, 0, OFFSET_BEGINING);
		
		{ close file }
		OK := Close_(f);

		{ Set file attributes to defaults }
		OK := SetProtection(filename,0);
		
		{ Set comment }
		OK := SetComment(filename, @comm[1]);
		
		{ set file date }
		ds.ds_days := 0;
		ds.ds_Minute := 0;
		ds.ds_Tick := 0;
		OK := SetFileDate(filename, @ds);
		
		{ set files user/owner information to 0 }
		If pLibrary(DOSBase)^.lib_Version >= 37 then
			OK := Boolean(SetOwner(filename,0));
		
		{ rename file }
		newname := 'Erased';
		nn := newname+#0;
		l := Lock(@nn[1], ACCESS_READ);
		ch1 := 'L';
		ch2 := 'S';
		ch3 := 'K';
		while l <> NULL do begin
			UnLock(l);
			nn := newname + ch1 + ch2 + ch3 + #0;
			l := Lock(@nn[1], ACCESS_READ);
			inc(ch1);
			inc(ch2);
			inc(ch3);
		End;
		UnLock(l);
		if Rename_(filename, @nn[1]) then begin
			oldname := filename;
			filename := @nn[1];
		end else
			oldname := filename;

			
		{ delete file }
		If ((AmigaDos.DeleteFile(filename)) and (RD_Array[OPT_QUIET] = 0)) then begin
			s := PtrToPas(OldName)+'  Erased'#10#0;
			err := PutStr(@s[1]);
		end;
			
	End;
	If IoErr <> 0 then begin
		s := '***** DeleteFile() : '+PtrToPas(filename)+#0;
		filename := @s[1]; 
		OK := PrintFault(IoErr, filename);
	End;
	n := SetIoErr(0);

	oldcd := CurrentDir(oldcd);
End;

{ DeleteDir() - Delete a directory                        }
{ "dirname" - STRPTR to the name of the drawer to delete. }
{ NB. this procedure recurses.                            }
Procedure DeleteDir(dirname : STRPTR; pdir : BPTR);
VAR
	oldcd,ocd,l,l2 : BPTR;
	fib     : pFileInfoBlock;
	OK      : Boolean;
	ret, fn : LONG;
	
begin
	ocd := CurrentDir(pdir);
	fn := 0;
	if RD_Array[OPT_ALL] = 0 then 
		OK := AmigaDos.DeleteFile(dirname)
	else begin
		l := Lock(dirname, ACCESS_READ);
		if l <> NULL then begin
			oldcd := CurrentDir(l);

			fib := AllocDosObject(DOS_FIB, NIL);
			if fib <> NIL then begin
				OK := Examine(l, fib);
				While OK do begin
					inc(fn);
					begin
						{err := PutStr(@fib^.fib_FileName);}
						
												
						if fib^.fib_DirEntryType > 0 then begin
							l2 := Lock(@fib^.fib_FileName, ACCESS_READ);
							If (SameLock(l,l2) = LOCK_SAME_VOLUME) then begin
								DeleteDir(@fib^.fib_FileName, l);
							End;
							UnLock(l2);
						End;
						
						if fib^.fib_DirEntryType < 0 then begin
							DeleteFile(@fib^.fib_FileName, l, fib^.fib_Size);
						end;
						
						OK := ExNext(l, fib);
						ret := CheckSignal(SIGBREAKF_CTRL_C);
						if ret and SIGBREAKF_CTRL_C <> 0 then begin
							Writeln('breeeek');
							OK := False;
						end;
					end;
				End;
				FreeDosObject(DOS_FIB, fib);
			End;
			oldcd := CurrentDir(oldcd);
			UnLock(l);
			if (AmigaDos.DeleteFile(dirname)) and (RD_Array[OPT_QUIET] = 0) then begin
				s := PtrToPas(dirName)+'  Erased (DelDir)'#10#0;
				err := PutStr(@s[1]);
			end;
		End;
	End;
	If IoErr <> ERROR_NO_MORE_ENTRIES then
		ret := SetIoErr(0);
	If IoErr <> 0 then begin
		s := '***** DeleteDir() : '+PtrToPas(dirname)+#0;
		dirname := @s[1]; 
		OK := PrintFault(IoErr, dirname);
	end;
	ret := SetIoErr(0);
	ocd := CurrentDir(ocd);

End;

Procedure Main;

TYPE
	pSTRPTR  = ^STRPTR;
	
VAR
	OK       : Boolean;
	RDArg    : pRDArgs;
	Template,
	Version  : String;
	ret      : LONG;
	ap       : pAnchorPath;
	strn        : STRPTR;
	oldcd , l2   : BPTR;
	
CONST
	rc       : Byte = 0;
	
begin
	writeln('Erase 1.3');
	Version  := '$VER: Erase 36.1 (08.09.94)'#0;
	Template := 'FILE/M/A,ALL/S,QUIET/S,FORCE/S'#0;
	If pLibrary(DOSBase)^.lib_Version >= 36 then begin
		RDArg := ReadArgs(@Template[1],@RD_Array,NIL);
		if RDArg <> NIL then begin
			strn := pSTRPTR(RD_Array[OPT_FILE])^;
			While strn^ <> 0 do begin
				ap := AllocVec(Sizeof(tAnchorPath), MEMF_CLEAR);
				if ap <> NIL then begin
					ap^.ap_BreakBits := SIGBREAKF_CTRL_C;
					ret := MatchFirst(strn, ap);
					While ret = 0 do begin
					
						if ap^.ap_Info.fib_DirEntryType > 0 then begin
							s := '---* From Main Loop (d)'#10#0;
							err := PutStr(@s[1]);
							l2 := Lock(@ap^.ap_Info.fib_FileName, ACCESS_READ);
							If (SameLock(ap^.ap_Current^.an_Lock,l2) = LOCK_SAME_VOLUME) then begin
								DeleteDir(@ap^.ap_Info.fib_FileName, ap^.ap_Current^.an_Lock);
							End;
							UnLock(l2);
							s := '---* From Main Loop returned (d)'#10#0;
							err := PutStr(@s[1]);
						end;
						
						if ap^.ap_Info.fib_DirEntryType < 0 then begin
							s := '---* From Main Loop'#10#0;
							err := PutStr(@s[1]);

							DeleteFile(@ap^.ap_Info.fib_FileName, ap^.ap_Current^.an_Lock, ap^.ap_Info.fib_Size);
							s := '---* From Main Loop returned'#10#0;
							err := PutStr(@s[1]);
						End;
						
						ret := MatchNext(ap);
					end;
					MatchEnd(ap);
					if ret <> ERROR_NO_MORE_ENTRIES then
						ret := SetIoErr(ret)
					else
						ret := SetIoErr(0);
					FreeVec(ap);
				end;
				strn := STRPTR(LONG(strn)+Length(PtrToPas(strn))+1);
			End;
			FreeArgs(RDArg);
		End;
		If IoErr <> 0 then
			OK := PrintFault(IoErr, NIL);
	End Else ret := SetIoErr(ERROR_INVALID_RESIDENT_LIBRARY);
End;

{----------------------------------------------------------------------------}

begin
main;
end.

{----------------------------------------------------------------------------}