Category : File Managers
Archive   : KILLDIR2.ZIP
Filename : KD.PAS

 
Output of file : KD.PAS contained in archive : KILLDIR2.ZIP
{$I-} {IO checking off}
{$R-} {Range checking off}
{$S-} {Stack checking off}
{$V-} {Bounds checking off}

{The above compiler directives are off for the sake of increased
execution speed and decreased size of the executable file.}

{
-------------------------------------------------------------------

KD - Kill Directory - Version 1.5
Copyright (c) Mike Bailey 1988. All Rights Reserved.

This program may be copied and distributed freely as long as no changes
are made to the documentary file, the source code or the executable.

Mike Bailey
Madison, WI
June, 1988


If there are any comments, please address them to me on any of the
BBS here in the Madison, WI area.


This program will delete a directory, all of its subdirectories
and all files contained in those subdirectories. This is a command
line program, which takes the path and directory name to kill and
returns a query to make certain that this is what is desired. The
query is necessary since this is a powerful command that kills
the entire tree contained within the chosen directory.

Acceptable syntax is either the full path of the directory to kill
or any directory off your current directory.


-------------------------------------------------------------------
}

program KD; {Kill Directory}

Uses
Crt,
Dos;

type
Fstring = string[12]; {for FindNext results}
Fnames = string[64];

const
OffBar = $07; {normal video}
OnBar = $70; {reverse video highlight}

var
Regs : Registers;
DirList : array[1..400] of Fnames;
FilList : array[1..400] of Fnames;
F1 : file;
DInfo : SearchRec; {record for directory info}
DNdx,FNdx : word; {index for array}
DirMax,FilMax : word; {maximum directory & file numbers}
RealCurs : integer;
Ch : char; {for last query before delete starts}
Msg : FNames; {for final message when done}
OrgDir : FNames; {use for capturing log on directory}
LocX,LocY : byte; {for saving cursor position}
DirToKill : string[128]; {directory to kill}


procedure LightBar(WStr : Fnames;Attr: byte);
{ WStr = string to write to screen.
Attr = $07 if normal video
$70 if reverse video
$FF if blinking reverse video
$F0 if blinking reverse video line
Uses BIOS calls $03 : get current cursor location
$09 : write char & attribute
$02 : move cursor to new position
Column must be incremented before call to move cursor.}
var
Index : integer;
Column, Row : byte;
begin
for Index := 1 to length(WStr) do {write each character}
begin
with Regs do {use Regs set}
begin
AX := $0300; {function to save current cursor pos.}
BX := 0; {page 0}
Intr($10,Regs); {BIOS call}
Row := DX shr 8; {row return*ed in DH}
Column := (DX mod 256) + 1; {column returned in DL,inc and store}
AX := $0900 + ord(WStr[Index]);{function to write char & attribute}
BX := Attr; {BL gets attribute}
CX := $01; {do only one character}
Intr($10,Regs); {BIOS call}
AX := $0200; {function to set cursor position}
DX := Row shl 8 + Column; {DH gets row, DL gets column}
Intr($10,Regs); {BIOS call}
end;
end;
end;


procedure OrgCursor;
{ Capture the original value of the cursor upon entry.}
begin
Regs.AX := $0300; {read cursor function}
Regs.BX := $00; {assume page 0}
Intr($10,Regs); {call BIOS int 10h}
RealCurs := Regs.CX; {cursor val returned in CX}
end;


procedure Cursor;
{ Turns the cursor on using BIOS int 10h.
The cursor captured upon program initiation is used.}
begin
Regs.AX := $0100;
Regs.CX := RealCurs;
Intr($10,Regs);
end;


procedure NoCursor;
{ Turns the cursor off using BIOS int 10h.
Bit 5 of CH when high turns off the cursor.}
begin
Regs.AX := $0100;
Regs.CX := $2000; {turn off original cursor}
Intr($10,Regs);
end;


