Windows Scripting - Xceed Zip Compression Library

Подписка на рассылку

Лучше смотреть с Microsoft Internet Explorer 4.0 и выше

Xceed Zip Compression Library

Кратко

Эта библиотека представляет собой набор ActiveX и DLL, с помощью которых Вы сможете добавить функции архивации/разархивации в Ваши программы. Формат генерируемых файлов совместим с форматами PKZip и WinZip. Имеется полнофункциональная trial-версия без каких-либо ограничений.

Ссылки

Домашняя страница
Скачать trial-версию
Ограничение trial-версии состоит в том, что ее нельзя распространять вместе со своей программой.

Пример 1: sample1.vbs

В этом простом примере мы сархивируем все файлы, находящиеся в текущем каталоге:

Option Explicit

Dim XceedZip
Set XceedZip = CreateObject("XceedSoftware.XceedZip.4")

XceedZip.ZipFilename = "sample1.zip"

XceedZip.FilesToProcess = "*.*"

XceedZip.Zip

Set XceedZip = Nothing

Пример 2: sample2.vbs

А в этом примере мы разархивируем все файлы, находящиеся в архиве sample1.zip, в родительский каталог:

Option Explicit

Dim XceedZip
Set XceedZip = CreateObject("XceedSoftware.XceedZip.4")

XceedZip.ZipFilename = "sample1.zip"
XceedZip1.UnzipToFolder = ".."

XceedZip.FilesToProcess = "*.*"

XceedZip.Unzip

Set XceedZip = Nothing

Пример 3: sample3.vbs

В этом простом примере мы просмотрим содержимое архива sample1.zip.

Обратите внимание, как сделан обработчик событий от ActiveX - с помощью вызова метода WScript.CreateObject мы регистрируем ActiveX как источник событий и определяем префикс для функций обработчиков.

Option Explicit

Dim XceedZip
Set XceedZip = WScript.CreateObject("XceedSoftware.XceedZip.4", "XceedZip_")

XceedZip.ZipFilename = "sample1.zip"

XceedZip.FilesToProcess = "*.*"

If XceedZip.ListZipContents <> 0 Then MsgBox "An error occured!"

WScript.DisconnectObject XceedZip

Set XceedZip = Nothing

Sub XceedZip_ListingFile(ByVal Filename, ByVal Comment, ByVal Size, _
		ByVal CompressedSize, ByVal CompressionRatio, _
		ByVal Attributes, ByVal CRC, ByVal LastModified, _
		ByVal LastAccessed, ByVal Created, _
		ByVal Method, ByVal Encrypted, ByVal DiskNumber, _
		ByVal Excluded, ByVal Reason)
	MsgBox Filename & ": " & CompressedSize & "/" & Size & " bytes."
End Sub

Пример 4: ZipShell

И, наконец, мы создадим настоящее большое приложение ZipShell, являющееся расширением Проводника Windows (Windows Shell Extension). С его помощью можно будет просматривать общие сведение о zip-архиве, если в Проводнике щелкнуть по нему правой кнопкой мыши:

Я не буду рассказывать здесь про механизмы Windows Shell Extension, подробнее о них можно прочитать в документации, а также в серии статей в Microsoft Systems Journal:

Fusing Your Applications to the System Through the Windows95 Shell, MSJ, April 1996
Extending the Windows Explorer with Name Space Extensions, MSJ, July 1996
Extend the Windows 95 Shell with Application Desktop Toolbars, MSJ, March 1996

Остановимся лишь на некоторых особенностях кода.

Во-первых, наша программа - это Shell Extension. Это, в частности, значит, что ее нужно правильно зарегистрировать, иначе Explorer не сможет ее использовать. Можно, конечно, сделать это вручную, но я решил реализовать эту функциональность в том же скрипте: когда ему передается в командной строке ключ -r, то он осуществляет регистрацию себя в качестве Shell Extension. Реализован этот код в процедуре RegisterScript.

Прежде всего, мы должны найти тип документа, соответствующего расширению .zip (скорее всего, это будет документ, связанный с установленным на Вашем компьютере архиватором - например, с WinZip). Если такого документа еще нет, то мы зададим свой документ с именем "ZipShell":

