home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Database / CLIPR502.DOS / SOURCE / SAMPLE / ENVIRON.PRG < prev    next >
Encoding:
Text File  |  1993-02-15  |  5.8 KB  |  234 lines
  1. /***
  2. *
  3. *  Environ.prg
  4. *
  5. *  Sample procedures and user-defined functions for aiding Clipper
  6. *  programs with environmental issues and global settings
  7. *
  8. *  Copyright (c) 1993, Computer Associates International Inc.
  9. *  All rights reserved.
  10. *
  11. *  NOTE: compile with /a /m /n /w
  12. *
  13. */
  14.  
  15.  
  16. /***
  17. *
  18. *  FilePath( <cFile> ) --> cFilePath
  19. *
  20. *  Extract the full path name (without the filename or extension) from
  21. *  a complete file specification
  22. *
  23. *  Example:
  24. *     FilePath( "c:\clipper5\bin\clipper.exe" ) --> "c:\clipper5\bin\"
  25. *
  26. */
  27. FUNCTION FilePath( cFile )
  28.    
  29.    LOCAL nPos        // Marks the posistion of the last "\" in cFile, if any
  30.    LOCAL cFilePath   // The extracted path for cFile, exluding the filename
  31.  
  32.    IF ( nPos := RAT( "\", cFile )) != 0
  33.       cFilePath := SUBSTR( cFile, 1, nPos )
  34.    ELSE
  35.       cFilePath := ""
  36.    ENDIF
  37.  
  38.    RETURN ( cFilePath )
  39.  
  40.  
  41.  
  42. /***
  43. *
  44. *  FileBase( <cFile> ) --> cFileBase
  45. *
  46. *  Extract the eight letter base name from a filename
  47. *
  48. */
  49. FUNCTION FileBase( cFile )
  50.    
  51.    LOCAL nPos           // Marks the position of the last "\", if any
  52.    LOCAL cFileBase      // Return value containing the filename
  53.  
  54.    DO CASE
  55.    CASE ( nPos := RAT( "\", cFile )) != 0
  56.       
  57.       // Strip out full path name leaving only the filename (with
  58.       // extension)
  59.       cFileBase := SUBSTR( cFile, nPos + 1 )
  60.  
  61.    CASE ( nPos := AT( ":", cFile )) != 0
  62.       
  63.       // Strip drive letter if cFile contains only drive letter
  64.       // no subdirectories
  65.       cFileBase := SUBSTR( cFile, nPos + 1 )
  66.  
  67.    OTHERWISE
  68.       
  69.       // Assume it's already taken care of
  70.       cFileBase := cFile
  71.  
  72.    ENDCASE
  73.  
  74.    // Strip out the file extension, if any
  75.    IF ( nPos := AT( ".", cFileBase )) != 0
  76.       cFileBase := SUBSTR( cFileBase, 1, nPos - 1 )
  77.    ENDIF
  78.  
  79.    RETURN ( cFileBase )
  80.  
  81.  
  82.  
  83. /***
  84. *
  85. *  FileExt( <cFile> ) --> cFileExt
  86. *
  87. *  Extract the three letter extension from a filename
  88. *
  89. */
  90. FUNCTION FileExt( cFile )
  91.    
  92.    LOCAL nPos        // Marks the position of the extension, if any
  93.    LOCAL cFileExt    // Return value, the extension of cFile
  94.  
  95.    // Does the file extension exist?
  96.    IF ( nPos := RAT( ".", cFile )) != 0
  97.       cFileExt := SUBSTR( cFile, nPos + 1 )  // Extract it
  98.    ELSE
  99.       cFileExt := ""                         // None exists, return ""
  100.    ENDIF
  101.  
  102.    RETURN ( cFileExt )
  103.  
  104.  
  105.  
  106. /***
  107. *
  108. *  FileDrive( <cFile> ) --> cFileDrive
  109. *
  110. *  Extract the drive designator from a file specification
  111. *
  112. */
  113. FUNCTION FileDrive( cFile )
  114.    
  115.    LOCAL nPos                 // Marks the position of ":", if any
  116.    LOCAL cFileDrive := ""     // Return value, the drive letter
  117.    
  118.    // If ":" exists in cFile, extract the previous letter (drive letter)
  119.    IF ( nPos := AT( ":", cFile )) != 0
  120.       cFileDrive := SUBSTR( cFile, 1, nPos - 1 )
  121.    ENDIF
  122.  
  123.    RETURN ( cFileDrive )
  124.  
  125.  
  126.  
  127. /***
  128. *
  129. *  FullPath( <cFile>, <lClipPath> ) --> cFullPath
  130. *
  131. *  Returns the full path of cFile; similar to the FoxPro FULLPATH() function
  132. *
  133. */
  134. FUNCTION FullPath( cFile, lDosPath )
  135.    
  136.    LOCAL cDefault    // Contains the default path for searching for files
  137.    LOCAL cPath       // Return value
  138.  
  139.    // Retrieve Clipper's default directory for files (SET DEFAULT)
  140.    cDefault := SET( _SET_DEFAULT )
  141.  
  142.    // Add cFile to the default directory
  143.    cDefault += IF( RIGHT( RTRIM( cDefault ), 1 ) != "\", "\", "" ) + cFile
  144.  
  145.    IF FILE( cDefault )
  146.       cPath := cDefault
  147.    ELSE
  148.       IF (( lDosPath == NIL ) .OR. ( !lDosPath ))
  149.          
  150.          // Search for cFile in Clipper's current SET PATH setting;
  151.          // cPath will be set to NIL if not found
  152.          cPath := GetPath( cFile, SET( _SET_PATH ) )
  153.  
  154.       ELSE
  155.          
  156.          // Search for cFile in the current DOS PATH setting;
  157.          // cPath will be set to NIL if not found
  158.          cPath := GetPath( cFile, GETENV( "PATH" ) )
  159.  
  160.       ENDIF
  161.    ENDIF
  162.  
  163.    // Return the SET DEFAULT path if the file was not found elsewhere
  164.    RETURN IF( cPath == NIL, cDefault, cPath )
  165.  
  166.  
  167.  
  168. /***
  169. *
  170. *  GetPath( <cFile>, <cPathSpec> ) --> cPath
  171. *
  172. *  Returns the location of a file if found in cPathSpec,
  173. *  otherwise returns NIL
  174. *
  175. *  NOTE: Calls ListAsArray(), which is defined in String.prg
  176. *
  177. */
  178. FUNCTION GetPath( cFile, cPathSpec )
  179.    
  180.    LOCAL aPathList   // Contains an array of all the paths in cPathSpec   
  181.    LOCAL bFilePath   // Code block that checks for the existence of a file
  182.    LOCAL nPos        // The position in aPathList where cFile exists
  183.    LOCAL xRet        // Return value, the path where found, or NIL
  184.  
  185.    // This block returns true if cFile can be found in cPath
  186.    bFilePath := { |cPath| FILE( cPath +                                      ;
  187.                           IF( RIGHT( RTRIM( cPath ), 1 ) != "\", "\", "" ) + ;
  188.                           cFile )                                            ;
  189.                 }
  190.  
  191.    // Convert the list of paths as separate array elements
  192.    aPathList := ListAsArray( STRTRAN( cPathSpec, ",", ";" ), ";" )
  193.  
  194.    IF ( nPos := ASCAN( aPathList, bFilePath )) != 0
  195.       xRet := aPathList[nPos]
  196.    ELSE
  197.       xRet := NIL
  198.    ENDIF
  199.  
  200.    RETURN ( xRet )
  201.  
  202.  
  203.  
  204. /***
  205. *
  206. *  SetAll( [<aNewSets>] ) --> aCurrentSets
  207. *
  208. *  Using an array of settings, change all global SETs and return their
  209. *  original settings in an array.  If no argument is passed, simply 
  210. *  return current settings.
  211. *
  212. */
  213. FUNCTION SetAll( aNewSets )
  214.    
  215.    LOCAL aCurrentSets[_SET_COUNT]      // Holds the current global SETs
  216.    LOCAL n                             // Loop counter
  217.  
  218.    IF ( aNewSets != NIL )
  219.       
  220.       // Set new and return current
  221.       FOR n := 1 TO _SET_COUNT
  222.          aCurrentSets[n] := SET( n, aNewSets[n] )
  223.       NEXT
  224.  
  225.    ELSE
  226.    
  227.       // Just return current
  228.       FOR n := 1 TO _SET_COUNT
  229.          aCurrentSets[n] := SET( n )
  230.       NEXT
  231.  
  232.    ENDIF
  233.  
  234.    RETURN ( aCurrentSets )