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.
-
- GET and SET the current directory .
- }
-
- program GetSetDirectory;
- {$I errmessg.lib} {<-- to interpret any error messages}
- {$I filename.typ}
- {$I regpack.typ} {<-- the "type" for REGISTERS variables for MSDOS calls}
- {$I getsetdd.lib} {<-- you might ask to set the drive, too}
- {$I gtsetdir.lib} {<-- THE MAIN ATTRACTION}
- var
- the_directory : filename_type;
- drive : char;
- error_return : byte;
-
- begin
- GetSetDrive('G',drive);
- GetSetDirectory('G',drive,the_directory,error_return);
- WriteLn('Current directory is ',the_directory);
- Write('Set to what? ');
- ReadLn(the_directory);
-
- if pos(':',the_directory) <> 0 then {if the requested new }
- begin {directory contains a drive}
- if upCase(the_directory[1]) <> drive then {letter, see if it's the }
- begin {same as the current drive.}
- drive := upCase(the_directory[1]); {If not, change the current}
- GetSetDrive('S',drive); {drive. }
- WriteLn('Drive changed to ',drive);
- end;
- delete(the_directory,1,2);
- end;
- if length(the_directory) > 0 then
- GetSetDirectory('S',drive,the_directory,error_return);
- if error_return <> 0 then
- WriteLn(message(error_return))
- else
- begin
- the_directory := drive + ':' + the_directory;
- writeLn(the_directory,' is the current directory.');
- end;
- end.