home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a009 / 6.ddi / SAMPLE.LIF / ENVIRON.PRG < prev    next >
Encoding:
Text File  |  1991-04-14  |  3.5 KB  |  161 lines
  1. /*****
  2. *
  3. *  Environ.prg
  4. *
  5. *  Sample procedures and user-defined functions for controlling a
  6. *  Clipper program
  7. *
  8. *  Copyright, Nantucket Corporation, 1990
  9. *  Apr 19, 1990
  10. *
  11. *  NOTE: compile with /n/w/a/m
  12. *
  13. */
  14.  
  15.  
  16. #include "Set.ch"
  17.  
  18.  
  19. /***
  20. *  FilePath( <cFile> ) --> cFilePath
  21. *  Extract the full path name from a filename
  22. *
  23. */
  24. FUNCTION FilePath( cFile )
  25.    LOCAL nPos, cFilePath
  26.    IF (nPos := RAT("\", cFile)) != 0
  27.       cFilePath := SUBSTR(cFile, 1, nPos)
  28.    ELSE
  29.       cFilePath := ""
  30.    ENDIF
  31.    RETURN cFilePath
  32.  
  33.  
  34.  
  35. /***
  36. *  FileBase( <cFile> ) --> cFileBase
  37. *  Extract the eight letter base name from a filename
  38. *
  39. */
  40. FUNCTION FileBase( cFile )
  41.    LOCAL nPos, cFileBase
  42.  
  43.    DO CASE
  44.    CASE (nPos := RAT("\", cFile)) != 0
  45.       // Strip full path name
  46.       cFileBase := SUBSTR(cFile, nPos + 1)
  47.    CASE (nPos := AT(":", cFile)) != 0
  48.       // Strip drive letter
  49.       cFileBase := SUBSTR(cFile, nPos + 1)
  50.    OTHERWISE
  51.       cFileBase := cFile
  52.    ENDCASE
  53.  
  54.    // Strip file extension, if any
  55.    IF (nPos := AT(".", cFileBase)) != 0
  56.       cFileBase := SUBSTR(cFileBase, 1, nPos - 1)
  57.    ENDIF
  58.  
  59.    RETURN cFileBase
  60.  
  61.  
  62.  
  63. /***
  64. *  FileExt( <cFile> ) --> cFileExt
  65. *  Extract the three letter extension from a filename
  66. *
  67. */
  68. FUNCTION FileExt( cFile )
  69.    LOCAL nPos, cFileExt
  70.  
  71.    IF (nPos := RAT(".", cFile)) != 0
  72.       cFileExt := SUBSTR(cFile, nPos + 1)
  73.    ELSE
  74.       cFileExt := ""
  75.    ENDIF
  76.  
  77.    RETURN cFileExt
  78.  
  79.  
  80.  
  81. /***
  82. *  FileDrive( <cFile> ) --> cFileDrive
  83. *  Extract the drive designator from a fully qualified filename
  84. *
  85. */
  86. FUNCTION FileDrive( cFile )
  87.    LOCAL nPos, cFileDrive := ""
  88.    
  89.    IF (nPos := AT(":", cFile)) != 0
  90.       cFileDrive := SUBSTR(cFile, 1, nPos - 1)
  91.    ENDIF
  92.  
  93.    RETURN cFileDrive
  94.  
  95.  
  96. /***
  97. *  FullPath( <cFile>, <lClipPath> ) --> cFullPath
  98. *  Returns the full path of cFile; similar to the FoxPro FULLPATH() function
  99. */
  100. FUNCTION FullPath( cFile, lDosPath )
  101.    LOCAL cDefault, cPath
  102.  
  103.    cDefault := SET(_SET_DEFAULT)
  104.    cDefault += IF( RIGHT(RTRIM(cDefault), 1) != "\", "\", "") + cFile
  105.  
  106.    IF FILE( cDefault )
  107.       cPath := cDefault
  108.    ELSE
  109.       IF lDosPath = NIL .OR. !lDosPath
  110.          cPath := GetPath( cFile, SET(_SET_PATH) )
  111.       ELSE
  112.          cPath := GetPath( cFile, GETENV( "PATH" ) )
  113.       ENDIF
  114.    ENDIF
  115.    RETURN IF( cPath = NIL, cDefault, cPath )
  116.  
  117.  
  118.  
  119. /***
  120. *  GetPath( <cFile>, <cPathSpec> ) --> cPath
  121. *  Returns the location of a file if found in cPathSpec; otherwise returns NIL
  122. *
  123. *  NOTE: calls ListAsArray(), defined in String.prg
  124. */
  125. FUNCTION GetPath( cFile, cPathSpec )
  126.    LOCAL aPathList, bFilePath, cPath, nPos
  127.  
  128.    bFilePath := { |cPath| FILE( cPath + ;
  129.       IF( RIGHT(RTRIM(cPath), 1) != "\", "\", "") + cFile ) }
  130.  
  131.    aPathList := ListAsArray( STRTRAN(cPathSpec, ",", ";"), ";" )
  132.  
  133.    IF (nPos := ASCAN( aPathList, bFilePath )) != 0
  134.       RETURN aPathList[ nPos ]
  135.    ELSE
  136.       RETURN NIL
  137.    ENDIF
  138.  
  139.  
  140.  
  141. /***
  142. *  SetAll( [<aNewSets>] ) --> aCurrentSets
  143. *  Using an array of settings, change all global SETs and return their
  144. *  original settings in an array.  If no argument is passed, simply 
  145. *  return current settings.
  146. *
  147. */
  148. FUNCTION SetAll( aNewSets )
  149.    LOCAL aCurrentSets[_SET_COUNT], n
  150.    IF ( aNewSets != NIL )              // Set new and return current
  151.       FOR n := 1 TO _SET_COUNT
  152.          aCurrentSets[n] := SET(n, aNewSets[n])
  153.       NEXT
  154.    ELSE                                // Just return current
  155.       FOR n := 1 TO _SET_COUNT
  156.          aCurrentSets[n] := SET(n)
  157.       NEXT
  158.    ENDIF
  159.    RETURN (aCurrentSets)
  160.  
  161.