批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程
[批处理文件精品]批处理版照片整理器[批处理文件精品]纯批处理备份&还原驱动在线第三方下载
返回列表 发帖

[原创] VBS清除指定文件类型的文件(安全删除,艳照删除用,能找回来算你狠)

清除指定文件类型的文件(安全删除,能找回来算你狠) By Yu2n 2013-07-30
功能:清理相机SD卡内艳照。
原理:重命名+复写+删除
作者:Yu2n
  1. ' Safa_Clear_Folder.vbs
  2. ' +----------------------------------------------------------------------------+
  3. ' | 清除指定文件类型的文件(安全删除,能找回来算你狠) By Yu2n 2013-07-30 |
  4. ' +----------------------------------------------------------------------------+
  5. On Error Resume Next
  6. Dim sTitle, sMeDir, sFolder, sFileType, sQuery
  7. sTitle = "文件完全删除工具"
  8. sMeDir = Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName,"\")-1)
  9. ' 取得文件夹路径
  10. sFolder = BrowseForFolder("警告:删除文件后,工具软件无法找回!!" & vbCrLf & vbCrLf & "请选择要清理的文件夹:")
  11. If sFolder = "" Then sFolder = sMeDir
  12. ' 取得文件类型
  13. sFileType = InputBox(  "請輸入要清理的文件类型:" & vbCrLf & _
  14.                     vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf & _
  15.                     "使用正则表达式,默认清理所有文件夹", _
  16.                     sTitle, "(jpg|mp4)")
  17. ' 最后确认
  18. sQuery = Msgbox("警告:删除文件后,工具软件无法找回!" & vbCrLf & vbCrLf & _
  19.                 "清理文件夹:" & sFolder & " (默认本程序位置)" & vbCrLf & vbCrLf & _
  20.                 "是否确认?" & vbCrLf , _
  21.                 vbYesNo + 64, sTitle)
  22.                
  23. If Not sQuery = vbYes Then WScript.Quit
  24. ' 清理
  25. CleraFolder sFolder, sFileType
  26. '结束
  27. Msgbox "提示:操作完成!            ", 64, sTitle
  28. ' +----------------------------------------------------------------------------+
  29. ' | 清除指定文件类型的文件(安全删除) |
  30. ' +----------------------------------------------------------------------------+
  31. Function CleraFolder(ByVal strFolderPath, ByVal strFileType)
  32.     Dim oScanDir, sFileList, sFolderList
  33.     ' 创建对象
  34.     Set oScanDir = New Scan_Folder
  35.     ' 指定文件夹
  36.     oScanDir.FolderSpec strFolderPath
  37.     ' 设定扫描最大层数(可为空。默认扫描所有子文件夹)
  38.     'oScanDir.MaxLayer 2
  39.     ' 指定文件类型(可为空。正则表达式规则,默认则返回所有文件)
  40.     oScanDir.FileType_RegExPatternt strFileType
  41.     ' 获取结果(必填。GetFileList返回文件列表,GetFolderList返回目录列表,GetEmptyFolderList返回空目录列表)
  42.     sFileList = oScanDir.GetFileList
  43.     ' 结束对象
  44.     oScanDir.Close
  45.    
  46.     'WScript.Echo "文件列表:" & vbCrLf & sFileList
  47.    
  48.     ' 对所有子文件进行处理
  49.     Dim arrFilePath
  50.     arrFilePath = Split(sFileList, vbCrLf, -1, vbTextCompare)
  51.     For i = 0 To UBound(arrFilePath)
  52.         strFilePath = arrFilePath(i)
  53.         'WScript.Echo "strFilePath  _" & strFilePath & "_"
  54.         ClearFileDate strFilePath
  55.     Next
  56.    
  57.     ' 清空文件夹,删除所有子目录
  58.     REM Set fso = CreateObject("Scripting.FileSystemObject")
  59.     REM If (fso.FolderExists( strFolderPath )) Then
  60.         REM fso.GetFolder( strFolderPath ).attributes = 0
  61.         REM fso.GetFolder( strFolderPath ).delete
  62.     REM End If
  63.     REM If Not fso.FolderExists( strFolderPath ) Then fso.CreateFolder( strFolderPath )
  64.     REM Set fso = Nothing
  65. End Function
  66. ' +----------------------------------------------------------------------------+
  67. ' | 清除文件 |
  68. ' +----------------------------------------------------------------------------+
  69. Function ClearFileDate(ByVal sFilePath)
  70.     Dim fso, oFile
  71.     Set fso = CreateObject("Scripting.FileSystemObject")
  72.     If fso.FileExists(sFilePath) = True Then
  73.         Set oFile = fso.GetFile(sFilePath)
  74.         oFile.Attributes = 0
  75.         sFolderPath = fso.GetParentFolderName(oFile)
  76.         ' 重命名
  77.         sFileNameNew = GetGUID()
  78.         oFile.Name = sFileNameNew
  79.         sFilePathNew = sFolderPath & "\" & sFileNameNew
  80.         ' 覆盖数据
  81.         SetLocale "en-us"
  82.         set wtxt = fso.OpenTextFile(sFilePathNew, 2, True, -1)
  83.         wtxt.Write sFileNameNew & VbCrLf & Now()
  84.         wtxt.Close()
  85.         ' 删除
  86.         Set oFile = fso.GetFile(sFilePathNew)
  87.         oFile.Delete
  88.     End If
  89. End Function
  90. ' +----------------------------------------------------------------------------+
  91. ' | 递归查找文件类:可自定义扫描目录层数、文件类型 |
  92. ' +----------------------------------------------------------------------------+
  93. Class Scan_Folder
  94.     ' ==============================================================================================================
  95.     ' 类初始化
  96.     ' ==============================================================================================================
  97.     ' 公共变量
  98.     Private fso, regEx, sFolderSpec, sParentFolderLayer, sMaxLayer, sFileType_RegExPatternt, sFileType, sFileList, sFolderList, sEmptyFolderList
  99.     Private ScanFolderOnly, ScanSubFolder
  100.     '类初始化事件
  101.     Private Sub Class_Initialize
  102.         Set fso = CreateObject("Scripting.FileSystemObject")
  103.         Set regEx = CreateObject("VBScript.RegExp")     ' 建立正则表达式。
  104.             regEx.IgnoreCase = True     ' 设置是否区分大小写。
  105.             regEx.Global = True         ' 设置全局替换。
  106.             regEx.MultiLine = True      ' 设置多行匹配模式
  107.         ScanFolderOnly = True           ' 仅扫描文件夹(提高效率)
  108.         ScanSubFolder = True            ' 扫描子文件夹
  109.     End Sub
  110.     ' ==============================================================================================================
  111.     ' 获取设定
  112.     ' ==============================================================================================================
  113.     ' 设置扫描目录
  114.     Public Function FolderSpec(ByVal strFolderSpec)
  115.         sFolderSpec = strFolderSpec
  116.     End Function
  117.     ' 设置最大扫描目录层数
  118.     Public Function MaxLayer(ByVal strMaxLayer)
  119.         sMaxLayer = strMaxLayer
  120.     End Function
  121.     ' 设置扫描的文件类型
  122.     Public Function FileType_RegExPatternt(ByVal strFileType_RegExPatternt)
  123.         sFileType_RegExPatternt = strFileType_RegExPatternt
  124.     End Function
  125.     ' 获取文件夹列表(包括空文件夹)
  126.     Public Function GetFolderList()
  127.         ScanFolderOnly = True
  128.         Scan_Layer sFolderSpec
  129.         GetFolderList = sFolderList
  130.     End Function
  131.     ' 获取空文件夹列表
  132.     Public Function GetEmptyFolderList()
  133.         ScanFolderOnly = False
  134.         Scan_Layer sFolderSpec
  135.         GetEmptyFolderList = sEmptyFolderList
  136.     End Function
  137.     ' 获取文件列表
  138.     Public Function GetFileList()
  139.         ScanFolderOnly = False
  140.         Scan_Layer sFolderSpec
  141.         GetFileList = sFileList
  142.     End Function
  143.     ' 关闭控件
  144.     Public Sub Close()
  145.         Set fso = Nothing
  146.         Set regEx = Nothing
  147.     End Sub
  148.     ' ==============================================================================================================
  149.     ' 私有函数
  150.     ' ==============================================================================================================
  151.     ' 递归扫描
  152.     Private Function Scan_Layer(strFolderspec)
  153.         On Error Resume Next
  154.         If Not Right(strFolderspec,1) = "\" Then strFolderspec = strFolderspec & "\"
  155.         If Not IsEmpty(sFolderList) Then sFolderList = sFolderList & vbCrLf
  156.         sFolderList = sFolderList & strFolderspec
  157.         ' 文件夹对象
  158.         Dim oFolder, oSubFolderItems, oSubFileItems, oSubFolder, oSubFile
  159.         Set oFolder = fso.GetFolder(strFolderspec)
  160.         ' 是否扫描 当前文件夹 的 子文件
  161.         If ScanFolderOnly = False Then
  162.             ' 子文件对象集合
  163.             Set oSubFileItems = oFolder.Files
  164.             ' 查找当前文件夹 的 文件
  165.             If oSubFileItems.Count <> 0 Then
  166.                 For Each oSubFile In oSubFileItems
  167.                     If IsEmpty(sFileType_RegExPatternt) Or (sFileType_RegExPatternt = "") Then
  168.                         If Not IsEmpty(sFileList) Then sFileList = sFileList & vbCrLf
  169.                         sFileList = sFileList & oSubFile.Path
  170.                     Else
  171.                         ' 过滤文件类型(适用正则表达式)
  172.                         regEx.Pattern = sFileType_RegExPatternt
  173.                         If regEx.Execute( fso.GetExtensionName(oSubFile) ).Count > 0 Then
  174.                             If Not IsEmpty(sFileList) Then sFileList = sFileList & vbCrLf
  175.                             sFileList = sFileList & oSubFile.Path
  176.                         End If
  177.                     End If
  178.                 Next
  179.             End If
  180.         End If
  181.         ' 查找当前文件夹 的 子文件夹
  182.         Set oSubFolderItems = oFolder.SubFolders        ' 子文件夹对象集合
  183.         ' --------没有子文件夹时
  184.         If oSubFolderItems.Count = 0 Then
  185.             ' --------也没有子文件时(此文件夹为空)
  186.             If ScanFolderOnly = False Then
  187.                 If oSubFileItems.Count = 0 Then
  188.                     If Not IsEmpty(sEmptyFolderList) Then sEmptyFolderList = sEmptyFolderList & vbCrLf
  189.                     sEmptyFolderList = sEmptyFolderList & strFolderspec
  190.                 End If
  191.             End If
  192.         Else
  193.             ' 限制递归的最大层数
  194.             If Not (IsEmpty(sMaxLayer) Or (sMaxLayer = "")) Then
  195.                 Dim s, f, n
  196.                 s = Replace(strFolderspec, sFolderSpec, "", vbTextCompare, -1, 1)
  197.                 f = "\"
  198.                 n = (len(s)-len(replace(s,f,"",vbTextCompare,-1,1)))/len(f)    ' 统计字符串中某一单词出现次数
  199.                 If sMaxLayer < n Then ScanSubFolder = False
  200.             Else
  201.                 ScanSubFolder = True
  202.             End If
  203.             If ScanSubFolder = True Then
  204.                 ' ----有子文件夹时,递归查找
  205.                 For Each oSubFolder In oSubFolderItems
  206.                     'sFolderList = sFolderList & oSubFolder.Path & vbCrLf
  207.                     Scan_Layer oSubFolder.Path
  208.                 Next
  209.             End If
  210.         End If
  211.     End Function
  212. End Class
  213. ' 实例
  214. Function DemoScanDir()
  215.     Dim oScanDir, sInfo
  216.     ' 创建对象
  217.     Set oScanDir = New Scan_Folder
  218.     ' 指定文件夹
  219.     oScanDir.FolderSpec "G:\DCIM\.BACKUP\20130717"
  220.     ' 设定扫描最大层数(可为空。默认扫描所有子文件夹)
  221.     oScanDir.MaxLayer 1
  222.     ' 指定文件类型(可为空。正则表达式规则,默认则返回所有文件)
  223.     oScanDir.FileType_RegExPatternt "(jpg|mp4|css|7z)"
  224.     ' 获取结果(必填。GetFileList返回文件列表,GetFolderList返回目录列表,GetEmptyFolderList返回空目录列表)
  225.     DemoScanDir = oScanDir.GetFileList
  226.     ' 结束对象
  227.     oScanDir.Close
  228. End Function
  229. ' +----------------------------------------------------------------------------+
  230. ' | 生成GUID http://demon.tw/programming/generate-guid-in-vbs.html  |
  231. ' +----------------------------------------------------------------------------+
  232. Function GetGUID()
  233.     Set TypeLib = CreateObject("Scriptlet.TypeLib")
  234.     GetGUID = Left(TypeLib.Guid,38)
  235. End Function
  236. ' +----------------------------------------------------------------------------+
  237. ' | 浏览文件夹 ' File:Dialog.vbs (WSH sample in VBScript)   |
  238. ' |              Author:(c) G. Born                         |
  239. ' +----------------------------------------------------------------------------+
  240. Function BrowseForFolder(ByVal sTips)
  241.     Const BIF_returnonlyfsdirs = &H0001
  242.     Const BIF_editbox= &H0010
  243.     Dim oShell, oFolder
  244.     BrowseForFolder = ""
  245.     Set oShell = CreateObject("Shell.Application")
  246.     Set oFolder = oShell.BrowseForFolder(&H0, sTips, BIF_editbox + BIF_returnonlyfsdirs)
  247.     If InStr(1, TypeName(oFolder), "Folder") > 0 Then
  248.         BrowseForFolder = oFolder.Items().Item().Path
  249.     End If
  250. End Function
