Name: MakeAbs.Pas

(***********************************************************************

Name: MakeAbs.Pas
Version: 1.0

This software has been placed into the public domain by Digital
Equipment Corporation.

DISCLAIMER:

The information herein is subject to change without notice and should
not be construed as a commitment by Digital Equipment Corporation.

Digital Equipment Corporation assumes no responsibility for the use or
reliability of this software. This software is provided "as is,"
without any warranty of any kind, express or implied. Digital Equipment
Corporation will not be liable in any event for any damages including
any loss of data, profit, or savings, claims against the user by any
other party, or any other incidental or consequential damages arising
out of the use of, or inability to use, this software, even if Digital
Equipment Corporation is advised of the possibility of such damage.

DEFECT REPORTING AND SUGGESTIONS:

Please send reports of defects or suggestions for improvement directly
to the author:

Brian Hetrick
Digital Equipment Corporation
110 Spit Brook Road ZKO1-3/J10
Nashua NH 03062-2698

Do NOT file a Software Performance Report on this software, call the
Telephone Support Center regarding this software, contact your Digital
Field Office regarding this software, or use any other mechanism
provided for Digital's supported and warranted software.

FACILITY:

TURBO Pascal MS-DOS support routines

ABSTRACT:

Translates a relative path specification into an absolute path
specification (one that does not depend upon current directories or
relative directory specifiers)

ENVIRONMENT:

MS-DOS V2.0 or later, compiled with Borland International's TURBO
Pascal V3.0 or later.

AUTHOR: Brian Hetrick, CREATION DATE: 1 December 1986.

MODIFIED BY:

Brian Hetrick, 01-Dec-86: Version 1.0
000 - Original creation of module.

***********************************************************************)
{.PA}
(*
* INCLUDE FILES:
*)

(*
* LABEL DECLARATIONS:
*)

(*
* CONSTANT DECLARATIONS:
*)

(*
* TYPE DECLARATIONS:
*)

TYPE

MakeAbsPath = STRING [255];

(*
* OWN STORAGE:
*)

(*
* TABLE OF CONTENTS:
*)
{.PA}
PROCEDURE MakePathAbsolute
(VAR RelativePath : MakeAbsPath);

(***********************************************************************

FUNCTIONAL DESCRIPTION:

Finds the absolute path specification for a given relative path
specification. In the absolute path specification, the drive letter
and a root-relative path specification name the file. In a relative
path specification, the drive letter need not appear (it defaults to
the current drive), and the path specification may be relative to
the current path on the drive.

FORMAL PARAMETERS:

Path.mt.r - The possibly relative path specification which is set to
be the corresponding absolute path specification.

RETURN VALUE:

None.

IMPLICIT INPUTS:

None.

IMPLICIT OUTPUTS:

None.

SIDE EFFECTS:

May obtain the current directory on the current drive, or the cur-
rent directory on some other drive. For some reason, MS-DOS acces-
es the drive when the current directory is requested, so this may
generate an MS-DOS level error if the drive does not exist or if
there is no volume in the drive.

***********************************************************************)

VAR

AbsolutePath : MakeAbsPath;
DriveIndex : INTEGER;
LastDeletePosition : INTEGER;
ScanPtr : INTEGER;
ThisChar : CHAR;

BEGIN

(*
* Get drive index and current directory for drive
*)

IF (Length (RelativePath) >= 2) AND (RelativePath [2] = ':')
THEN
BEGIN

DriveIndex := Ord (UpCase (RelativePath [1])) - 64;
Delete (RelativePath, 1, 2)

END
ELSE

DriveIndex := 0;

GetDir (DriveIndex, AbsolutePath);

(*
* Construct the absolute path name
*)

IF Length (RelativePath) > 0
THEN
BEGIN

IF (RelativePath [1] = '/') OR (RelativePath [1] = '\')
THEN

Delete (AbsolutePath, 3, Length (AbsolutePath) - 2)

ELSE IF (AbsolutePath [Length (AbsolutePath)] <> '\') AND
(AbsolutePath [Length (AbsolutePath)] <> '/')
THEN

Insert ('\', AbsolutePath, Length (AbsolutePath) + 1)

END;

Insert (RelativePath, AbsolutePath, Length (AbsolutePath) + 1);

(*
* Fix lowercase and directory separators
*)

FOR ScanPtr := 1 TO Length (AbsolutePath)
DO
BEGIN

ThisChar := UpCase (AbsolutePath [ScanPtr]);
IF ThisChar = '/'
THEN
ThisChar := '\';
AbsolutePath [ScanPtr] := ThisChar

END;

(*
* Fix up '.' and '..' references
*)

ScanPtr := 1;
WHILE ScanPtr <= Length (AbsolutePath)
DO
BEGIN

IF AbsolutePath [ScanPtr] = '\'
THEN
BEGIN

(*
* Check next character for '.'
*)

IF (Length (AbsolutePath) > ScanPtr) AND
(AbsolutePath [ScanPtr + 1] = '.')
THEN
BEGIN

(*
* Check next character also for '..'
*)

IF (Length (AbsolutePath) > ScanPtr + 1) AND
(AbsolutePath [ScanPtr + 2] = '.')
THEN
BEGIN

(*
* Have reference to parent directory. Delete both
* '..' and previous directory
*)

LastDeletePosition := ScanPtr + 2;
REPEAT
ScanPtr := ScanPtr - 1
UNTIL (AbsolutePath [ScanPtr] = '\') OR
(AbsolutePath [ScanPtr] = ':');

IF AbsolutePath [ScanPtr] = ':'
THEN
ScanPtr := ScanPtr + 1

END
ELSE

(*
* Have reference to current directory. Delete '.'
* only
*)

LastDeletePosition := ScanPtr + 1;

(*
* Delete directory references
*)

Delete (AbsolutePath, ScanPtr,
LastDeletePosition - ScanPtr + 1)

END
ELSE

(*
* Next character is not '.'
*)

ScanPtr := ScanPtr + 1

END
ELSE

(*
* Current character is not '\'
*)

ScanPtr := ScanPtr + 1

END;

(*
* Specification of the root directory through .. may leave only
* the drive letter and colon
*)

IF Length (AbsolutePath) = 2
THEN
Insert ('\', AbsolutePath, 3);

(*
* Return the absolute path
*)

RelativePath := AbsolutePath

END;