procedure DelFile(Fname : Fnames);
{ Kill the file.}
var
ChStr : string[1];
longline,careful : boolean;
x,y,z,length_count : integer;
tempctrl,skip,typeStyle : char;
Ndx : byte;
begin
for Ndx := 1 to length(Fname) do if Fname[Ndx] in ['A'..'Z'] then
ord(Fname[Ndx]) := ord(Fname[Ndx]) + 32; {make all lower case}
careful := false; { for uniformity}
if Copy(Fname,length(Fname),length(Fname)) = '.' then exit; {no '.' files}
assign(F1,Fname);
SetFAttr(F1,Archive); {if read or hidden then change}
if IOResult <> 0 then begin end; {erroneous returns on this function}
Erase(F1);
if IOResult <> 0 then
begin
Inc(DirMax); {found another directory}
DirList[DirMax] := FName; {add to list to do}
exit; {will repeat in a recursive fashion}
end;
write('Deleting File -> '); {only show message if actually did}
LightBar(Fname,OnBar); { a delete}
Writeln; {write a line}
end;


function ParsePath(Fname : Fnames) : Fnames;
{ Read the name passed and parse off the path since
this is lost with calls to FindFirst. Return the
path so it can be concated back onto the name in
the array.}
var
Ndx,NdxR : byte;
SaveF : Fnames;
begin
SaveF := Fname;
if Pos('\',Fname) = 0 then {if no directory '\'}
begin
ParsePath := ''; {there is not path to add}
exit;
end;
NdxR := 0; {start location as 0}
while Pos('\',Fname) <> 0 do {repeat until last '\'}
begin
Ndx := Pos('\',Fname); {save position in string}
Fname := Copy(Fname,Ndx + 1,Length(Fname)); {new string}
NdxR := NdxR + Ndx; {add position to total count}
end;
ParsePath := Copy(SaveF,1,NdxR) {parse off path and return}
end;


procedure KillFiles(Fname : Fnames);
{ Uses a string with wild cards to form a list of files in a directory
prior to deleting all.}
var
FileOk : boolean;
ChStr : string[1];
FPath : string[64];
MadeOne : boolean;
begin
FilMax := 0;
MadeOne := False;
FPath := ParsePath(Fname);
ChDir(Fname);
FNdx := 1; {start real info}
FindFirst('*.*',AnyFile,DInfo); {use DOS file records}
while DosError = 0 do {while more files}
begin
MadeOne := True;
FilList[FNdx] := FName + '\' + DInfo.Name;{file the array}
FindNext(DInfo); {get next file name}
Inc(FNdx); {increment array pointer}
end;
if MadeOne = False then {did not find file(s)}
begin
LowVideo;
Write(' Can not access -> '); {print scrn message}
HighVideo;
Write(Fname);
LowVideo;
end;
FilMax := FNdx - 1; {get number of files}
if FilMax > 0 then
for FNdx := 1 to FilMax do
begin
DelFile(FilList[FNdx]); {do actual file deletion}
end;
end;


procedure KillDir(Fname : Fnames);
{ Uses the name of a directory to build a tree structure of that directory
and all subdirectories of it.}
var
FileOk : boolean;
ChStr : string[1];
Path,Path1 : string[64];
MadeOne : boolean;
begin
MadeOne := False;
Path := ParsePath(Fname); {save path}
ChDir(Fname);
DirList[1] := Fname; {also do main chosen dir}
DNdx := 2; {start real info}
FindFirst('*.*',AnyFile,DInfo); {use DOS file records}
while DosError = 0 do {while more directories}
begin
MadeOne := True;
if ((DInfo.AttrAND $10 = $10) and (DInfo.Name <> '.')
and (DInfo.Name <> '..')) then {skip '.' and '..' in all dirs}
begin
DirList[DNdx] := Fname + '\' + DInfo.Name; {file the array}
Inc(DNdx); {increment array pointer}
end;
FindNext(DInfo); {get next directory}
end;
if MadeOne = False then {did not find directory}
begin
LowVideo;
Write('Can not find -> '); {print scrn message}
HighVideo;
Write(Fname);
LowVideo;
end;
DirMax := DNdx - 1; {get number of directories}
DNdx := 1;
repeat
ClrScr; {clear the screen}
KillFiles(DirList[DNdx]); {del all files in each directory}
Inc(DNdx);
until DNdx >= DirMax; {need >= if only one}
ChDir(Path); {return to Root above}
if IOResult <> 0 then {means we did not start off Root}
begin { and must delete backslash}
if Copy(Path,length(Path),1) = '\' then
Path1:= Copy(Path,1,length(Path) - 1); {delete backslash}
ChDir(Path1); {now change Path}
if IOResult <> 0 then begin end; {capture error if any}
end;
ClrScr;
HighVideo;
for DNdx := DirMax downto 1
do
begin
Write('Deleting Directory -> ');
LightBar(DirList[DNdx],OnBar);
Writeln;
RmDir(DirList[DNdx]); {now delete all directories}
if IOResult <> 0 then begin end;{do not use results}

end;
end;


function CkParm : boolean;
{ Do an initial check of the parameter to be certain it
is okay.}
var
Ndx,NdxI : byte; {for indexing}
Single : boolean; {gave only directory name, no path}
Accept : boolean; {path is okay if true}
begin
Single := False; {assume full path}
Accept := False;
if ParamCount <> 1 then {must receive only 1 command}
begin
LowVideo;
Writeln('KD - Kill Directory - June 1988 v 1.5');
Write('Usage: KD [directory]');
HighVideo;write(' ');
Halt;
end;
GetDir(0,OrgDir); {save original sign-on}
if IOResult <> 0 then
begin
Writeln('KD - Kill Directory - June 1988 v 1.5');
Write('Error in capturing current directory.');
Halt;
end;
Msg := ParamStr(1); {put Param into string}
Ndx := 1; {init both to 1}
NdxI := 1;
for Ndx := 1 to length(Msg) do Msg[Ndx] := UpCase(Msg[Ndx]);
for Ndx := 1 to length(Msg) do {do parameter string}
if (Msg[Ndx] <> ' ') then {eat all white spaces}
begin
Msg[NdxI] := Msg[Ndx]; {put into new string}
Inc(NdxI);
end;
if Msg[length(Msg)] = '.' then
begin
Writeln('KD - Kill Directory - June 1988 v 1.5');
Write('Invalid entry.');
Halt(1);
end;
if ((Msg[2] = ':') and {check for ':'}
(Msg[3] = '\') and { and '\'}
(length(Msg) > 3)) then {make sure not only a root dir}
begin
Accept := True; {allow this path}
CkParm := True; {assume eventual success}
end
else
begin
if (OrgDir[length(OrgDir)] <> '\') then
DirToKill := OrgDir + '\' + Msg
else DirToKill := OrgDir + Msg;
ChDir(DirToKill);
if IOResult = 0 then
begin
CkParm := True;
Single := True;
Accept := True;
end;
end;
if not Accept then
begin
Writeln('KD - Kill Directory - June 1988 v 1.5');
Write('Invalid entry.');
Halt;
end;
if not Single then
begin
ChDir(Msg); {try to change to request}
if IOResult <> 0 then {failed}
begin
Writeln('KD - Kill Directory - June 1988 v 1.5');
Write('Invalid entry.');
Halt(1);
end;
DirToKill := Msg; {use full path}
end;
ChDir(OrgDir); {restart at original location}
if IOResult <> 0 then
begin
Writeln('KD - Kill Directory - June 1988 v 1.5');
Write('Error in reading path. Retry.');
Halt;
end;
end;


begin

if CkParm then {if command checked out okay}
begin
LocX := WhereX;
LocY := WhereY - 1;
if LocY > 20 then LocY := 20;
Window(1,LocY,80,LocY + 5);
ClrScr;
LowVideo;
Writeln('KD - Kill Directory - June 1988 v 1.5');
HighVideo;
Write('Kill Directory ');
LightBar(DirToKill,OnBar);
Write(' (y/n)? ');
repeat Ch := ReadKey until Ch in ['n','y','N','Y'];
if ((Ch = 'n') or (Ch = 'N')) then Halt;
OrgCursor; {save original system cursor}
NoCursor; {turn off cursor}
ClrScr;
KillDir(DirToKill); {delete all files and directories}
ChDir(OrgDir);
if IOResult <> 0 then begin end; {do nothing, just capture}
Cursor; {restore system cursor}
ClrScr;
Window(1,1,80,25);
GoToXY(LocX,LocY - 1);
end;
end.


  3 Responses to “Category : File Managers
Archive   : KILLDIR2.ZIP
Filename : KD.PAS

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/