复制代码
1

评分人数

『千江有水千江月』千江有水,月映千江;万里无云,万里青天。    http://yu2n.qiniudn.com/

之前有写一个BAT版,写这个是个人爱好。
里面那个类是自己写的,有点烂。

BAT代码如下:
  1. :: Safa_Clear_Folder.bat
  2. @echo off
  3. setlocal enableDelayedExpansion
  4. rem ---要清理的文件夹目录
  5. echo,警告:删除文件后,工具软件无法找回!!
  6. set /p "wkDir=请输入要清理的文件夹:"
  7. if not exist "!wkDir!" exit
  8. cls
  9. echo,警告:删除文件后,工具软件无法找回!
  10. echo,即将清理文件夹:!wkDir!
  11. pause
  12. rem ---扫描文件夹
  13. for /f "tokens=1 delims==" %%i in ('dir /a-d /b /s "%wkDir%"') do (
  14.     set "wkDir=%%~dpi"
  15.     set "wkDir=!wkDir:~0,-1!"
  16.     set "wkFileName=%%~nxi"
  17.     set "wkFilePath=%%~i"
  18.    
  19.     REM ---取消文件属性
  20.     attrib -a -s -h -r "%%~fi"
  21.    
  22.     REM ---文件名随机重命名
  23.     call :get_sRandom
  24.     if exist "!wkDir!\!sRandom!" (
  25.         ping -n 3 127.1 >nul 2>nul & call :get_sRandom
  26.     )
  27.     rename "!wkFilePath!" "!sRandom!"
  28.    
  29.     REM ---覆写及删除文件
  30.     echo,!sRandom!>"!wkDir!\!sRandom!"
  31.     echo,DEL !wkDir!\!sRandom!
  32.     del /q "!wkDir!\!sRandom!"
  33. )
  34. echo,清理完成!!
  35. pause
  36. rem ---生成随机字符串
  37. goto :eof
  38. :get_sRandom
  39.     set "sRandom="
  40.     set "sTime=%date:~0,4%%date:~5,2%%date:~8,2%%time:~0,2%%time:~3,2%%time:~6,2%%time:~9,2%"
  41.     set "p=ABCDEFGHIJ"
  42.     for /l %%a in (0 1 9) do set "#!random!!random!!random!=!p:~%%a,1!"
  43.     for /f "tokens=1,2 delims==" %%a in ('set #') do (set "%%a="&set "sRandom=!sRandom!%%b")
  44.     set "sRandom=!sTime!!sRandom!"
