home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / NAMEPATH.ZIP / NAP.INC next >
Encoding:
Text File  |  1985-10-22  |  6.1 KB  |  168 lines
  1. (* Utilities to deal with name/path strings
  2.  
  3.    vers1.01   10/21/85   add LastChar function
  4.    vers1.00   08/22/85
  5.    PL Glatz
  6. *)
  7.  
  8.  
  9. (* return last character from string *)
  10. FUNCTION LastChar(s : Str255) : CHAR ;
  11.   BEGIN
  12.     IF s > '' THEN
  13.       LastChar := Copy(s, Length(s), 1)
  14.     ELSE
  15.       LastChar := ''
  16.   END ;   (* LastChar *)
  17.  
  18.  
  19. (* seperate name and path components from string:
  20.     Possibilities:   NamePathStr        path                 name
  21.                      -----------        ----                 ----
  22.          [1]         nnnn               -                    nnnn
  23.          [2]         dr:nnnn            dr+path of dr        nnnn
  24.          [3]         dr:\nnnn           dr\                  nnnn
  25.          [4]         dr:\pppp\          dr:\pppp\            -
  26.          [5]         \pppp\             \pppp\               -
  27.          [6]         \pppp\nnnn\        \pppp\               nnnn
  28.          [7]         \nnnn              \                    nnnn
  29.          [8]         dr:                dr+path of dr        ---
  30.  
  31.     path will always be returned with a trailing '\'
  32. *)
  33.  
  34.     PROCEDURE SeperateNameFromPath(VAR NamePathStr : Str255 ;  (* string containing path and name *)
  35.                                    VAR name,                   (* returned name part here *)
  36.                                        path : NameStr) ;       (* returned path part here *)
  37.       TYPE
  38.         Possibility = (Empty,NameOnly,DriveAndName,DriveAndSlashAndName,
  39.                        DriveAndPath,PathOnly,PathAndName,SlashAndName,DriveOnly) ;
  40.  
  41.       VAR
  42.         FoundPosition,
  43.         SeperationPoint : INTEGER ;
  44.         temp : NameStr ;
  45.         DrivePart : STRING[2] ;
  46.  
  47.         (* Return name/path type *)
  48.         FUNCTION DeterminePossibility(VAR str : Str255) : Possibility ;
  49.           (* return TRUE if string s contains a slash *)
  50.           FUNCTION HasSlash(VAR s : Str255) : BOOLEAN ;
  51.             BEGIN
  52.               FoundPosition := Pos('\',s) ;
  53.               IF FoundPosition > 0 THEN
  54.                 HasSlash := TRUE ELSE HasSlash := FALSE
  55.             END; (* Function HasSlash *)
  56.  
  57.           (* return # of slashes in string s *)
  58.           FUNCTION SlashCount(VAR s : Str255) : INTEGER ;
  59.             VAR
  60.               j,
  61.               count : INTEGER ;
  62.             BEGIN
  63.               count := 0 ;
  64.               FOR j := 1 TO Length(s) DO
  65.                 IF s[j] = '\' THEN count := Succ(count) ;
  66.               SlashCount := count
  67.             END; (* Function SlashCount *)
  68.  
  69.           (* return TRUE if string s contains a colon in position 2 *)
  70.           FUNCTION HasColon(VAR s : Str255) : BOOLEAN ;
  71.             BEGIN
  72.               FoundPosition := Pos(':',s) ;
  73.               IF FoundPosition > 0 THEN
  74.                 HasColon := TRUE ELSE HasColon := FALSE
  75.             END; (* Function HasColon *)
  76.  
  77.  
  78.           BEGIN                 (* DeterminePossibility *)
  79.             IF (str = '') THEN DeterminePossibility := Empty
  80.             ELSE
  81.               IF (NOT HasSlash(str)) AND (NOT HasColon(str)) THEN
  82.                 DeterminePossibility := NameOnly
  83.               ELSE
  84.                 BEGIN
  85.                   IF HasColon(str) THEN
  86.                     BEGIN
  87.                       IF NOT HasSlash(str) THEN
  88.                         IF LastChar(str) = ':' THEN
  89.                           DeterminePossibility := DriveOnly
  90.                         ELSE
  91.                           DeterminePossibility := DriveAndName
  92.                       ELSE
  93.                         IF LastChar(str) = '\' THEN
  94.                           DeterminePossibility := DriveAndPath
  95.                         ELSE
  96.                           DeterminePossibility := DriveAndSlashAndName
  97.                     END
  98.                   ELSE
  99.                     IF LastChar(str) = '\' THEN
  100.                       DeterminePossibility := PathOnly
  101.                     ELSE
  102.                       IF SlashCount(str) > 1 THEN
  103.                         DeterminePossibility := PathAndName
  104.                       ELSE
  105.                         DeterminePossibility := SlashAndName
  106.               END
  107.           END; (* Function DeterminePossibility *)
  108.  
  109.        PROCEDURE DetermineSeperationPoint ;
  110.          BEGIN
  111.            SeperationPoint := Length(NamePathStr) ;
  112.            WHILE (SeperationPoint > 0)
  113.                  AND (Copy(NamePathStr,SeperationPoint,1) <> '\') DO
  114.                    SeperationPoint := Pred(SeperationPoint)
  115.          END; (* Procedure DetermineSeperationPoint  *)
  116.  
  117.       PROCEDURE ExtractPathAndName ;
  118.         VAR
  119.           i : INTEGER ;
  120.  
  121.         BEGIN
  122.           DetermineSeperationPoint ;
  123.           FOR i := 1 TO SeperationPoint DO
  124.             path := path + NamePathStr[i] ;
  125.           i := Succ(i) ;
  126.           WHILE i <= Length(NamePathStr) DO
  127.             BEGIN
  128.               name := name + NamePathStr[i] ;
  129.               i := Succ(i)
  130.             END
  131.         END ; (* Procedure ExtractPathAndName *)
  132.  
  133.      PROCEDURE GetDriveAndName ;
  134.         VAR
  135.           i : INTEGER ;
  136.  
  137.        BEGIN
  138.          GetDir(Ord(UpCase(NamePathStr[1]))-Ord('A')+1,path) ;
  139.          i := Pos(':',NamePathStr) + 1 ;
  140.          WHILE i <= Length(NamePathStr) DO
  141.            BEGIN
  142.              name := name + NamePathStr[i] ;
  143.              i := Succ(i)
  144.            END
  145.        END ; (* Procedure GetDriveAndName *)
  146.  
  147.  
  148.       BEGIN                 (* Procedure SeperateNameFromPath *)
  149.         name := '' ;
  150.         path := '' ;
  151.         CASE DeterminePossibility(NamePathStr) OF
  152.           NameOnly             : name := NamePathStr ;
  153.           DriveAndName         : GetDriveAndName ;
  154.           DriveAndSlashAndName : ExtractPathAndName ;
  155.           DriveAndPath         : path := NamePathStr ;
  156.           PathOnly             : path := NamePathStr ;
  157.           PathAndName          : ExtractPathAndName ;
  158.           SlashAndName         : ExtractPathAndName ;
  159.           DriveOnly            : path := NamePathStr ;
  160.         ELSE END ;   (* case *)
  161.  
  162.         IF path<> '' THEN
  163.           BEGIN
  164.             IF LastChar(path) <> '\' THEN path := path + '\'
  165.           END
  166.       END ; (* Procedure SeperateNameFromPath *)
  167.  
  168.