以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.com/bbs/index.asp)
--  专家坐堂  (http://foxtable.com/bbs/list.asp?boardid=2)
----  [求助] 多层目录查找图片 运行外部批处理文件如何实现?【已解决】  (http://foxtable.com/bbs/dispbbs.asp?boardid=2&id=93658)

--  作者:tyconlance
--  发布时间:2016/12/3 15:01:00
--  [求助] 多层目录查找图片 运行外部批处理文件如何实现?【已解决】

图片点击可在新窗口打开查看此主题相关图片如下:截图2.jpg
图片点击可在新窗口打开查看

图片点击可在新窗口打开查看此主题相关图片如下:截图.jpg
图片点击可在新窗口打开查看

老师好  想设计一段找在多层目录里找产品照片的代码,用下面帮助里的办法试了几次没能生成目录清单(直接双击可以生成),能否帮忙指点一下问题出在哪里?
http://www.foxtable.com/help/index.htm?page=0353.htm 
我找了一下帮助里好像没有直接生成多级目录清单的函数或是方法,于是想借助外部批处理文件
思路是
1. 提供做好一个批处理文件(dir.bat, 里面的内容是dir *.jpg /s /b > dirlist.txt), 存在项目文件夹里
2. 然后从窗口文本框里获取待找路径及照片名称清单,
3. 然后用FileSys.CopyFile(ProjectPath & "dir.bat",scdir & "\\dir.bat",True) 把dir.bat 复制到待查找目录下面
4. 然后用Process运行外部程序:
试了两个方法用不用Arguments 都是只能copy过去,但执行后不能自动生成dirlist.txt
方法1:
Dim Proc As New Process 
Proc.File ="cmd.exe"
Proc.Arguments = "D:\\Users\\Desktop\\根目录\\dir.bat" \'这里先不动态合成,直接用实际目录测试
Proc.Start() \'打开文件
Proc.WaitForExit

方法2:
Dim Proc As New Process 
Proc.File = "D:\\Users\\Desktop\\根目录\\dir.bat" \'\'这里先不动态合成,直接用实际目录测试
Proc.Start() \'打开文件
Proc.WaitForExit

5. 读取生成的dirlist.txt, 再用FileExists 和 CopyFile 查找及复制找到的图片到指定文件夹
6. 最后用DeleteFile 删除 待查找文件夹里的 dirlist.txt 和 dir.bat



[此贴子已经被作者于2016/12/5 12:37:58编辑过]

--  作者:有点蓝
--  发布时间:2016/12/3 15:16:00
--  
参考:http://www.foxtable.com/webhelp/scr/0331.htm
--  作者:tyconlance
--  发布时间:2016/12/3 17:51:00
--  
那里也看过了 好像很很困难。。。 实际用的目录一般都有4、5层子目录,用GetDirectories , GetFiles 只能看当前目录,多级子目录不能直接看,也不知道有没有办法通过套用实现?
--  作者:有点色
--  发布时间:2016/12/4 16:12:00
--  

为什么要用bat,直接用foxtable代码处理就可以的。

 

1、设计一个内部函数,名称为lsitfile,代码:

 

Dim pth As String = args(0)
For Each fl As String In filesys.GetFiles(pth)
    output.show(fl)
Next
For Each dr As String In FileSys.GetDirectories(pth)
    Functions.Execute("listfile",dr)
Next

 

2、调用函数,这样就可以列出data文件夹下所有的文件了

 

Functions.Execute("listfile","c:\\data")


--  作者:tyconlance
--  发布时间:2016/12/4 22:15:00
--  
多谢老师,看起来这个自定义函数还调用了自己本身,有点晕了, 还是不太会用。。。
我想把利用这个自定义函数一次性返回一个集合,或是把每个循环返回的值存在集合里该怎么做?
我用下面的代码返回一个集合,可不知道为什么返回的names集合只剩下当前目录的文件清单了?
Dim pth As String = args(0) 
Dim names As New List(Of String)
For Each fl As String In filesys.GetFiles(pth) 
    names.Add(fl)
Next
For Each dr As String In FileSys.GetDirectories(pth) 
    Functions.Execute("Listfiles",dr) 
Next
Return names
下面是在函数外面逐个返回到一个集合,好像这样语法本身就有问题。。 
Dim tnames As New List(Of String)
tnames.add(Functions.Execute("Listfiles","c:\\data"))






--  作者:有点酸
--  发布时间:2016/12/4 23:40:00
--  
要是需要将文集放在一个集合的话,函数改为:

Dim pth As String = args(0)
Dim nms As List(of String) = args(1)
For Each fl As String In filesys.GetFiles(pth)
    nms.add(fl)
Next
For Each dr As String In FileSys.GetDirectories(pth)
    Functions.Execute("listfile",dr.nms)
Next

调用函数:
dim nms As New List(of string)
Functions.Execute("listfile","c:\\data",nms)

--  作者:tyconlance
--  发布时间:2016/12/4 23:42:00
--  
我试着用了一种变通的办法,设想一般我们公司的文件夹也就四、五层,我就预设了八层,不用getfiles, 只是反复套用getdirectories,fileexist,和copyfile, 虽说有点繁琐,但试运行了一下还勉强能凑合,
试搜了1000个文件出来,花了1分钟左右, 如果找不到更好的办法,就这么将就着用着先

图片点击可在新窗口打开查看此主题相关图片如下:找图片.jpg
图片点击可在新窗口打开查看

Dim stx As String = Forms("FINDPIC").Controls("TBoxPath").Text
Dim ctx As String = Forms("FINDPIC").Controls("TBoxPathSave").Text
If DataTables("FINDLIST").DataRows(0).IsNull("orignialname") Then
    MessageBox.Show("把待搜清单粘贴到这里","提示",MessageBoxButtons.OK,MessageBoxIcon.Information)
    Forms("FINDPICLST").Open
    Return
Else If stx.Length < 2  Then
    MessageBox.Show("你打算搜哪个文件夹?","提示",MessageBoxButtons.OK,MessageBoxIcon.Information)
    Return
Else If ctx.Length < 2 Then
    MessageBox.Show("你打算存在哪里?","提示",MessageBoxButtons.OK,MessageBoxIcon.Information)
    Return
End If
MessageBox.Show("目录层数比较的话会慢些,耐性等一会儿吧","提示",MessageBoxButtons.OK,MessageBoxIcon.Information)
Dim dir0 As String = Forms("FINDPIC").Controls("TBoxPath").Text
Dim savepath As String = Forms("FINDPIC").Controls("TBoxPathSave").Text
Dim picfmt As String =Forms("FINDPIC").Controls("fmtTexbox").text \' 从单选框获得文件文件扩展名存
Dim names As List(Of String)
names = DataTables("FINDLIST").GetValues("orignialname")\' 获得原始待搜文件清单
For i As Integer  = 1 To names.Count-1
    names(i) = "\\" & names(i) & picfmt \' 加上扩展名
Next
names.RemoveAt(0) \' 去掉第一个空值
\'根目录搜索
For Each name As String In names
    If FileSys.FileExists(dir0 & name) Then
        FileSys.CopyFile( dir0 & name, savepath & name, True)
    End If
Next
\'二级目录搜索
For Each dir1 As String In FileSys.GetDirectories(dir0)
    For Each name As String In names
        If FileSys.FileExists(dir1 & name) Then
            FileSys.CopyFile( dir1 & name, savepath & name, True)
        End If
    Next
Next
\'三级目录搜索
For Each dir1 As String In FileSys.GetDirectories(dir0)
    For Each dir2 As String In FileSys.GetDirectories(dir1)
        For Each name As String In names
            If FileSys.FileExists(dir2 & name) Then
                FileSys.CopyFile( dir2 & name, savepath & name, True)
            End If
        Next
    Next
Next
\'四级目录搜索
For Each dir1 As String In FileSys.GetDirectories(dir0)
    For Each dir2 As String In FileSys.GetDirectories(dir1)
        For Each dir3 As String In FileSys.GetDirectories(dir2)
            For Each name As String In names
                If FileSys.FileExists(dir3 & name) Then
                    FileSys.CopyFile( dir3 & name, savepath & name, True)
                End If
            Next
        Next
    Next
Next

\'五级目录搜索
For Each dir1 As String In FileSys.GetDirectories(dir0)
    For Each dir2 As String In FileSys.GetDirectories(dir1)
        For Each dir3 As String In FileSys.GetDirectories(dir2)
            For Each dir4 As String In FileSys.GetDirectories(dir3)
                For Each name As String In names
                    If FileSys.FileExists(dir4 & name) Then
                        FileSys.CopyFile( dir4 & name, savepath & name, True)
                    End If
                Next
            Next
        Next
    Next
Next
\'六级目录搜索
For Each dir1 As String In FileSys.GetDirectories(dir0)
    For Each dir2 As String In FileSys.GetDirectories(dir1)
        For Each dir3 As String In FileSys.GetDirectories(dir2)
            For Each dir4 As String In FileSys.GetDirectories(dir3)
                For Each dir5 As String In FileSys.GetDirectories(dir4)
                    For Each name As String In names
                        If FileSys.FileExists(dir5 & name) Then
                            FileSys.CopyFile( dir5 & name, savepath & name, True)
                        End If
                    Next
                Next
            Next
        Next
    Next
Next
\'七级目录搜索
For Each dir1 As String In FileSys.GetDirectories(dir0)
    For Each dir2 As String In FileSys.GetDirectories(dir1)
        For Each dir3 As String In FileSys.GetDirectories(dir2)
            For Each dir4 As String In FileSys.GetDirectories(dir3)
                For Each dir5 As String In FileSys.GetDirectories(dir4)
                    For Each dir6 As String In FileSys.GetDirectories(dir5)
                        For Each name As String In names
                            If FileSys.FileExists(dir6 & name) Then
                                FileSys.CopyFile( dir6 & name, savepath & name, True)
                            End If
                        Next
                    Next
                Next
            Next
        Next
    Next
Next
\'八级目录搜索
For Each dir1 As String In FileSys.GetDirectories(dir0)
    For Each dir2 As String In FileSys.GetDirectories(dir1)
        For Each dir3 As String In FileSys.GetDirectories(dir2)
            For Each dir4 As String In FileSys.GetDirectories(dir3)
                For Each dir5 As String In FileSys.GetDirectories(dir4)
                    For Each dir6 As String In FileSys.GetDirectories(dir5)
                        For Each dir7 As String In FileSys.GetDirectories(dir6)
                            For Each name As String In names
                                If FileSys.FileExists(dir7 & name) Then
                                    FileSys.CopyFile( dir7 & name, savepath & name, True)
                                End If
                            Next
                        Next
                    Next
                Next
            Next
        Next
    Next
Next
MessageBox.Show("搜完了","提示",MessageBoxButtons.OK,MessageBoxIcon.Information)
DataTables("FINDLIST").DeleteFor("orignialname Is Not Null")

--  作者:有点酸
--  发布时间:2016/12/4 23:45:00
--  
6楼方法应该可以的啊
--  作者:有点蓝
--  发布时间:2016/12/5 8:43:00
--  
函数调用自己是递归的用法,如:http://www.foxtable.com/webhelp/scr/2416.htm

不能够因为看不懂而害怕使用,因噎废食哦,你测试6楼的代码有什么问题吗。

--  作者:tyconlance
--  发布时间:2016/12/5 12:35:00
--  
多谢老师赐教 6楼的代码测试过了 没有问题 很好用 
是的 是的 有空要再好好研究一下自定义函数 和 递归用法, 感觉这两个东东能大大提高工作效率啊