复制代码
『千江有水千江月』千江有水,月映千江;万里无云,万里青天。    http://yu2n.qiniudn.com/

TOP

前排支持   
综合型编程论坛
Writing Code That Nobody Else Can Read.

TOP

其实重复 for + 'set #' 累计耗时是比较多的。
  1. @echo off
  2. set t=%time%
  3. setlocal enabledelayedexpansion
  4. for /l %%a in (1,1,100) do (call :get_sRandom)
  5. echo %t% %time%
  6. pause
  7. rem ---生成随机字符串
  8. :get_sRandom
  9.     set "sRandom="
  10.     set "sTime=%date:~0,4%%date:~5,2%%date:~8,2%%time:~0,2%%time:~3,2%%time:~6,2%%time:~9,2%"
  11.     set "p=ABCDEFGHIJ"
  12.     for /l %%a in (0 1 9) do set "#!random!!random!!random!=!p:~%%a,1!"
  13.     for /f "tokens=1,2 delims==" %%a in ('set #') do (set "%%a="&set "sRandom=!sRandom!%%b")
  14.     set "sRandom=!sTime!!sRandom!"
  15.     echo !sRandom!
  16.     goto :eof
复制代码
另外写了一个随机提取的方法,对比下时间:
  1. @echo off
  2. set t=%time%
  3. setlocal enabledelayedexpansion
  4. for /l %%a in (1,1,100) do (call :get_sRandom)
  5. echo %t% %time%
  6. pause
  7. rem ---生成随机字符串
  8. :get_sRandom
  9.     set "sRandom="
  10.     set "sTime=%date:~0,4%%date:~5,2%%date:~8,2%%time:~0,2%%time:~3,2%%time:~6,2%%time:~9,2%"
  11.     set "p=ABCDEFGHIJ"
  12.     for /l %%a in (9,-1,1) do (
  13.         set /a R=!random! %% %%a
  14.         for %%b in (!R!) do set GetSR=!p:~%%b,1!
  15.         for %%c in (!GetSR!) do set p=!p:%%c=!
  16.         set sRandom=!sRandom!!GetSR!
  17.     )
  18.     set "sRandom=!sTime!!sRandom!"
  19.     echo !sRandom!
  20.     goto :eof
