VFP获得给定目录下所有文件夹路径

VFP获得给定目录下所有文件夹路径

FUNCTION GetAllPath

LPARAMETERS tcRoot

LOCAL ARRAY laDirs[1],aDirCount[1]

LOCAL i, n, m, lnRec, lcTblDir, lcDir, lnCount, lnSelect, lcPathStr

lnSelect = SELECT()

lcTblDir= SYS(2015)

CREATE CURSOR &lcTblDir (fldsn I(3),flddir C(200))

INSERT INTO &lcTblDir. (fldsn,flddir) VALUES (0,SUBSTR(tcRoot,1,LEN(tcRoot)-1))

i = 0

m = LEN(tcRoot)+1

lcPathStr = ""

DO WHILE .T.

SELECT COUNT(*) FROM (lcTblDir) WHERE fldSn=i INTO ARRAY aDirCount

IF aDirCount(1)=0

EXIT

ENDIF

SELECT (lcTblDir)

SCAN FOR fldSn=i

lcDir = ALLTRIM(flddir) + "\"

lnCount = ADIR(laDirs,lcDir + "*.", "D")

lnRec = RECNO()

FOR n = 1 TO lnCount

IF !("." $ laDirs(n,1) OR ".." $ laDirs(n,1))

INSERT INTO &lcTblDir. (fldsn,flddir) VALUES (i+1,lcDir+laDirs(n,1))

lcPathStr = lcPathStr + IIF(EMPTY(lcPathStr),"",",") +

SUBSTR(ALLTRIM(flddir),m)

ENDIF

ENDFOR

GO lnRec IN (lcTblDir)

ENDSCAN

i=i+1

ENDDO

SELECT (lnSelect)

RETURN lcTblDir

ENDFUNC

一、用法：

kk=GetAllPath("c:\")

select (kk)

brow

二、如果将最后一句改为“RETURN lcPathStr”可以得到给定目录下的所有文件夹相对路径（逗号隔开），这样有一个应用，可以动态设置搜索路径：

lcPath=GetAllPath("c:\我的应用程序\")

set path to &lcPath

以上方法有个好处，你随便移动数据表、表单等的位置，系统不会出现找不到文件的错误。新建文件夹时也会将其自动加到搜索路径中，这个方法在我的程序中已经成功应用。代码如下（代码放到主程序开始部分，主程序文件应放到应用程序文件夹的第一层）：

*-----------------------------------

lcSys16 = SYS(16) &&查询当前运行程序名

lcProgram = SUBSTR(lcSys16, AT(":", lcSys16) - 1)

cDefaultPath=LEFT(lcProgram, RAT("\", lcProgram))

CD LEFT(lcProgram, RAT("\", lcProgram)) &&设置默认路径

cSubDir = GetAllPath(cDefaultPath)

SET PATH TO &cSubDir. ADDITIVE &&设置搜索路径

*-----------------------------------