home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / PIBTERM / PIBT41S4.ARC / SPLITFNA.MOD < prev    next >
Encoding:
Text File  |  1988-02-08  |  4.2 KB  |  104 lines
  1. (*----------------------------------------------------------------------*)
  2. (*       Split_File_Name --- Return components of a file name           *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. PROCEDURE Split_File_Name(     FileRef    : AnyStr;
  6.                            VAR Drive      : CHAR;
  7.                            VAR Path       : AnyStr;
  8.                            VAR FileName   : AnyStr;
  9.                            VAR FileType   : AnyStr;
  10.                            VAR Bogus_Name : BOOLEAN  );
  11.  
  12. (*----------------------------------------------------------------------*)
  13. (*                                                                      *)
  14. (*     Procedure:  Split_File_Name                                      *)
  15. (*                                                                      *)
  16. (*     Purpose:    Splits file name into component parts                *)
  17. (*                                                                      *)
  18. (*     Calling Sequence:                                                *)
  19. (*                                                                      *)
  20. (*        Split_File_Name(     FileRef    : AnyStr;                     *)
  21. (*                         VAR Drive      : AnyStr;                     *)
  22. (*                         VAR Path       : AnyStr;                     *)
  23. (*                         VAR FileName   : AnyStr;                     *)
  24. (*                         VAR FileType   : AnyStr;                     *)
  25. (*                         VAR Bogus_Name : BOOLEAN );                  *)
  26. (*                                                                      *)
  27. (*           FileRef    --- original file specification                 *)
  28. (*           Drive      --- drive spec if any                           *)
  29. (*           Path       --- path spec if any                            *)
  30. (*           FileName   --- main file name                              *)
  31. (*           FileType   --- file type if any                            *)
  32. (*           Bogus_Name --- TRUE if name is bad, FALSE otherwise        *)
  33. (*                                                                      *)
  34. (*----------------------------------------------------------------------*)
  35.  
  36. VAR
  37.    Count      : INTEGER;
  38.    IPos       : INTEGER;
  39.    L          : INTEGER;
  40.  
  41. BEGIN (* Split_File_Name *)
  42.                                    (* Assume file name bad.       *)
  43.    Bogus_Name := TRUE;
  44.                                    (* Defaults                    *)
  45.    Drive      := ' ';
  46.    Path       := '';
  47.    FileName   := '';
  48.    FileType   := '';
  49.                                    (* Trim the file name          *)
  50.  
  51.    FileRef    := LTrim( Trim( FileRef ) );
  52.  
  53.                                    (* Remove any drive identifier *)
  54.  
  55.    IPos := POS(':', FileRef);
  56.  
  57.    IF ( IPos <> 0 ) THEN
  58.       IF ( IPos = 2 ) THEN
  59.          BEGIN
  60.             Drive   := FileRef[1];
  61.             FileRef := COPY( FileRef, 3, LENGTH( FileRef ) - 2 );
  62.          END
  63.       ELSE
  64.          EXIT;
  65.                                    (* Extract the path if any          *)
  66.  
  67.    IF ( POS( '\' , FileRef ) <> 0 ) THEN
  68.       BEGIN
  69.  
  70.          L    := LENGTH( FileRef );
  71.          IPos := L + 1;
  72.  
  73.          REPEAT
  74.             DEC( IPos );
  75.          UNTIL ( IPos <= 1 ) OR ( FileRef[IPos] = '\' );
  76.  
  77.          Path    := COPY( FileRef, 1, IPos );
  78.          FileRef := COPY( FileRef, IPos + 1, L - IPos );
  79.  
  80.       END;
  81.                                    (* No file reference after path --  *)
  82.                                    (* exit.                            *)
  83.    IF ( FileRef = '' ) THEN
  84.       BEGIN
  85.          Bogus_Name := FALSE;
  86.          EXIT;
  87.       END;
  88.                                    (* Extract file type if any         *)
  89.    IPos := POS( '.' , FileRef );
  90.  
  91.    IF ( IPos = 0 ) THEN
  92.       BEGIN
  93.          FileName   := FileRef;
  94.          Bogus_Name := FALSE;
  95.       END
  96.    ELSE
  97.       BEGIN
  98.          FileName := COPY( FileRef, 1, PRED( IPos ) );
  99.          FileType := COPY( FileRef, SUCC( IPos ), LENGTH( FileRef ) - IPos );
  100.          Bogus_Name := ( LENGTH( FileName ) <= 0 );
  101.       END;
  102.  
  103. END    (* Split_File_Name *);
  104.