注册
登录
| 关键词： var filetitle 文件 binary 文件名 ascb midb filename 标题 path |
有一同事昨天发来救命的邮件，说她的一个工作文件夹下的2000多个文件都变成了file0001.chk,file0002.chk......，那可是她几年的心血，如无法还原会抓狂的。 分析原因估计是病毒或其他原因造成FAT错误，电脑检查磁盘时进行修复，就成这个样子了，试着把几个文件扩展名改为DOC或XLS，发现文件还是可以打开的，看来部分文件还是可以拯救的，只是2000个文件，如果一个一个试，岂不要等到地老天荒？况且即使扩展名改好了，文件名都是file???的格式，以后谁知道哪个文件是什么内容，想想还是写个小脚本来干这活吧。 思路是：建一个空的目标文件夹，然后读取源文件夹的每个文件，判断文件类型，读取文件标题，如文件标题不为空，则用文件标题作为文件名，最后把源文件用新文件名复制到目标文件夹。具体代码如下，大家如有更好的办法要告诉我哦。 'filename: repair.vbsDim arrHeaders(34) '源目录 var_source_path="d:\test"'处理后目录 var_destination_path="d:\ok"Set objShell = CreateObject("Shell.Application") set fso=wscript.createobject("scripting.FileSystemObject") Set objFolder = objShell.Namespace(var_source_path)'加一个计数器，用在修改后的文件名后，以防止两个文件标题相同而导致文件名相同的情况。 g_count=1 For Each strFileName in objFolder.Items For i = 0 to 33 arrHeaders(i) = objFolder.GetDetailsOf(objFolder.Items, i) if arrHeaders(i)="名称" then '获取文件名 var_filename=trim(objFolder.GetDetailsOf(strFileName, i) ) end if if arrHeaders(i)="标题" then '获取文件中的标题属性，如为WORD或POWERPOINT一般都有标题 var_filetitle=objFolder.GetDetailsOf(strFileName, i) end if Next var_binary=ReadBinaryFile(var_source_path & "\" & var_filename) '由于可能用标题作为文件名，要把标题中不能做为文件名的字符去掉。 var_filetitle=replace(var_filetitle,":","") var_filetitle=replace(var_filetitle,"/","") var_filetitle=replace(var_filetitle,"\","") var_filetitle=replace(var_filetitle,"*","") var_filetitle=replace(var_filetitle,"?","") var_filetitle=replace(var_filetitle,"""","") var_filetitle=replace(var_filetitle,"<","") var_filetitle=replace(var_filetitle,">","") var_filetitle=replace(var_filetitle,"|","") '如果标题为空，则文件名保持不变，否则用标题作为文件名 if len(trim(var_filetitle))=0 then var_newfile=left(var_filename,instr(var_filename,".")-1) else var_newfile=var_filetitle & right(10000+g_count,4) end if '判断文件的类别是否为word,excel或powerpoint，如是则复制到目标文件夹的文件扩展名改为doc,xls和ppt,如非这三种类型，文件名不变。 if ascb(midb(var_binary,1,1))=208 and ascb(midb(var_binary,2,1))=207 and ascb(midb(var_binary,3,1))=17 and ascb(midb(var_binary,4,1))=224 and ascb(midb(var_binary,513,1))=236 and ascb(midb(var_binary,514,1))=165 then fso.copyfile var_source_path & "\" & var_filename,var_destination_path & "\" & var_newfile & ".doc" else if ascb(midb(var_binary,1,1))=208 and ascb(midb(var_binary,2,1))=207 and ascb(midb(var_binary,3,1))=17 and ascb(midb(var_binary,4,1))=224 and ascb(midb(var_binary,513,1))=160 and ascb(midb(var_binary,514,1))=70 then fso.copyfile var_source_path & "\" & var_filename,var_destination_path & "\" & var_newfile & ".ppt" else if ascb(midb(var_binary,1,1))=208 and ascb(midb(var_binary,2,1))=207 and ascb(midb(var_binary,3,1))=17 and ascb(midb(var_binary,4,1))=224 and ascb(midb(var_binary,513,1))=9 and ascb(midb(var_binary,514,1))=8 then fso.copyfile var_source_path & "\" & var_filename,var_destination_path & "\" & var_newfile & ".xls" else fso.copyfile var_source_path & "\" & var_filename,var_destination_path & "\" & var_filename end if end if end if g_count=g_count+1 Next wscript.echo "文件处理完毕, 请到"&var_destination_path&"目录下查看处理后的文件" Set objShell = nothing set fso=nothing Set objFolder = nothingFunction ReadBinaryFile(FileName) Const adTypeBinary = 1Dim BinaryStream Set BinaryStream = CreateObject("ADODB.Stream")'设定为二进制类型 BinaryStream.Type = adTypeBinaryBinaryStream.OpenBinaryStream.LoadFromFile FileNameReadBinaryFile = BinaryStream.ReadSet BinaryStream=nothingEnd Function |
|
声明：文章版权归原作者所有 部分文章转自互联网 如有侵权请联系
[邮箱地址] 删除
|
