1) Нельзя указать степень сжатия
2) WINDOWS COMMANDER некорректно понимает русские имена в ZIP файле. ( Это пока единственный архиватор который так себя повёл )
Обычные WinZip / WinRar понимают имена файлов без проблем
3) Не реализовал функцию добавки файлов и папок в уже созданный архив, т.к возникли трудности с появлением окошек о подтверждении замены файлов. ( В принципе перенос целого каталога в ZIP архив работает )
Если у кого нибудь будут советы и предложения по доработке класса, буду очень рад.
- Код: Выделить всё
'/// Пример работы с классом
Set FileSytemObject = CreateObject("Scripting.FileSystemObject")
'/// Получаем путь до каталога в котором находимся
ParentFolderName = FileSytemObject.GetParentFolderName(Wscript.ScriptFullName)
'/// Строим путь для создания тестового файла
SourceFilePath = FileSytemObject.BuildPath(ParentFolderName,"Текстовый документ.txt")
'/// Создаём и заполняем файл содержимым
FileSytemObject.OpenTextFile(SourceFilePath,2,True).write "Содержимое файла"
'/// Создаём архив
DestFilePath = FileSytemObject.BuildPath(ParentFolderName,"1.zip")
'/// Создаём класс создания ZIP файла
Set Zip = New ZipClass
'/// Открываем новый архив
Zip.CreateArchive DestFilePath
'/// Добавляем файл в архив
Zip.CopyFileToArchive SourceFilePath
'/// Закрываем архив
Zip.CloseArchive
MsgBox "Архив создан",vbInformation,"ZipClass"
'/// Код класса
Class ZipClass
Private Shell
Private FileSystemObject
Private ArchiveFolder
Private ItemsCount
Private Sub Class_Initialize()
Set Shell = CreateObject("Shell.Application")
Set FileSystemObject = CreateObject("Scripting.FileSystemObject")
End Sub
Function CreateArchive(ZipArchivePath)
If UCase(FileSystemObject.GetExtensionName(ZipArchivePath)) <> "ZIP" Then
Exit Function
End If
Dim ZipFileHeader
ZipFileHeader = "PK" & Chr(5) & Chr(6) & String(18, 0)
FileSystemObject.OpenTextFile(ZipArchivePath, 2, True).Write ZipFileHeader
Set ArchiveFolder = Shell.NameSpace(ZipArchivePath)
if Not (ArchiveFolder is Nothing) Then CreateArchive = True
End Function
Function CopyFileToArchive(FilePath)
if (ArchiveFolder is Nothing) Then Exit Function
ArchiveFolder.CopyHere FilePath
ItemsCount = ItemsCount + 1
End Function
Function CopyFolderToArchive(FolderPath)
if (ArchiveFolder is Nothing) Then Exit Function
ArchiveFolder.CopyHere FolderPath
ItemsCount = ItemsCount + 1
End Function
Function CloseArchive
if (ArchiveFolder is Nothing) Then Exit Function
Set WsriptShell = CreateObject("Wscript.Shell")
if IsObject(Wscript) Then
Do
Wscript.Sleep 100
Loop Until ArchiveFolder.Items.Count => ItemsCount
Else
ServerSleep
End if
ItemsCount = 0
End Function
Private Function ServerSleep
Set WsriptShell = CreateObject("Wscript.Shell")
Do
WsriptShell.Popup "",1,""
Loop Until ArchiveFolder.Items.Count => ItemsCount
End Function
Function MoveFileToArchive(FilePath)
if (ArchiveFolder is Nothing) Then Exit Function
ArchiveFolder.MoveHere FilePath
End Function
End Class