获得给定目录下所有文件夹路径-非递归方法

阿杰

1. 
   
2. &&共享以下原创代码：
   
3. *!* 获得给定目录下所有文件夹路径
   
4. Function GetAllPath
   
5. Lparameters tcRoot
   
6. Local Array laDirs[1],aDirCount[1]
   
7. Local i, N, m, lnRec, lcTblDir, lcDir, lnCount, lnSelect, lcPathStr
   
8. lnSelect = Select()
   
9. lcTblDir= Sys(2015)
   
10. Create Cursor &lcTblDir (fldsn i(3),flddir C(200))
    
11. Insert Into &lcTblDir. (fldsn,flddir) Values (0,Substr(tcRoot,1,Len(tcRoot)-1))
    
12. i = 0
    
13. m = Len(tcRoot)+1
    
14. lcPathStr = ""
    
15. Do While .T.
    
16. Select Count(*) From (lcTblDir) Where fldsn=i Into Array aDirCount
    
17. If aDirCount(1)=0
    
18.   Exit
    
19. Endif
    
20. Select (lcTblDir)
    
21. Scan For fldsn=i
    
22.   lcDir = Alltrim(flddir) + ""
    
23.   lnCount = Adir(laDirs,lcDir + "*.", "D")
    
24.   lnRec = Recno()
    
25.   For N = 1 To lnCount
    
26.    If !("." $ laDirs(N,1) Or ".." $ laDirs(N,1))
    
27.     Insert Into &lcTblDir. (fldsn,flddir) Values (i+1,lcDir+laDirs(N,1))
    
28.     lcPathStr = lcPathStr + Iif(Empty(lcPathStr),"",",") + Substr(Alltrim(flddir),m)
    
29.    Endif
    
30.   Endfor
    
31.   Go lnRec In (lcTblDir)
    
32. Endscan
    
33. i=i+1
    
34. Enddo
    
35. 
    
36. Select (lnSelect)
    
37. Return lcTblDir
    
38. Endfunc
    
39. 
    
40. &&一、用法：
    
41. kk=GetAllPath("c:")
    
42. Select (kk)
    
43. Brow
    
44. &&二、如果将最后一句改为“RETURN lcPathStr”可以得到给定目录下的所有文件夹相对路径（逗号隔开），这样有一个应用，可以动态设置搜索路径：
    
45. lcPathStr=GetAllPath("c:\我的应用程序")
    
46. Set Path To &lcPathStr
    
47. &&以上方法有个好处，你随便移动数据表、表单等的位置，系统不会出现找不到文件的错误。新建文件夹时也会将其自动加到搜索路径中，这个方法在我的程序中已经成功应用。代码如下（代码放到主程序开始部分，主程序文件应放到应用程序文件夹的第一层）：
    
48. lcSys16 = Sys(16) &&查询当前运行程序名
    
49. lcProgram = Substr(lcSys16, At(":", lcSys16) - 1)
    
50. cDefaultPath=Left(lcProgram, Rat("", lcProgram))
    
51. Cd Left(lcProgram, Rat("", lcProgram)) &&设置默认路径
    
52. cSubDir = GetAllPath(cDefaultPath)
    
53. Set Path To &cSubDir. Additive &&设置搜索路径
    
54. 
    

复制代码