|
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 ' -------------------------------------------------------------------
|