home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / AAKXREF.ZIP / FIXPATH.FUN < prev    next >
Encoding:
Text File  |  1986-06-23  |  1.9 KB  |  44 lines
  1. (********************************************************************)
  2. (* THIS FUNCTION WILL FIX PATH NAMES THAT LACK TRAILING SLASHES     *)
  3. (*  IT WILL ALSO REMOVE ..\ AND TRAILING SPACES                     *)
  4. (* INPUT        : Work_String                                       *)
  5. (* INPUT/OUTPUT : NONE                                              *)
  6. (* OUTPUT       : File_Str                                          *)
  7. (* USES         : NO SIDE EFFECTS                                   *)
  8. (* CALLS        : Rev_Pos                                           *)
  9. (* ERRORS       : NONE                                              *)
  10. (* GLOBAL VARS  : NONE                                              *)
  11. (* SUBJECT      : PATH NAMES                                        *)
  12. (* DOMAIN       : ARNO A. KARNER                      LEVEL : 001   *)
  13. (********************************************************************)
  14.  
  15. FUNCTION Fix_Path_Str          ( Path_Str : Work_String ) : File_Str ;
  16.  
  17. VAR
  18.    I,J : INTEGER ;
  19.    Tem : Work_String ;
  20.  
  21. BEGIN (* FUNC *)
  22.    (* DELETE ALL TRAILING SPACES *)
  23.    WHILE Path_Str [ LENGTH ( Path_Str ) ] = ' ' DO
  24.       Path_Str := COPY ( Path_Str , 1 , LENGTH ( Path_Str ) - 1 ) ;
  25.    (* ADD SUB DIRECTORY SYMBOL IF NOT THERE *)
  26.    IF (Rev_Pos ( '\', Path_Str ) > Rev_Pos ( '.', Path_Str ))
  27.       AND ( Path_Str [ LENGTH ( Path_Str ) ] <> '\' )
  28.    THEN Tem := Path_Str + '\'
  29.    ELSE Tem := Path_Str ;
  30.    I := POS ( '\..\', Tem ) ;
  31.    IF I <> 0
  32.    THEN J := Rev_Pos ( '\', Copy ( Tem, 1, I -1 ))
  33.    ELSE J := 0 ;
  34.    WHILE (I > 2) AND (J > 0) DO  (* loop while deletable directories*)
  35.    BEGIN (* WHILE *)
  36.       Tem := COPY ( Tem, 1 , J ) + COPY ( Tem, I + 4, 255 ) ;
  37.       I := POS ( '\..\' , Tem ) ;
  38.       IF I <> 0
  39.       THEN J := Rev_Pos ( '\', Copy ( Tem, 1, I -1 ))
  40.       ELSE J := 0 ;
  41.    END ; (* WHILE *)
  42.    Fix_Path_Str := COPY ( Tem , 1 , 64 ) ;
  43. END ; (* FUNC *)
  44.