Работа с ZIP архивами средствами Windows XP

Пример того как можно создать архив, упаковать в него файл и извлечь этот файл из архива.

В Windows XP разработчики заложили возможность работоть с архивами как с папками. Такая возможность была давно реализована в различных файловых менеджерах ещё в DOS (знаменитый Norton Commander 5.0). Теперь такую возможность разработчики включили и в саму операционную систему.

Теперь давайте рассмотрим по шагам, как нам создать архив, записать в него файл и извлечь файл из архива.

Шаг первый. Создаем архивный файл.

Сделать это очень просто. Необходимо создать файл с нужным именем и расширением ZIP (это обязательно!). И записать в него заголовок ZIP файла. Например так:

Sub NewZip(sPath)
     If Len(Dir(sPath)) > 0 Then Kill sPath
     Open sPath For Output As #1
     Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
     Close #1
End Sub

Или так:

Function CreateArchive(ZipArchivePath) As Boolean
Dim Shell As Object
Dim FileSystemObject As Object
Dim ArchiveFolder As Object

     Set Shell = CreateObject("Shell.Application")
     Set FileSystemObject = CreateObject("Scripting.FileSystemObject")

     ' Проверка наличия расширения zip в полном пути-имени файла
     If UCase(FileSystemObject.GetExtensionName(ZipArchivePath)) <> "ZIP" Then
          Exit Function
     End If
     ' Создание пустого zip архива
Dim ZipFileHeader As String
     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

И помните! Необходимо указывать ПОЛНЫЙ ПУТЬ к создаваемому архиву.

Обратите так же внимание на оператор Shell.NameSpace((ZipArchivePath)) Имя архивного файла должно быть заключено в двойные(!) скобки. Это особенности использования Shell. Если Вы подставляете вместо значений переменные, то Вы должны их заключать в двойные скобки. Иначе работать не будет!

Теперь у нас создан архивный файл. Осталось записать в него нужный файл.

Шаг второй. Запись файла в архив.

Это тоже сделать не сложно. Например вот так

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

     Sub CopyFileToArchiv(ZipName as String, FileName as String)
     ' ZipName - полный путь к архиву
     ' FileName - полный путь к архивируемому файлу
Dim ShellApp As Object
Dim DestFolder As Object

     Set ShellApp = CreateObject("Shell.Application")
     Set DestFolder = ShellApp.NameSpace((ZipName))
     ' копируемый выбранный файл в zip папку
     DestFolder.CopyHere (FileName)
     ' ожидаем окончание сжатия файла
     Do Until DestFolder.Items.Count = 1
          Sleep 100
     Loop

     Set ShellApp = Nothing

End Sub

Повторяю. Не забывайте про дополнительные скобки.

Шаг третий. Извлекаем файл из архива.

И в этом нет ничего сложного. Надо знать имя архивного файла (с полным путем) и то место, куда мы хотим извлечь файл из архива. Вот так.

Public Sub UnZipFile(ZipName As String, DestPath As String)
' ZipName - полный путь к архиву
' DestPath - полный путь к папке для распаковки архива

Dim ShellApp As Object

     Set ShellApp = CreateObject("Shell.Application")
     'Copy the files in the newly created folder
     ShellApp.NameSpace((DestPath)).CopyHere ShellApp.NameSpace((ZipName)).Items
     Set ShellApp = Nothing

End Sub

Вот и все основные действия. Можно так же узнать число файлов в архиве, их имена, размеры, даты модификации, типы и многое другое. Вот, например, как узнать количество файлов в архиве.

Public Function fnCountItemsArchive(ZipName As String) As Integer
' ZipName - полный путь к архиву

Dim objShellApp As Object
Dim objFolder As Object
Dim objItems As Object

     Set objShellApp = CreateObject("Shell.Application")
     Set objFolder = objShellApp.NameSpace((ZipName))
     Set objItems = objFolder.Items()
     fnCountItemsArchive = objItems.Count

End Function

А вот так можно узнать имена файлов в архиве.

Public Function fnNameArchiveFile(ZipName As String, Optional i As Integer = 0, _
Optional fext As Boolean = True) As String
' ZipName - имя архива
' i - номер файла в архиве (начало с 0), по умолчанию - 0
' fext - включать расширение в имя файла, по умолчанию - true
Dim objShellApp As Object
Dim objFolder As Object

     Set objShellApp = CreateObject("Shell.Application")
     Set objFolder = objShellApp.NameSpace((ZipName))
     If fext Then
          fnNameArchiveFile = objFolder.Items().Item((i)).Path
     Else
          fnNameArchiveFile = objFolder.Items().Item((i)).Name
     End If

End Function

Всё остальное зависит от вашего желания и фантазии. В Windows 2000 - не работает. В Vista - не тестировалось.

Используемые материалы.

Серый форум
Zip file or files with the default Windows zip program (VBA)
заZIPповать через WinXP (Latuk)

Очень много позаимствовано на форуме SQL.RU у пользователя Latuk. К статье прилагается небольшая база в формате Access 2000, которая и демонстрирует все вышеописанное.

Обсудить на форуме...

Автор: Дмитрий Сонных (aka Joss) Размер: 74 кБ Добавлен: 11.03.2009