home *** CD-ROM | disk | FTP | other *** search
/ DOS Wares / doswares.zip / doswares / DATABASE / DBASE5 / CUA_SAMP.ZIP / FILEROOT.PRG < prev    next >
Encoding:
Text File  |  1994-06-24  |  1.5 KB  |  62 lines
  1. FUNCTION FileRoot
  2. PARAMETER pc_fname
  3. *--------------------------------------------------------------------
  4. * NAME
  5. *   FileRoot - Returns "root" of a filename.
  6. *
  7. * SYNOPSIS
  8. *   FileRoot( pc_fname )
  9. *
  10. * DESCRIPTION
  11. *   FileRoot() isolates the filename, up to the first eight
  12. *   characters, from a full path description.  That is, the
  13. *   file extension, if any, is not returned.  Note that the
  14. *   following can all be valid filespecs within dBASE:
  15. *     FOO
  16. *     FOO.BAR
  17. *     C:FOO
  18. *     C:FOO.BAR
  19. *     C:\FOO
  20. *     C:\FOO.BAR
  21. *     C:\FOO\FOO
  22. *     C:\FOO\FOO.BAR
  23. *     C:\FOO.BAR\FOO
  24. *     C:\FOO.BAR\FOO.BAR
  25. *     ..\FOO.BAR
  26. *
  27. *   No upper or lower case conversion occurs.
  28. *
  29. * PARAMETER
  30. *   pc_fname - A character full DOS filespec.
  31. *
  32. * EXAMPLE
  33. *   lc_root = FileRoot( "C:\TEST\FOO.PRG" )
  34. *     ( lc_root will equal "FOO" )
  35. *
  36. * SEE ALSO
  37. *   FILEDRV(), FILEPATH(), FILETYPE()
  38. *
  39. *--------------------------------------------------------------------
  40.  
  41.   PRIVATE lc_result, lc_slash
  42.  
  43.   lc_slash = "\"
  44.  
  45.   *-- Add "." to end to easily handle file with no extension:
  46.   lc_result = LTRIM( RTRIM( m->pc_fname ) ) + "."
  47.  
  48.   IF m->lc_slash $ m->lc_result
  49.     lc_result = SUBSTR( m->lc_result, RAT(m->lc_slash, m->lc_result) + 1 )
  50.   ELSE
  51.  
  52.     IF ":" $ m->lc_result
  53.       lc_result = SUBSTR( m->lc_result, AT(":", m->lc_result) + 1 )
  54.     ENDIF
  55.  
  56.   ENDIF
  57.  
  58. RETURN UPPER( SUBSTR(m->lc_result, 1, AT(".", m->lc_result ) - 1 ) )
  59.  
  60. *-- EOF: FileRoot( pc_fname )
  61.  
  62.