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

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

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