home *** CD-ROM | disk | FTP | other *** search
- {@@@@@@@@@@@ copyright (C) 1984 by Neil J. Rubenking @@@@@@@@@@@@@@@@@@@@@@@@
- The purchaser of these procedures and functions may include them in COMPILED
- programs freely, but may not sell or give away the source text.
-
- }
- {$I regpack.typ}
- {$I filename.typ}
- {$I errmessg.lib}
- {$I mkrmdir.lib}
- {$I getkeys.lib}
- {@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
- var
- new_directory : filename_type;
- error : byte;
- C, D : char;
- {@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
- begin
- WriteLn('Enter a pathname for a new directory to create.');
- WriteLn('Note that it must "grow" from an existing path.');
- ReadLn(new_directory);
- DoSubDirectory('M',new_directory,error);
- if error <> 0 then
- WriteLn(message(error))
- else
- begin
- WriteLn('We have just created directory ',new_directory);
- WriteLn('If you want to quit and confirm that fact, type Q.');
- WriteLn('Otherwise, I will go on to remove ',new_directory);
- GetKeys(C,D);
- if UpCase(C) <> 'Q' then
- begin
- DoSubDirectory('R',new_directory,error);
- if error <> 0 then
- writeLn(message(error))
- else
- begin
- WriteLn('Successfully removes ',new_directory);
- end;
- end;
- end;
- end.