复制代码
综合型编程论坛
Writing Code That Nobody Else Can Read.

TOP

回复 4# 523066680

不错,这部分代码你的效率很高,比我的高大约十倍。
『千江有水千江月』千江有水,月映千江;万里无云,万里青天。    http://yu2n.qiniudn.com/

TOP

其实重复 for + 'set #' 累计耗时是比较多的。另外写了一个随机提取的方法,对比下时间:
523066680 发表于 2013-7-31 17:22



    既然如此,来个高效删除的BAT版文件清除删除器
  1. :: Safe_Clear_Folder.cmd
  2. @echo off
  3. setlocal enableDelayedExpansion
  4. rem ---要清理的文件夹目录
  5. echo,警告:删除文件后,工具软件无法找回!!
  6. set /p "wkDir=请输入要清理的文件夹:"
  7. if not exist "!wkDir!" exit
  8. cls
  9. echo,警告:删除文件后,工具软件无法找回!
  10. echo,即将清理文件夹:!wkDir!
  11. pause
  12. rem ---扫描文件夹
  13. for /f "tokens=1 delims==" %%i in ('dir /a-d /b /s "%wkDir%"') do (
  14.     set "wkDir=%%~dpi"
  15.     set "wkDir=!wkDir:~0,-1!"
  16.     set "wkFileName=%%~nxi"
  17.     set "wkFilePath=%%~i"
  18.    
  19.     REM ---取消文件属性
  20.     attrib -a -s -h -r "%%~fi"
  21.    
  22.     REM ---文件名随机重命名
  23.     call :get_sRandom
  24.     if exist "!wkDir!\!sRandom!" (
  25.         ping -n 3 127.1 >nul 2>nul & call :get_sRandom
  26.     )
  27.     rename "!wkFilePath!" "!sRandom!"
  28.    
  29.     REM ---覆写及删除文件
  30.     echo,!sRandom!>"!wkDir!\!sRandom!"
  31.     echo,DEL !wkDir!\!sRandom!
  32.     del /q "!wkDir!\!sRandom!"
  33. )
  34. echo,清理完成!!
  35. pause
  36. rem ---生成随机字符串
  37. goto :eof
  38. :get_sRandom
  39.     set "sRandom="
  40.     set "sTime=%date:~0,4%%date:~5,2%%date:~8,2%%time:~0,2%%time:~3,2%%time:~6,2%%time:~9,2%"
  41.     set "p=ABCDEFGHIJ"
  42.     for /l %%a in (9,-1,1) do (
  43.         set /a R=!random! %% %%a
  44.         for %%b in (!R!) do set GetSR=!p:~%%b,1!
  45.         for %%c in (!GetSR!) do set p=!p:%%c=!
  46.         set sRandom=!sRandom!!GetSR!
  47.     )
  48.     set "sRandom=!sTime!!sRandom!"
  49.     goto :eof
复制代码
『千江有水千江月』千江有水,月映千江;万里无云,万里青天。    http://yu2n.qiniudn.com/

TOP

返回列表