获得给定目录下所有文件夹路径-非递归方法
&&共享以下原创代码：
*!* 获得给定目录下所有文件夹路径
Function GetAllPath
Lparameters tcRoot
Local Array laDirs,aDirCount
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”可以得到给定目录下的所有文件夹相对路径（逗号隔开），这样有一个应用，可以动态设置搜索路径：
lcPathStr=GetAllPath("c:\我的应用程序\")
Set Path To &lcPathStr
&&以上方法有个好处，你随便移动数据表、表单等的位置，系统不会出现找不到文件的错误。新建文件夹时也会将其自动加到搜索路径中，这个方法在我的程序中已经成功应用。代码如下（代码放到主程序开始部分，主程序文件应放到应用程序文件夹的第一层）：
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 &&设置搜索路径
页:
[1]