Rambler's Top100
Российский фонд помощи
Навигация
Главная
MS ACCESS
VB
ASP
PHP
Наши друзья
Поиск
Форум
Лента новостей
Новый сайт

Online
Рассылки Subscribe.Ru
Работа с MS Access
Подписаться письмом
Реклама на сайте
Вся ли косметика хорошая? Чем натуральная косметика выделяется?
 
Главная arrow MS ACCESS arrow Работа с ZIP архивами средствами Windows XP
Работа с ZIP архивами средствами Windows XP Печать E-mail
Автор Joss   
20.03.2009 г.

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


Иногда бывает необходимо архивировать документы, которые создает Access. Например, при электронной рассылке или резервном копировании. Для этого многие используют внешние архиваторы (7-Zip, WinRAR, WinZip, WinAce и т.д.) Но начиная с Windows XP для этого можно использовать возможности самой ОС.
В Windows XP разработчики заложили возможность работоть с архивами формата ZIP как с папками. Такая возможность была давно реализована в различных файловых менеджерах ещё в 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 NothingThen 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 StringAs 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 StringOptional i As Integer = 0, _
Optional fext As Boolean = TrueAs 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 95/98/Me/2000 - не работает. В Vista - не тестировалось.

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

http://forum.script-coding.info/viewtopic.php?id=296 - Серый форум
http://www.rondebruin.nl/windowsxpzip.htm - Zip file or files with the default Windows zip program (VBA)
http://sql.ru/forum/actualthread.aspx?bid=4&tid=468220&pg=-1&hl=zip - заZIPповать через WinXP (Latuk)

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

Download now


Дмитрий (aka Joss) 2008 (c)

 


Просмотров: 16569

  Коментарии (1)
 1 Написал(а) час, в 16:41 20.03.2009
Интересно-познавательно.(Доступно-понятно!!!)

Добавить коментарий
Имя:
E-mail
Коментарий:



Код:* Code

 
Реклама на сайте
HiProg.com - Технологии программирования
Rambler's Top100 TopList