home *** CD-ROM | disk | FTP | other *** search
/ Power CD-ROM!! 7 / POWERCD7.ISO / prgmming / clipper / gt_direc.prg < prev    next >
Text File  |  1993-10-14  |  6KB  |  237 lines
  1. /*
  2.     File......: GT_Directory.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.  
  20. /*  $DOC$
  21.  *  $FUNCNAME$
  22.  *       GT_DIRECTORY()
  23.  *  $CATEGORY$
  24.  *       General
  25.  *  $ONELINER$
  26.  *       List files and directories
  27.  *  $SYNTAX$
  28.  *       GT_Directory([<cPath>],[cExtent],[<nTop>],[<nLeft>])
  29.  *  $ARGUMENTS$
  30.  *       <cPath> Path to list initially.
  31.  *
  32.  *       <cExtent> Extentions to list.
  33.  *
  34.  *       <nTop> Fix the window top.
  35.  *
  36.  *       <nLeft> Fix the window left column
  37.  *  $RETURNS$
  38.  *       cFileSelected
  39.  *  $DESCRIPTION$
  40.  *       List files and directories and allow selection of a
  41.  *       file.
  42.  *  $EXAMPLES$
  43.  *  $END$
  44.  */
  45.  
  46. #include "GtClippe.ch"
  47. #include "directry.ch"
  48.  
  49. MEMVAR aNames
  50.  
  51. FUNCTION GT_Directory(cPath,cExtension,nTop,nLeft)
  52.  
  53. LOCAL aFiles := {}
  54. LOCAL cAllExtent := '.*'
  55. LOCAL cColour := SETCOLOR()
  56. LOCAL cDirList := 'D'
  57. LOCAL cDrive := 'C:'
  58. LOCAL cDriveDelimeter := ':'
  59. LOCAL cErrorMsg1 := 'No files or directories could be found.'
  60. LOCAL cExtentDelimeter := '.'
  61. LOCAL cFileSelected := ''
  62. LOCAL cFind := ''
  63. LOCAL cOptions := ;
  64.     'Esc·Exit              A/Z·Find               ─┘·Select              F1·Help'
  65. LOCAL cOtherOptions := ''
  66. LOCAL cParentDir := '..'
  67. LOCAL cPathDelimeter := '\'
  68. LOCAL cScreen := SAVESCREEN(00,00,MAXROW(),MAXCOL())
  69. LOCAL cWildCard1 := '*'
  70. LOCAL nBottom := 00
  71. LOCAL nCount := 0
  72. LOCAL nMaxFiles := 0
  73. LOCAL nRight := 00
  74. LOCAL nSelected := 0
  75.  
  76. PRIVATE aNames := {}
  77.  
  78. Default cPath to ''
  79. Default cExtension to '.*'
  80. Default nTop to 04
  81. Default nLeft to 02
  82.  
  83. //  Trim items
  84. cPath := UPPER(LTRIM(RTRIM(cPath)))
  85. cExtension := UPPER(LTRIM(RTRIM(cExtension)))
  86.  
  87. //  Ensure values are OK
  88. IF EMPTY(cPath)
  89.     // If no path, then specify current directory
  90.     cPath := cPathDelimeter + CURDIR(cDrive)
  91. ENDIF
  92.  
  93. IF RAT(cDriveDelimeter,cPath) > 0
  94.     // Split drive from path
  95.     nCount := RAT(cDriveDelimeter,cPath)
  96.     cDrive := SUBSTR(cPath,1,nCount)
  97.     cPath := SUBSTR(cPath,nCount+1)
  98. ENDIF
  99.  
  100. IF cExtentDelimeter $ cPath
  101.     // It has a file name in it
  102.     cPath := IF(cPathDelimeter $ cPath, ;
  103.         SUBSTR(cPath,1,RAT(cPathDelimeter,cPath)), ;
  104.         cPathDelimeter+CURDIR(cDrive))
  105. ENDIF
  106.  
  107. //  Add \ to end of path if not there
  108. IF SUBSTR(cPath,LEN(cPath),1) != cPathDelimeter
  109.     cPath += cPathDelimeter
  110. ENDIF
  111.  
  112. DO CASE
  113.     // Verify extention
  114.     CASE EMPTY(cExtension)
  115.         // Set ext
  116.         cExtension := cAllExtent
  117.  
  118.     CASE cExtentDelimeter $ cExtension
  119.         // ext OK
  120.  
  121.     OTHERWISE
  122.         cExtension := cExtentDelimeter + ;
  123.             SUBSTR(LTRIM(cExtension),1,3)
  124.  
  125. ENDCASE
  126.  
  127. BEGIN SEQUENCE
  128.     DO WHILE .T.
  129.  
  130.         // Message
  131.         GT_Message('Sorting Files ....','Please wait:')
  132.  
  133.         // Find files and update path
  134.         cFind := cDrive + cPath + cWildCard1 + cAllExtent
  135.         aFiles := DIRECTORY(cFind,cDirList)
  136.  
  137.         // Remove unwanted files
  138.         nMaxFiles := LEN(aFiles)
  139.         nCount := 1
  140.  
  141.         IF cExtension != cAllExtent
  142.  
  143.             DO WHILE .NOT. (nCount > nMaxFiles)
  144.  
  145.                 IF (cExtension $ aFiles[nCount][F_NAME] ;
  146.                     .OR. aFiles[nCount][F_ATTR] = 'D')
  147.  
  148.                     nCount ++
  149.  
  150.                 ELSE
  151.  
  152.                     ADEL(aFiles,nCount)
  153.                     nMaxFiles --
  154.  
  155.                 ENDIF
  156.  
  157.             ENDDO
  158.             ASIZE(aFiles,nMaxFiles)
  159.  
  160.         ENDIF
  161.  
  162.         cFind := cDrive + cPath + cWildCard1 + cExtension
  163.         cOtherOptions := PADR(cFind,MAX(12,LEN(cFind)))
  164.  
  165.         // Find any ?
  166.         nCount := LEN(aFiles)
  167.         nBottom := MIN(nTop+nCount+3,MAXROW()-4)
  168.         nRight := nLeft + LEN(cOtherOptions) + 02
  169.         IF nCount < 1
  170.             GT_AskUser(cErrorMsg1,{},'Error:')
  171.             cFileSelected := ''
  172.             EXIT
  173.         ENDIF
  174.  
  175.         // Build list of files and dirs
  176.         ASIZE(aNames,nCount)
  177.         AEVAL(aFiles,{ | data,elem | aNames[elem] := data[1] })
  178.  
  179.         // Sort
  180.         ASORT(aNames)
  181.  
  182.         // Select one
  183.         RESTSCREEN(00,00,MAXROW(),MAXCOL(),cScreen)
  184.  
  185.         GT_Message(cOptions,'Options:',SETCOLOR(),BOX_SS, ;
  186.             MAXROW()-02,00,MAXROW(),MAXCOL())
  187.  
  188.         nSelected := GT_Choose(aNames,cOtherOptions, ;
  189.             nTop,nLeft,nBottom,nRight)
  190.         RESTSCREEN(00,00,MAXROW(),MAXCOL(),cScreen)
  191.  
  192.         // What did they select ?
  193.         IF nSelected <= 0
  194.             // Esc ?
  195.             cFileSelected := ''
  196.             EXIT
  197.         ENDIF
  198.  
  199.         cFind := STRTRAN(aNames[nSelected],' ','')
  200.         DO CASE
  201.             CASE cFind = cParentDir
  202.                 // Back one level
  203.                 nCount := RAT(cPathDelimeter,SUBSTR(cPath,1,LEN(cPath)-1))
  204.                 cPath := IF(nCount=0,cPathDelimeter,SUBSTR(cPath,1,nCount))
  205.  
  206.             CASE cFind = cExtentDelimeter
  207.                 // Ignore
  208.  
  209.             CASE FILE(cDrive+cPath+cFind)
  210.                 // File selected
  211.                 cFileSelected := cDrive + cPath + cFind
  212.                 EXIT
  213.  
  214.             OTHERWISE
  215.                 // Must be a directory
  216.                 cPath += cFind + cPathDelimeter
  217.  
  218.         ENDCASE
  219.  
  220.     ENDDO
  221.  
  222. ENDSEQUENCE
  223.  
  224. //  Restore the old screen
  225. RESTSCREEN(00,00,MAXROW(),MAXCOL(),cScreen)
  226. SETCOLOR(cColour)
  227.  
  228. //  Blank the keyboard
  229. KEYBOARD CHR(0)
  230. INKEY()
  231.  
  232. /*
  233.     End of GT_Directory()
  234. */
  235. RETURN(cFileSelected)
  236.  
  237.