AppName = Shell.RegRead("HKEY_CLASSES_ROOT\.zip\")
If Len(AppName) = 0 Then
	AppName = "ZipShell"
	Shell.RegWrite "HKEY_CLASSES_ROOT\.zip\", AppName
End If

Затем мы создадим для этого документа новую команду "Свойства zip-архива", с помощью которой будет вызываться наш Shell Extension:

Dim RegRoot
RegRoot = "HKEY_CLASSES_ROOT\" & AppName & "\shell\zipshell\"
Shell.RegWrite RegRoot, "Свойства zip-архива"
Shell.RegWrite RegRoot & "command\", _
	"""" & WScript.Fullname & """ """ & WScript.ScriptFullName & _
	""" ""%1"""

Обратите внимание, как мы формируем командную строку: через WScript.Fullname узнаем полное имя программы, которая исполняет скрипты, через WScript.ScriptFullName узнаем полное имя скрипта. Поскольку в этих именах могут оказаться пробелы, то ограждаем их кавычками. В итоге, мы нигде не указываем жестко пути или имена файлов и поэтому наш скрипт может исполняться на любом компьютере без изменений в коде.

Во-вторых, предусмотрена процедура дерегистрации скрипта, находящаяся в процедуре UnregisterScript. Она несколько проще - она лишь удаляет нашу команду "Свойства zip-архива":

Dim RegRoot
RegRoot = "HKEY_CLASSES_ROOT\" & AppName & "\shell\zipshell\"
Shell.RegDelete RegRoot & "command\"
Shell.RegDelete RegRoot

Обратите внимание, что мы вызываем RegDelete два раза, поскольку этот метод не может удалять ключи с подключами.

В-третьих, в скрипте есть несколько обработчиков событий от ActiveX, с идеей которых Вы уже знакомы по примеру 3.

Полный листинг: zipshell.vbs

' -------------------------------------------------------------------

Option Explicit

' Получаем имя архива через командную строку

If WScript.Arguments.Count <> 1 Then
	ShowHelp
	WScript.Quit
End If

Dim ZipName
ZipName = WScript.Arguments(0)

' Регистрация/дерегистрация скрипта

Dim C
C = Mid(ZipName, 1, 1)
If (C = "-") Or (C = "/") Then
	C = UCase(Mid(ZipName, 2, 1))
	If C = "R" Then
		RegisterScript
	ElseIf C = "U" Then
		UnregisterScript
	Else
		MsgBox "Неизвестный ключ: " & ZipName, vbCritical
	End If
	WScript.Quit
End If

' Создаем ActiveX

Dim XceedZip
Set XceedZip = WScript.CreateObject("XceedSoftware.XceedZip.4", "XceedZip_")

' Готовимся к перебору файлов

Dim List

Dim NumberOfDisks, NumberOfFiles, ZipComment
NumberOfDisks = 0
NumberOfFiles = 0
Dim TotalUncompressedSize, TotalCompressedSize

XceedZip.ZipFilename = ZipName

XceedZip.ProcessSubfolders = True
XceedZip.FilesToProcess = "*.*"

' Выполняем перебор файлов

Dim ResultCode, ResultDescription
ResultCode = XceedZip.ListZipContents

ResultDescription = XceedZip.GetErrorDescription(0, ResultCode)

' Уничтожаем ActiveX

WScript.DisconnectObject XceedZip

Set XceedZip = Nothing

' Обработка ошибок

If ResultCode <> 0 Then
	MsgBox "Error " & ResultCode & ":" & vbNewLine & _
		ResultDescription, vbCritical
	WScript.Quit
End If

' Показываем общую статистику

Dim S
S = "Имя архива:" & vbTab & ZipName & vbNewLine & _
	vbTab & "Число дисков:" & vbTab & vbTab & _
		NumberOfDisks & vbNewLine & _
	vbTab & "Число файлов:" & vbTab & vbTab & _
		NumberOfFiles & vbNewLine & _
	vbTab & "Комментарий к архиву:" & vbTab & _
		ZipComment & vbNewLine & _
	vbTab & "Размер несжатых файлов:" & vbTab & _
		TotalUncompressedSize & " байт" & vbNewLine & _
	vbTab & "Размер сжатых файлов:" & vbTab & _
		TotalCompressedSize & " байт" & vbNewLine & _
	vbTab & "Коэффициент сжатия:" & vbTab & _
		TotalCompressedSize * 100 \ TotalUncompressedSize & "%" & _
	vbNewLine & vbNewLine & "Показать список файлов?"

If (MsgBox(S, vbYesNoCancel + vbInformation, _
	"Общая статистика") <> vbYes) Then WScript.Quit

' Показываем список файлов

List = "Имя файла, размер сжатого файла, размер несжатого файла, сжатие" & _
	vbNewLine & vbNewLine & List
MsgBox List, vbInformation, "Список файлов"

' Заканчиваем работу скрипта

WScript.Quit

' -------------------------------------------------------------------

' Вызывается для каждого файла

Sub XceedZip_ListingFile(ByVal Filename, ByVal Comment, ByVal Size, _
		ByVal CompressedSize, ByVal CompressionRatio, _
		ByVal Attributes, ByVal CRC, ByVal LastModified, _
		ByVal LastAccessed, ByVal Created, ByVal Method, _
		ByVal Encrypted, ByVal DiskNumber, ByVal Excluded, _
		ByVal Reason)
	NumberOfFiles = NumberOfFiles + 1
	TotalUncompressedSize = TotalUncompressedSize + Size
	TotalCompressedSize = TotalCompressedSize + CompressedSize
	List = List & Filename & ", " & CompressedSize & " байт, " & _
		Size & " байт, " & CompressionRatio & "%" & vbNewLine
	If DiskNumber > NumberOfDisks Then NumberOfDisks = DiskNumber
End Sub

' Вызывается, если найден комментарий к архиву

Sub XceedZip_ZipComment(ZipComment)
	ZipComment = Comment
End Sub

' Вызывается, если нужно сменить диск

Sub XceedZip_InsertDisk(DiskNumber, ByRef DiskInserted)
	DiskInserted = _
		MsgBox("Вставьте диск номер " & DiskNumber, _
		vbOkCancel + vbExclamation) = vbOk
End Sub

' Вызывается, если нужно показать предупреждение

Sub XceedZip_Warning(Filename, Warning)
	MsgBox "Warning " & Warning & ":" & vbNewLine & _
		XceedZip.GetErrorDescription(1, Warning), vbWarning
End Sub

' -------------------------------------------------------------------

Sub RegisterScript()
	Dim Shell
	Set Shell = WScript.CreateObject("WScript.Shell")
	
	Dim AppName
	AppName = Shell.RegRead("HKEY_CLASSES_ROOT\.zip\")
	If Len(AppName) = 0 Then
		AppName = "ZipShell"
		Shell.RegWrite "HKEY_CLASSES_ROOT\.zip\", AppName
	End If
	
	Dim RegRoot
	RegRoot = "HKEY_CLASSES_ROOT\" & AppName & "\shell\zipshell\"
	Shell.RegWrite RegRoot, "Свойства zip-архива"
	Shell.RegWrite RegRoot & "command\", _
		"""" & WScript.Fullname & """ """ & _
		WScript.ScriptFullName & """ ""%1"""
	
	Set Shell = Nothing

	MsgBox "Регистрация скрипта в качестве " & _
		"Shell Extension завершена.", vbInformation
End Sub

Sub UnregisterScript()
	Dim Shell
	Set Shell = WScript.CreateObject("WScript.Shell")
	
	Dim AppName
	AppName = Shell.RegRead("HKEY_CLASSES_ROOT\.zip\")
	If Len(AppName) = 0 Then Exit Sub
	
	Dim RegRoot
	RegRoot = "HKEY_CLASSES_ROOT\" & AppName & "\shell\zipshell\"
	Shell.RegDelete RegRoot & "command\"
	Shell.RegDelete RegRoot

	Set Shell = Nothing

	MsgBox "Дерегистрация скрипта в качестве " & _
		"Shell Extension завершена.", vbInformation
End Sub

Sub ShowHelp
	MsgBox "Нет обязательного параметра или их слишком много!" & _
		vbNewLine & vbNewLine & "Формат вызова:" & vbNewLine & _
		"  zipshell.vbs имя_zip_архива" & vbTab & _
			"- показ свойств архива" & vbNewLine & _
		"  zipshell.vbs -r" & vbTab & vbTab & _
			"- регистрация скрипта в качестве " & _
				"Shell Extension" & vbNewLine & _
		"  zipshell.vbs -u" & vbTab & vbTab & _
			"- дерегистрация скрипта в качестве " & _
				"Shell Extension", vbCritical
End Sub

' -------------------------------------------------------------------