Главная страница

Новости

Вопрос-ответ

Скрипты

ActiveX

Статьи

Книжная полка

Knowledge Base

Конференции

Ссылки

 

Гостевая книга

Напишите мне письмо

 

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

Рассылка 'Windows Scripting'  Архив

 

 

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

 

Создано с помощью UltraEdit

 

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: Остановимся лишь на некоторых особенностях кода.

Во-первых, наша программа - это 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

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