『楼 主』:
[求助]批量压缩解压XX_(CAB格式)文件及VBS问题求助
在压缩CAB格式文件时，发现使用MakeCAB.EXE压缩文件后，文件的时间属性都会改变，另外凡是基于MakeCAB.EXE的压缩程序都有这个改变时间属性的现象。后经试用发现CABARC.EXE和 Cabinet Manager2003 不会改变压缩后的文件时间属性。
因为经常进行批量压缩操作，就在网上找到了这个软件ExMk_CAB.EXE。它是利用VBS调用CABARC.EXE来压缩和解压的，可以点击右键实现批量压缩和解压，并且在Win2003系统中可以压缩成包含目录的文件。可是前几天一下就无法使用了，窗口提示如图。那位大侠能帮小弟解惑，不胜感谢。
ExMk_CAB.EXE下载地址：
http://zhenlove.com.cn/cndos/fileup/files/ExMk_CAB.zip
出错截图：
===============================================
Cab_Make.VBS脚本：
If WScript.Arguments.Count <> 1 Then WScript.Quit
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WSS = CreateObject("Wscript.Shell")
F = WScript.Arguments(0)
If FSO.FileExists(F) Then
FileExt = UCase(FSO.GetExtensionName(F))
If FileExt = "CAB" Or Right(FileExt,1) = "_" Then WScript.Quit
FilePath = FSO.GetParentFolderName(F)
FileFName = FSO.GetFileName(F)
FileBName = FSO.GetBaseName(F)
TEMP = WSS.ExpandEnvironmentStrings("%TEMP%")
If FSO.FileExists(TEMP & "\modifype.tmp") Then FSO.DeleteFile TEMP & "\modifype.tmp",True
MpeErr = WSS.Run("MODIFYPE.EXE " & UCase(FSO.GetFile(F).ShortPath) & " -c",0,True)
If MpeErr <> 0 Then
If FSO.FileExists(TEMP & "\modifype.tmp") Then
If FSO.FileExists(F) Then FSO.DeleteFile F,True
FSO.MoveFile TEMP & "\modifype.tmp",F
End If
Call MsgBox("MODIFYPE can't patch " & Chr(34) & FileFName & Chr(34),vbOKOnly,"Error")
WScript.Quit
End If
If FileExt = "" Then
FC = UCase(FilePath & "\" & FileBName & "._")
Else
FC = UCase(FilePath & "\" & FileBName & "." & Mid(FileExt,1,2) & "_")
End If
CabErr = WSS.Run("CABARC.EXE -m LZX:21 N " & Chr(34) & FC & Chr(34) & " " & Chr(34) & F & Chr(34),1,True)
If CabErr <> 0 Then
Call MsgBox("CABARC can't compress file " & Chr(34) & FileFName & Chr(34),vbOKOnly,"Error")
Else
If FSO.FileExists(F) Then FSO.DeleteFile F,True
End If
End If
If FSO.FolderExists(F) Then
WSS.CurrentDirectory = F
CabErr = WSS.Run("CABARC.EXE -m LZX:21 -p -r N " & Chr(34) & UCase(F) & ".CAB" & Chr(34) & " *.*",1,True)
If CabErr <> 0 Then
Call MsgBox("CABARC can't compress folder " & Chr(34) & FSO.GetFolder(F).Name & Chr(34),vbOKOnly,"Error")
End If
End If ==============================================
Cab_Exct.VBS脚本：
If WScript.Arguments.Count <> 1 Then WScript.Quit
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WSS = CreateObject("Wscript.Shell")
F = WScript.Arguments(0)
If FSO.FileExists(F) Then
FileExt = UCase(FSO.GetExtensionName(F))
FilePFolder = FSO.GetFile(F).ParentFolder
FileFName = FSO.GetFileName(F)
If FileExt = "CAB" Then
FileBName = FSO.GetBaseName(F)
NewFolder = FilePFolder & "\" & FileBName
If Not FSO.FolderExists(NewFolder) Then FSO.CreateFolder(NewFolder)
WSS.CurrentDirectory = NewFolder
CabErr = WSS.Run("CABARC.EXE -o -p X " & Chr(34) & F & Chr(34),1,True)
If FSO.GetFolder(NewFolder).Size = 0 Then CabErr = 1
If CabErr <> 0 Then
WSS.CurrentDirectory = FSO.GetFolder(NewFolder).ParentFolder
FSO.DeleteFolder NewFolder,True
Call MsgBox("CABARC can't decompress file " & Chr(34) & FileFName & Chr(34),vbOKOnly,"Error")
End If
WScript.Quit
End If
If Right(FileExt,1) = "_" Then
WSS.CurrentDirectory = FilePFolder
CabErr = WSS.Run("CABARC.EXE X " & Chr(34) & F & Chr(34),1,True)
If CabErr <> 0 Then
Call MsgBox("CABARC can't decompress file " & Chr(34) & FileFName & Chr(34),vbOKOnly,"Error")
Else
If FSO.FileExists(F) Then FSO.DeleteFile F,True
End If
WScript.Quit
End If
End If ===============================================
另外有没有更好的使用右键调用CABARC.EXE批量压缩CAB的批处理程序。自己写了很简单的供大家参考。
===============================================
| Quote: |
- REM Run @ NT/2000/WinXP/Win2003
- @ECHO OFF
- COLOR 21
- TITLE 批量压制当前目录中的所有文件为*.XX_(CAB格式)文件
- IF EXIST %CD%\XX_ RD /S /Q %CD%\XX_
- IF NOT EXIST %CD%\XX_ MD %CD%\XX_
- FOR /F %%i IN ('dir/B/O "%CD%"\*.*') DO CABARC -m LZX:21 N %CD%\XX_\%%i "%CD%"\%%i
- REN %CD%\XX_\*.* *.??_
- ::REG ADD HKCR\*\shell\压制为*.XX_文件(CAB格式)\Command /ve /d MAkeCABs /f
- goto :EOF
无奈何发表于： 2007-05-15 00:01 |
|
===============================================
[ Last edited by wangjf on 2007-5-15 at 12:03 AM ]
|
