注册 登录  
 加关注
   显示下一条  |  关闭
温馨提示!由于新浪微博认证机制调整,您的新浪微博帐号绑定已过期,请重新绑定!立即重新绑定新浪微博》  |  关闭

奕克

爱家人爱工作爱生活

 
 
 

日志

 
 

让计算机自动抽取所有压缩包里的指定类型文件  

2010-04-11 19:04:10|  分类: 技术 |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |
          这学期我教大学计算机(二),所有的学生上交过来的实验报告是一个RAR文档,里面包括实验报告和所有的excel等乱七八糟的文件,最后我要写入成绩的是学生的word实验报告。怎么办?总不能我一个个去解压所有的实验报告,不把人累死么?别急,我们别忘了我们有万能的vbs这一武器!好,让你体会一下编程的力量!
        下面是我花了几个小时从网上东抄西抄加调试搞出来的unpack version1:
 
rarpath="e:\\progra~1\\winrar\\unrar.exe "
Set WshShell = WScript.CreateObject("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
CurrentDirectory=WshShell.CurrentDirectory
Set myFolder=FSO.GetFolder(CurrentDirectory)
Set myfiles=myFolder.Files
myfilename=mid(wscript.scriptfullname,len(CurrentDirectory)+2)
For Each myfile in myfiles
        if myfile.name<>myfilename and instr(myfile.name,".rar")<>0 then
        exestr=rarpath & " e -o+ -n*.doc "& CurrentDirectory & "\" & myfile.name
        Wshshell.run  exestr,0,tr
        end if
Next
set wshell=nothing
set fso=nothing
set myfolder=nothing
set myfiles=nothing
 
新建一个文本文档,拷贝这段代码过去,保存时选择类型为所有文件,然后文件名为unpack.vbs。当然记得首先把第一行的rarpath替换成你的winrar安装路径,我的rar安装在e:\program files\winrar。程序利用了里面的exe文件unrar。
当然这是第一个版本,比较粗糙,我后来想想可能还需要区分一下,把解压出来的文件名不带“实验报告”这几个字的word文档再删掉,因为我教的是文化基础,有可能是学生的练习文件。
现在我们来看看改进版的代码如下:。。。。。。
 
rarpath="e:\\progra~1\\winrar\\unrar.exe "
filterflag="tr" 
filterstr="课程设计"
Set WshShell = WScript.CreateObject("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
CurrentDirectory=WshShell.CurrentDirectory
Set myFolder=FSO.GetFolder(CurrentDirectory)
Set myfiles=myFolder.Files
myfilename=mid(wscript.scriptfullname,len(CurrentDirectory)+2)
For Each myfile in myfiles
        if myfile.name<>myfilename and instr(myfile.name,".rar")<>0 then
         if filterflag then
           exestr=rarpath & " e -o+ -n*"& filterstr &"*.doc "& CurrentDirectory & "\" & myfile.name
         else
           exestr=rarpath & " e -o+ -n*.doc "& CurrentDirectory & "\" & myfile.name
         end if
         Wshshell.run  exestr,0,tr
        end if
Next
set wshell=nothing
set fso=nothing
set myfolder=nothing
set myfiles=nothing
 
注意第二行的filterflag是一个标志变量,如果等于tr,则指保留包含第3行filterstr所指出文字的类型文件,如果是false,则保留所有该类型文件。上面代码中是抽出所有名字含“课程设计”的学生word文件。OK! 我以后就可以用这个抽出学生的word实验报告了。。。。
 
看看,看看,我的程序发布了不到2小时,我的一个同事就帮我找出了一个BUG,这说明了什么?测试很重要!他发现学生有些word文档名字都一样的,解压后后面的就覆盖了前面的。。。怎么办?继续改进呗!看看我下一版的程序,它把每个解压出来的文件加上了所在压缩包的名字做为前缀,然后移到了一个doc文件夹中。同时它还能抽取指定扩展名类型的文件,看看第4行的filtertype参数,懂了么?程序如下:
 
rarpath="e:\\progra~1\\winrar\\unrar.exe "
filterflag="tr" 'filter值为false则保留所有doc文件,否则只保留filterstr模式中指出的
filterstr="复习"
filtertype=".doc"
Set WshShell = WScript.CreateObject("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
CurrentDirectory=WshShell.CurrentDirectory
Set myFolder=FSO.GetFolder(CurrentDirectory)
Set myfiles=myFolder.Files
myfilename=mid(wscript.scriptfullname,len(CurrentDirectory)+2)
If fso.FolderExists(CurrentDirectory & "\doc") Then
   fso.DeleteFolder (CurrentDirectory & "\doc")
End If
fso.CreateFolder CurrentDirectory & "\doc"
For Each myfile in myfiles
        if myfile.name<>myfilename and instr(myfile.name,".rar")<>0 then
         if filterflag then
           exestr=rarpath & " e -o+ -or -n*"& filterstr &"*" & filtertype & " "& CurrentDirectory & "\" & myfile.name
         else
           exestr=rarpath & " e -o+ -or -n*.doc "& CurrentDirectory & "\" & myfile.name
         end if
         Wshshell.run  exestr,0,tr
         Set s myfiles=myFolder.Files
         For Each s myfile in s myfiles
           if Instr(s myfile,".doc") then
           OldName = CurrentDirectory &"\"& s myfile.name
           tempstr=left(myfile.name,len(myfile.name)-4)
           NewName = CurrentDirectory &"\doc\"& tempstr &"_"&  s myfile.name
           fso.movefile OldName,newname
           end if
         next
         set s myfiles=nothing
        end if
Next
set wshell=nothing
set fso=nothing
set myfolder=nothing
set myfiles=nothing
msgbox "完工啦!"
 
好了,希望这是个完美的程序了!,不过欢迎继续来找茬!:——)
 
今天感觉这个程序还不大完美,继续改进了一版,这版能够自动读取winrar的安装路径,运行时只要在提示框中输入类似计算机搜索时的*.doc 这样搜索模式就可以了。。。代码如下:
filterstr=inputbox("请输入要解压的文件,如*.doc或者*实验*.doc等")
Set WshShell = WScript.CreateObject("WScript.Shell")
rarpath=WshShell.Regread("HKLM\Software\Microsoft\Windows\CurrentVersion\Uninstall\Winrar archiver\UninstallString")
lenstr=Instr(lcase(rarpath),"uninstall.exe")
rarpath=Left(rarpath,lenstr-1) & "unrar.exe" 
rarpath=chr(34) & rarpath & chr(34) 
Set FSO = CreateObject("Scripting.FileSystemObject")
CurrentDirectory=WshShell.CurrentDirectory
Set myFolder=FSO.GetFolder(CurrentDirectory)
Set myfiles=myFolder.Files
myfilename=mid(wscript.scriptfullname,len(CurrentDirectory)+2)
If fso.FolderExists(CurrentDirectory & "\doc") Then
   fso.DeleteFolder (CurrentDirectory & "\doc")
End If
fso.CreateFolder CurrentDirectory & "\doc"
For Each myfile in myfiles
        if myfile.name<>myfilename and instr(myfile.name,".rar")<>0 then
         exestr=rarpath & " e -o+ -or -n"& filterstr & " "& CurrentDirectory & "\" & myfile.name
         Wshshell.run  exestr,0,tr
         Set s myfiles=myFolder.Files
         For Each s myfile in s myfiles
           if Instr(s myfile,".doc") then
           OldName = CurrentDirectory &"\"& s myfile.name
           tempstr=left(myfile.name,len(myfile.name)-4)
           NewName = CurrentDirectory &"\doc\"& tempstr &"_"&  s myfile.name
           fso.movefile OldName,newname
           end if
         next
         set s myfiles=nothing
        end if
Next
set wshell=nothing
set fso=nothing
set myfolder=nothing
set myfiles=nothing
msgbox "完工啦!"
 
最后的结论是我这样的完美主义者不适合做程序员,总想要做的好一些,完美一些,即使没钱,真正适合于程序员职业的是老板给多少钱,就做什么样程序的人,这样比较不容易累。。。。
  评论这张
 
阅读(124)| 评论(0)
推荐 转载

历史上的今天

在LOFTER的更多文章

评论

<#--最新日志,群博日志--> <#--推荐日志--> <#--引用记录--> <#--博主推荐--> <#--随机阅读--> <#--首页推荐--> <#--历史上的今天--> <#--被推荐日志--> <#--上一篇,下一篇--> <#-- 热度 --> <#-- 网易新闻广告 --> <#--右边模块结构--> <#--评论模块结构--> <#--引用模块结构--> <#--博主发起的投票-->
 
 
 
 
 
 
 
 
 
 
 
 
 
 

页脚

网易公司版权所有 ©1997-2017