home *** CD-ROM | disk | FTP | other *** search
/ Power CD-ROM!! 7 / POWERCD7.ISO / prgmming / clipper / gt_isfil.prg < prev    next >
Text File  |  1993-10-14  |  3KB  |  157 lines
  1. /*
  2.     File......: GT_IsFile.prg
  3.     Author....: Martin Bryant
  4.     BBS.......: The Dark Knight Returns
  5.     Net/Node..: 050/069
  6.     User Name.: Martin Bryant
  7.     Date......: 04/03/93
  8.     Revision..: 1.0
  9.  
  10.     This is an original work by Martin Bryant and is placed
  11.     in the public domain.
  12.  
  13.     Modification history:
  14.     ---------------------
  15.  
  16.     Rev 1.0 04/03/93
  17.     PD Revision.
  18.  
  19.     Rev 1.1 17/03/93
  20.     Change lWildCards to cType
  21. */
  22.  
  23. /*  $DOC$
  24.  *  $FUNCNAME$
  25.  *       GT_ISFILE()
  26.  *  $CATEGORY$
  27.  *       Array
  28.  *  $ONELINER$
  29.  *       Check a file name is valid
  30.  *  $SYNTAX$
  31.  *       GT_IsFile(<oGet|cFile>,[<cType>],[<lExists>])
  32.  *  $ARGUMENTS$
  33.  *       <oGet|cFile> Get object to check the file name or
  34.  *       just pass a name.
  35.  *
  36.  *       <lWildCards> Matching spec.
  37.  *
  38.  *       <lExists> Must the file exist ?
  39.  *  $RETURNS$
  40.  *       .T. / .F. based on the success.
  41.  *  $DESCRIPTION$
  42.  *       Check that a file name is valid and optionally if it
  43.  *       exists.
  44.  *  $EXAMPLES$
  45.  *  $END$
  46.  */
  47.  
  48. #include "GtClippe.ch"
  49.  
  50. FUNCTION GT_IsFile(oGet,cType,lExists)
  51.  
  52. LOCAL cExtent := ''
  53. LOCAL cFile := ''
  54. LOCAL cLegal := 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_-'
  55. LOCAL cPath := ''
  56. LOCAL lSuccess := .T.
  57. LOCAL nCount := 0
  58. LOCAL nFound := 0
  59. LOCAL nLength := 0
  60.  
  61. Default oGet to ''
  62. Default cType to ''
  63. Default lExists to .F.
  64.  
  65. //  Get file name to check
  66. IF VALTYPE(oGet) == 'O'
  67.     cFile := UPPER(EVAL(oGet:Block,NIL))
  68. ELSE
  69.     cFile := oGet
  70. ENDIF
  71. nLength := LEN(cFile)
  72.  
  73. // Check validity
  74. nFound := RAT('\',cFile)
  75.  
  76. //  Extract path
  77. IF nFound > 0
  78.     cPath := LTRIM(RTRIM(SUBSTR(cFile,1,nFound)))
  79.     cFile := SUBSTR(cFile,nFound+01)
  80. ELSE
  81.     cPath := ''
  82. ENDIF
  83.  
  84. // Extract extent
  85. nFound := AT('.',cFile)
  86. IF nFound > 0
  87.     cExtent := LTRIM(RTRIM(SUBSTR(cFile,nFound+01,3)))
  88.     cFile := SUBSTR(cFile,1,nFound-01)
  89. ELSE
  90.     cExtent := ''
  91. ENDIF
  92. cFile := LTRIM(RTRIM(cFile))
  93.  
  94. //  Validate extent
  95. nCount := LEN(cExtent)
  96. DO WHILE nCount > 0 .AND. lSuccess
  97.     lSuccess := SUBSTR(cExtent,nCount--,1) $ cLegal
  98. ENDDO
  99.  
  100. //  Validate name
  101. nCount := LEN(cFile)
  102. DO WHILE nCount > 0 .AND. lSuccess
  103.     lSuccess := SUBSTR(cFile,nCount--,1) $ cLegal
  104. ENDDO
  105.  
  106. // Validate path
  107. IF AT(':',cPath) != RAT(':',cPath) .OR. '\\' $ cPath
  108.     lSuccess := .F.
  109. ENDIF
  110. nCount := LEN(cPath)
  111. cLegal += ':\'
  112. DO WHILE nCount > 0 .AND. lSuccess
  113.     lSuccess := SUBSTR(cPath,nCount--,1) $ cLegal
  114. ENDDO
  115.  
  116. //  Must exist
  117. IF lExists .OR. .NOT. lSuccess
  118.  
  119.     IF lSuccess
  120.  
  121.         cFile := cPath + cFile + ;
  122.             IF(EMPTY(cExtent),'','.' + cExtent)
  123.  
  124.     ELSE
  125.  
  126.         cPath := ''
  127.         cExtent := ''
  128.         cFile := ''
  129.  
  130.     ENDIF
  131.  
  132.     IF !FILE(cFile)
  133.  
  134.         cFile := GT_Directory(cPath,IF(EMPTY(cType), ;
  135.             cExtent,cType))
  136.  
  137.         EVAL(oGet:Block,PADR(cFile,nLength))
  138.  
  139.     ENDIF
  140.  
  141.     RETURN(!EMPTY(cFile))
  142.  
  143. ENDIF
  144.  
  145. IF .NOT. lSuccess
  146.  
  147.     GT_AskUser('This is not a valid file name',{}, ;
  148.         'Error:',SETCOLOR())
  149.  
  150. ENDIF
  151.  
  152. /*
  153.     End of GT_IsFile()
  154. */
  155. RETURN(lSuccess)
  156.  
  157.