home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / AAKXREF.ZIP / FILESEPR.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-06-15  |  2.2 KB  |  51 lines
  1. (********************************************************************)
  2. (* THIS PROCEDURE WILL TAKE AN INPUT FILE PATH AND RETURN ITS       *)
  3. (* COMPONETES Path, Name, Extension                                 *)
  4. (* INPUT        : F_S ; PATH\FILE NAME . EXT                        *)
  5. (* INPUT/OUTPUT : NONE                                              *)
  6. (* OUTPUT       : File_Path,File_Name,File_Ext                      *)
  7. (* USES         : NO SIDE EFFECTS                                   *)
  8. (* CALLS        : NONE                                              *)
  9. (* ERRORS       : NONE                                              *)
  10. (* GLOBAL VARS  : NONE                                              *)
  11. (* SUBJECT      : FILE NAMES, PARSS FILE SPEC                       *)
  12. (* DOMAIN       : ARNO A. KARNER                      LEVEL : 000   *)
  13. (********************************************************************)
  14.  
  15. PROCEDURE File_Separator               ( VAR F_S       : File_Str ;
  16.                                          VAR File_Path : File_Str ;
  17.                                          VAR File_Name : String_08 ;
  18.                                          VAR File_Ext  : String_03 ) ;
  19.  
  20. VAR
  21.    Tem       : File_Str ;
  22.    I,J, Len  : INTEGER ;
  23.  
  24. BEGIN (* PROC *)
  25.    File_Ext  := '' ;
  26.    File_Name := '' ;
  27.    File_Path := '' ;
  28.    Len := Length ( F_S ) ;
  29.    I   := Len ;
  30.    WHILE (( I > 0 ) AND ( NOT ( F_S [ I ] = '\' ) )) DO I := I - 1 ;
  31.    IF I <> 0
  32.    THEN BEGIN (* FOUND PATH *)
  33.            File_Path := COPY ( F_S , 1 , I ) ;
  34.            Tem := COPY ( F_S , I + 1 , Len - I ) ;
  35.         END  (* FOUND PATH *)
  36.    ELSE Tem := F_S ;
  37.    J := POS ( '.' , Tem ) ;
  38.    Len := LENGTH ( Tem ) ;
  39.    IF J <> 0
  40.    THEN BEGIN (* FOUND EXT *)
  41.            IF J <> Len
  42.            THEN BEGIN (* NOT ZERO LENGTH EXT *)
  43.                    File_Ext := COPY ( Tem , J + 1 , Len - J ) ;
  44.                    File_Name := COPY ( Tem , 1 , J - 1 ) ;
  45.                 END
  46.            ELSE File_Name := COPY ( Tem , 1 , Len - 1 ) ;
  47.         END   (* FOUND EXT *)
  48.    ELSE BEGIN (* GET FILE NAME *)
  49.            File_Name := Tem ;
  50.         END ; (* GET FILE NAME *)
  51. END ; (* PROC *)