{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *  NUKE.PAS by Shane Kerr                                               *
 *        Deletes a subdirectory and everything it contains.             *
 *        Nuke for DOS written Turbo Pascal 5.5                          *
 *        Nuke for Windows written using Turbo Pascal for Windows 1.0    *
 *  Version 1.95    November 23, 1991                                    *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

program Nuke;

uses
{$IFDEF MsDos}
	DOS;
{$ENDIF}
{$IFDEF Windows}
    WinCRT, WinDOS, Strings;
{$ENDIF}

const
    MajorVer = '1';                     { Current major version number }
    MinorVer = '95';                    { Current minor version number }
    Year     = 1991;                    { Release year }

{$IFDEF MsDos}
    fsDirectory = 64;                   { Set directory length }
    faReadOnly = ReadOnly;              { Set directory flags }
    faHidden = Hidden;
    faSysFile = SysFile;
    faVolumeID = VolumeID;
    faDirectory = Directory;
    faArchive = Archive;
    faAnyFile = AnyFile;
{$ENDIF}

{$IFDEF MsDos}
type
	TRegisters = Registers;				{ Used for DOS calls }
    TSearchRec = SearchRec;             { Used for search record }
{$ENDIF}

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *  procedure FCBDeleteFile (FileSpec : string);
 *        Deletes files using the MS-DOS FCB function (from Version 1.0).
 *  parameters:  filespec, file(s) to be deleted
 *  notes:  Can only delete files in the current directory.
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

procedure FCBDeleteFile (filespec : string);
type
    TFCB = record
        drive : char;  	                { 0 = default, 1 = A, 2 = B }
        name : array[0..7] of char;     { File name }
        ext : array[0..2] of char;      { File extension }
        curblk : word;                  { Current block number }
        recsize : word;                 { Logical record size in bytes }
        filsize : longint;              { File size in bytes }
        date : word;                    { Date file was last written }
        resv : array[0..10] of byte;    { Reserved for DOS }
        currec : byte;                  { Current record in block }
        random : longint;               { Random record number }
    end;
var
    FCB : TFCB;
    Regs : TRegisters;
    TempStr : string;
    NameSeg, NameOfs : word;
    FCBSeg, FCBOfs : word;
begin
  { Get segment and offset of the filespec }
    TempStr := filespec + chr(0);
    NameSeg := seg(TempStr);
    NameOfs := ofs(TempStr) + 1;
    FCBSeg := seg(FCB);
    FCBOfs := ofs(FCB);
  { Do the actual DOS calls }
    Regs.AX := $2900;
    Regs.DS := NameSeg;
    Regs.SI := NameOfs;
    Regs.ES := FCBSeg;
    Regs.DI := FCBOfs;
    MsDos(Regs);                        { Parse file to FCB }
    Regs.DS := FCBSeg;
    Regs.DX := FCBOfs;
    Regs.AH := $13;
    MsDos(Regs);                        { Delete file (FCB) }
end; { FCBDeleteFile }

{$IFDEF MsDos}
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *  procedure ClearKb
 *        Clears the keyboard buffer
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

procedure ClearKb;
var
    Regs : TRegisters;
begin
    Regs.AH := $01;
    Intr($16, Regs);
    while ((Regs.Flags and FZero) = 0) do
      begin
        Regs.AH := $00;
        Intr($16, Regs);
        Regs.AH := $01;
        Intr($16, Regs);
      end;
end; { procedure ClearKb }
{$ENDIF}

{$IFDEF MsDos}
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *  procedure WaitKey
 *        Waits for a key press
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

procedure WaitKey;
var
    Regs : TRegisters;
begin
	Regs.AH := $00;
    Intr($16, Regs);
end; { procedure WaitKey }
{$ENDIF}

{$IFDEF MsDos}
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *  function IsRedirected : boolean;
 *        Determines whether a program's input or output is redirected
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

function IsRedirected : boolean;
var
	Regs : Registers;				{ Register values }
	StdIn : ^Byte;					{ Standard input }
	StdOut : ^Byte;					{ Standard output }
begin
	Regs.AH := $62;					{ Get segment address of PSP }
	MsDos(Regs);
	StdIn := Ptr(Regs.BX, $18);		{ Point to StdIn value }
	StdOut := Ptr(Regs.BX, $19); 	{ Point to StdOut value }

  { Return TRUE if StdIn is the same as StdOut }
    IsRedirected := (StdIn^ <> StdOut^);
end;
{$ENDIF}

{$IFDEF MsDos}
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *  function NumRows : byte;
 *        Returns the number of rows on the screen
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

function NumRows : byte;
var
	ScreenWidth : word absolute $0040:$004A;
	ScreenSize : word absolute $0040:$004C;
begin
	NumRows := (((ScreenSize div 1000) * 1000) div 2) div ScreenWidth;
end;
{$ENDIF}

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *  function NukeDir (directory : string) : boolean;                     *
 *  	Destroys the specified directory and all it contains recursively *
 *  parameters:  directory, path of the directory to be destroyed        *
 *               remove, TRUE to remove directory                        *
 *				 display, TRUE to display files as they are deleted      *
 *				 pause, TRUE to pause after each screen                  *
 *               attr, file search attributes to delete                  *
 *				 lines, number of lines displayed so far 			     *
 *  returns:  TRUE if directory is removed, FALSE otherwise              *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function NukeDir (directory : string; remove, display, pause : boolean;
					attrib : word; var lines : word) : boolean;
var
    OrgDir : string[fsDirectory];       { Saved original directory }
	SrchRec : TSearchRec;	        	{ For file searches }
    Dummy : boolean;
    Handle : file;                      { File handle (for attrib change) }
begin
	GetDir(0, OrgDir);   	        	{ Get original directory }

	ChDir(directory);                   { Change to target directory }
  { If display isn't on, just delete everything (grumble) }
	if (not display) then
		FCBDeleteFile('????????.???');  { Delete all files }

  { Find first file present }
    FindFirst('*.*', faDirectory or attrib, SrchRec);

  { Loop and nuke any subdirectories found }
    repeat
        if (((SrchRec.Attr and faDirectory) <> 0) and (DosError = 0) and
{$IFDEF MsDos}
                    (SrchRec.Name[1] <> '.')) then
{$ENDIF}
{$IFDEF Windows}
                    (SrchRec.Name[0] <> '.')) then
{$ENDIF}
          begin
            Assign(Handle, SrchRec.Name);
            SetFAttr(Handle, faDirectory);
			Dummy := NukeDir(SrchRec.Name, TRUE, Display, Pause, Attrib, Lines);
          end
        else if ((DosError = 0) and
{$IFDEF MsDos}
					(SrchRec.Name[1] <> '.') and
{$ENDIF}
{$IFDEF Windows}
					(SrchRec.Name[0] <> '.') and
{$ENDIF}
			(((SrchRec.Attr and Attrib) <> 0) or (Attrib = 0))) then
          begin
            Assign(Handle, SrchRec.Name);
            SetFAttr(Handle, 0);
			Erase(Handle);
		  { If displaying, then show name and increase line count }
			if (Display) then
			  begin
				WriteLn('     Deleting  ', Directory, '\', SrchRec.Name);
				Inc(Lines);
			  end;
		  { If pausing, check line count }
			if (Pause and ((Lines mod (NumRows - 2)) = 0)) then
			  begin
				Write('Press any key to continue...');
				WaitKey;
				WriteLn;
			  end;
          end; { if block }
        FindNext(SrchRec);
    until (DosError <> 0);

  { If original directory is current, change to parent }
	if (OrgDir = Directory) then
		ChDir('..')
	else if (pos(Directory, OrgDir) = 1) then
	  begin
		ChDir(Directory);
		ChDir('..');
	  end
	else
		ChDir(OrgDir);                  { Restore directory }
    NukeDir := FALSE;
    if (Remove) then
      begin
        {$I-}
		RmDir(Directory);	        	{ Kill target directory }
        if (IOResult = 0) then
            NukeDir := TRUE;
        {$I+}
      end;
end; { function NukeDir }

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *  function ToUpper (Str : string) : string;                            *
 *      Convert string to upper case                                     *
 *  parameters:  Str, any string                                         *
 *  returns:  uppercase value of the string                              *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

function ToUpper (Str : string) : string;
var
    i : integer;
    Temp : string;
begin
    Temp := str;
    for i := 1 to length(Str) do
        Temp[i] := UpCase(Temp[i]);
    ToUpper := Temp;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *  function ListFiles (directory : string) : integer                    *
 *      Lists files and attributes in the specified directory below      *
 *  parameters:  directory, directory to start listing at                *
 *  returns:  number of files listed                                     *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

function ListFiles (directory : string) : integer;
var
    OrgDir : string;	                { Original directory }
    CurDir : string;                    { Current directory }
    SearchRec : TSearchRec;             { Used to find filespecs }
    NumListed : Integer;                { Number of files listed }
    Attr: word;                         { Attributes to remove }
begin
    NumListed := 0;                     { Number of files listed }
	GetDir(0, OrgDir);	        		{ Get original directory }

    ChDir(directory);                   { Change to target directory }
	GetDir(0, CurDir);					{ Get current directory }

  { Find first directory present }
    FindFirst('*.*', faDirectory or faReadOnly or faHidden or faSysFile,
        SearchRec);
    FindNext(SearchRec);
    FindNext(SearchRec);

  { Loop and list any files found }
    repeat
        if ((DosError = 0) and ((SearchRec.Attr and faDirectory) <> 0)) then
          begin
            NumListed := NumListed + ListFiles(SearchRec.Name);
          end;
        if (DosError = 0) then
          begin
            NumListed := NumListed + 1;
            Write('     ', CurDir, '\', SearchRec.Name);
            if ((SearchRec.Attr and faDirectory) <> 0) then
                Write(', directory');
            if ((SearchRec.Attr and faReadOnly) <> 0) then
                Write(', read-only');
            if ((SearchRec.Attr and faHidden) <> 0) then
                Write(', hidden');
            if ((SearchRec.Attr and faSysFile) <> 0) then
                Write(', system');
            WriteLn;
          end; { if }
        FindNext(SearchRec);
    until (DosError <> 0);

    ChDir(OrgDir);                      { Restore directory }
    ListFiles := NumListed;             { Return number of files listed }
end;  { procedure ListFiles }


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *  function HasSwitch (switch : string) : boolean                       *
 *      Checks the command-line arguements for the specified switch      *
 *  parameters:  switch, the switch to search for                        *
 *  returns:  TRUE if found, else FALSE                                  *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

function HasSwitch (switch : char) : boolean;
var
    i : integer;                        { Index variable }
begin
    HasSwitch := FALSE;
    for i := 1 to ParamCount-1 do
      begin
        if (Pos(UpCase(switch), ToUpper(ParamStr(i))) <> 0) then
          begin
            HasSwitch := TRUE;
            Exit;
          end; { if }
      end; { for }
end; { function HasSwitch }

var { main variables }
    UserInput : string[fsDirectory];	{ user response }
	Answer : string;  					{ user response }
    OrgDir : string[fsDirectory];       { Original directory }
    Target : string[fsDirectory];       { Directory to nuke }
    Remove : boolean;                   { If directory actually removed }
	Result : boolean;                   { Result of nuking }
	LinesShown : word;					{ Number of lines shown so far }
    Attrib : word;                      { File attributes to delete }

begin { main program }
  { Print greeting }
    WriteLn('NUKE Directory  ', MajorVer, '.', MinorVer);
    WriteLn('    (C)', Year, ' by Kerr');
    WriteLn;

  { Check for DOS help command }
    if ((ParamCount < 1) or HasSwitch('?') or (Pos('?', ParamStr(1)) <> 0)) then
      begin
        Write('Removes a subdirectory, along with the files and ');
        WriteLn('subdirectories is contains');
        WriteLn;
        WriteLn('NUKE [options] [directory]');
        WriteLn;
        WriteLn('Options are as follows:');
		WriteLn('  K      Keeps the subdirectory after clearing out files.');
		WriteLn('  H      Deletes hidden files.');
		WriteLn('  R      Deletes read-only files.');
		WriteLn('  S      Deletes system files.');
		WriteLn('  A      Deletes files of all attributes.');
        WriteLn('  Y      No verification before NUKEing - dangerous!');
		Write  ('  V      Verbose, displays files and subdirectories they ');
		WriteLn('are removed - SLOW!');
		WriteLn('  P      Pause after each screen.');
        WriteLn;
        WriteLn('You cannot nuke the root directory.');
        WriteLn('Nuke will not Pause if you redirect the input or output.');
        Exit;
	  end;

  { Set number of lines displayed }
	LinesShown := 0;

  { Check for /K switch }
    Remove := not HasSwitch('K');

    Attrib := 0;

  { Check for /H switch }
    if (HasSwitch('H')) then
        Attrib := Attrib or faHidden;
  { Check for /R switch }
    if (HasSwitch('R')) then
        Attrib := Attrib or faReadOnly;
  { Check for /S switch }
    if (HasSwitch('S')) then
        Attrib := Attrib or faSysFile;
  { Check for /A switch }
    if (HasSwitch('A')) then
        if (Attrib <> 0) then
          begin
            WriteLn('Cannot use the /A switch with other attribute switches.');
            Exit;
          end
        else
            Attrib := faAnyFile;

{$IFDEF MsDos}
    UserInput := ParamStr(ParamCount);
{$ENDIF}
{$IFDEF Windows}
    Write('Input directory to remove:  ');
    ReadLn(UserInput);
{$ENDIF}

  { Save directory and drive and try to change to new directory }
    GetDir(0, OrgDir);

    {$I-}
    ChDir(UserInput);
    if (IOResult <> 0) then
      begin
        WriteLn('   Specified directory not found!');
        ChDir(OrgDir);
        Exit;
      end;
    {$I+}

	GetDir(0, Target);					{ Get new directory }

  { Display target directory and change back from it }
    WriteLn(' Target is ', Target);
	WriteLn;

	ChDir(OrgDir);                      { Restore directory }

  { Exit if root directory being nuked }
    if (length(Target) = 3) then
      begin
        WriteLn('You cannot NUKE the root directory!');
        WriteLn('  (Try FORMAT...)');
        Exit;
      end;


  { Double check before DECIMATING directory }
	if (not HasSwitch('Y')) then
	  begin
		WriteLn(' Are you SURE you want to OBLITERATE this directory and');
		Write('  everything in or under it?!?!? (Y/N) ');
{$IFDEF MsDos}
		ClearKb;
{$ENDIF}
		ReadLn(Answer);
		Answer := ToUpper(Answer);
	  end;

  { If 'yes' or 'y' entered, or 'Y' SWITCH set, nuke that puppy }
	if ((answer = 'YES') or (answer = 'Y') or HasSwitch('Y'))  then
      begin
        WriteLn(' Beginning now...');
		Result := NukeDir(Target, Remove, HasSwitch('V'),
				HasSwitch('P') and (not IsRedirected), Attrib, LinesShown);
        WriteLn('  ...may the diety of your choice have mercy on your soul.');
      end { if }
    else
      begin
        Result := FALSE;
        WriteLn(' Nothing done.');
        Exit;
      end; { else }

  { List files not deleted }
    if (not Result) then
      begin
        WriteLn;
      { Display a message if the directory was SUPPOSED to be removed }
        if (Remove) then
          begin
            WriteLn('  NUKE failed to remove the directory.');
          end
        else
          begin
            WriteLn('  NUKE has kept the directory.');
          end;
        WriteLn(' The following files or directories remain in it:');
        if (ListFiles(Target) = 0) then
            WriteLn('    None');
      { Display helpful hint if the directory was SUPPOSED to be removed }
        if (Remove) then
          begin
            WriteLn;
            Write('If you wish to remove these files, try the ');
            WriteLn('/H, /R, and /S options,');
            WriteLn('  or the /A option.');
          end;
      end; { if }
end. { main }