Владислав Петровский
Создание архиватора или простого упаковщика данных
[Форум] Обсудить в форуме
Надеюсь объяснять, что такое архиватор или упаковщик данных не надо. В дальнейшем будем считать архиватор упаковщиком данных с возможностью сжатия. Итак, необходимо сразу же разобраться, что должна делать наша будущая программа.
Во-первых, программа должна уметь упаковывать и распаковывать файлы любых форматов. Во-вторых, она должна располагать интуитивно-понятным интерфейсом, а также иметь некоторые дополнительные функции, такие как паролирование, кодирование, разбивка архива (пакета) на несколько частей.
Лично я, как игровой программист, делал простой упаковщик, задача которого была упаковать 3ds-модель, текстуры и аниматоры в один файл. Но вы, если хотите, можете делать архиватор. Тогда вам понадобятся алгоритмы сжатия.
Теперь разберемся, какой будет интерфейс. Я делал консольную утилиту, но в данном случае не считаю, что консольный интерфейс является интуитивно-понятным, да и в VB6 работа с консолью возможна только с помощью API. Поэтому используем оконный, SDI (Single Document Interface), ListView, ToolBar, StatusBar и меню. Вообще-то думаю, что каждый сам может определить каким будет интерфейс его приложения, а мы займёмся самым главным – механизмом упаковки, распаковки, и форматом файла.
Сначала давайте определимся, как будут храниться данные внутри программы. Я считаю, что это должна быть коллекция элементов класса CArhFile. Давайте использовать такой код для класса.
Public FileName As String 'Имя файла
Public FilePath As String 'Относительный путь
Public FileSize As Single 'Размер файла
Public FileData As String 'Файл может быть не больше 2гб
Public A_IsDirectory As Boolean 'Может быть это папка
Public A_IsReadOnly As Boolean 'Атрибут "Только чтение"
Public A_IsHidden As Boolean 'Атрибут "Скрытый"
Public A_IsArchive As Boolean 'Атрибут "Архивный"
Public A_IsSystem As Boolean 'Атрибут "Системный"
Public Sub ExtractFile(ToPath As String, Normal As Boolean)
Dim FullPath As String
Dim Normalized As String
'On Error GoTo ErrorHandler
'-------------------------------------
FullPath = ToPath + FilePath
Levels = Split(FullPath, "\")
For i = 0 To UBound(Levels)
If Dir(Normalized + Levels(i) + "\", vbDirectory) <> "" Then
Normalized = Normalized + Levels(i) + "\"
Else
'Как говорится, если папка не существует, то она будет
'создана
'Но если нет такого диска, то обрадуем пользователя
If i = 0 Then
Err.Raise 1111, "CArhFile", "Диска нету!"
Else
MkDir Normalized + Levels(i) + "\"
'Если папки не exist теперь будет exist!"
Normalized = Normalized + Levels(i) + "\"
End If
End If
Next i
'*** Сами сделаете запрос пользователю ***
'*** нужно ли переписывать файл ***
'*** да для всех - там, нет, нет для всех ***
If Not A_IsDirectory Then
ff = FreeFile
Open Normalized + FileName For Binary As #ff
For i = 1 To FileSize
Put #ff, i, CByte(Asc(Mid$(FileData, i, 1)))
Next i
Close #ff
Else
Mkdir Normalized + FileName
End if
SetAttr Normalized + FileName, IIf(A_IsArchive, vbArchive, 0) Or _
IIf(A_IsSystem, vbSystem, 0) Or _
IIf(A_IsReadOnly, vbReadOnly, 0) Or _
IIf(A_IsHidden, vbHidden, 0)
'-----------------------------------
Exit Sub
ErrorHandler:
Select Case Err.Number
Case 6: ' Произошла ошибка Overflow
'Делайте также со всеми ошибками, подлежащими обработке
'... ... ...
Case Else 'Произошла не предполагаемая ошибка (например Out Of Memory)
'поделитесь этой радостной новостью с пользователем!
End Select
End Sub
Можете также добавить в класс переменные и функции, которые бы вы хотели поместить в свою программу. А теперь класс коллекции. Конечно же каждый мог бы сделать коллекцию в VB-Class Builder’е да или просто написать ручками , но труд сделал обезьяну человеком, а лень сделала человека программистом. Поэтому читайте листинг, копируйте и не морочьте себе голову. Класс называется clFiles
'Переменная в которой действительно храниться коллекция
Private mCol As Collection
Public Function AddFile(FilePathName As String, MaskPath As String, KillFileAfterCompressing As Boolean) As CArhFile
Dim objNewMember As CArhFile
Dim RByte As Byte
Dim FAttr As VbFileAttribute
Set objNewMember = New CArhFile
' Конструкция "WITH" для инициализации значений новой объектной переменной
With objNewMember
Levels = Split(FilePathName, "\")
RelativePath = Right(FilePathName, Len(FilePathName) - Len(MaskPath))
.FileName = Level(UBound(Level))
.FilePath = Left(RelativePath, Len(RelativePath) - Len(.FileName))
.FileSize = FileLen(FilePathName)
ff = FreeFile
Open FilePathName For Binary As #ff
For i = 1 To .FileSize
Get #ff, i, RByte
.FileData = .FileData + Chr(RByte)
Next i
Close #ff
FAttr = FileAttr(FilePathName)
.A_IsArchive = FAttr And vbArchive
.A_IsDirectory = FAttr And vbDirectory
.A_IsHidden = FAttr And vbHidden
.A_IsReadOnly = FAttr And vbReadOnly
.A_IsSystem = FAttr And vbSystem
End With
'Если пользователь поставил галочку "Удалить файлы после упаковки"
If KillFileAfterCompressing Then Kill FilePathName
mCol.Add objNewMember, sKey
'Возвращаем указатель (ссылку) на созданный объект
Set Add = objNewMember
Set objNewMember = Nothing
End Function
Public Function AddItem(PFN As String, Flags As Byte, fSize As Single, fDt As String) As CArhFile
Dim objNewMember As CArhFile
Dim RByte As Byte
Dim FAttr As VbFileAttribute
Set objNewMember = New CArhFile
'Конструкция инициализации значений новой объектной переменной
With objNewMember
.FileName = Mid$(PFN, InStrRev("\", PFN) + 1)
.FilePath = Mid$(PFN, 1, InStrRev("\", PFN))
.FileSize = fSize
.FileData = fDt
.A_IsArchive = Flags And vbArchive
.A_IsDirectory = Flags And vbDirectory
.A_IsHidden = Flags And vbHidden
.A_IsReadOnly = Flags And vbReadOnly
.A_IsSystem = Flags And vbSystem
End With
mCol.Add objNewMember, sKey
'Возвращаем указатель (ссылку) на созданный объект
Set Add = objNewMember
Set objNewMember = Nothing
End Function
Public Property Get Item(RFP As String) As CArhFile
Dim f As New CArhFile
For Each f In mCol
If f.FilePath + f.FileName = RFP Then
Set Item = f
Exit Function
End If
Next f
End Property
Public Property Get Count() As Long
Count = mCol.Count
End Property
Public Sub Remove(vntIndexKey As Variant)
Dim f As New CArhFile
For Each f In mCol
i = i + 1
If f.FilePath + f.FileName = RFP Then
mCol.Remove i
Exit Function
End If
Next f
End Sub
Public Property Get NewEnum() As IUnknown
'Вот такой вот заумный код даёт вам возможность
'гонять коллекцию через For-Each циклы
Set NewEnum = mCol.[_NewEnum]
End Property
Private Sub Class_Initialize()
'Как только объявлена переменная коллекции
'происходит это
Set mCol = New Collection
End Sub
Private Sub Class_Terminate()
Set mCol = Nothing
End Sub
Обычная коллекция – как все остальные, но есть две функции Add… - AddFile и AddItem. 1-я функция добавляет в коллекцию элемент, зная только путь файла, - всё остальное она определяет сама. 2-я добавляет уже готовые данные. 1-я обычно используется, когда пользователь добавляет файл в архив, а вторая – при загрузке архива.
Формат файла
Заголовок архива – структура, содержащая основную информацию об архиве. (Например, количество файлов, подпись, пароль) Далее идут заголовки файлов – структуры, которые содержат сведения об упакованных файлах (путь, атрибуты, тип, размер). Затем идут данные самих сжатых файлов.
Теперь описание выше описанных структур (для удобства рекомендую все объявления помещать в модуль modDeclarations)
Type T_ARHIVE_HEADER
ArhFormat As String * 10 'Имя формата
Files As Long 'Кол-во упакованных объектов
Password As String * 100 'Пароль
Version As Byte 'Версия упаковщика
End Type
Type T_FILE_HEADER
PathFileName As String * 255 'Путь и имя файла
Flags As Byte 'Флаговый байт
Size As Single 'Размер пути (если пап. То 0)
End Type
' Данные представлены динамическим массивом типа Byte
Public bData() As Byte 'Содержимое нашего файла
Public aFiles As New clFiles 'Содержимое файла, но в более приличном виде
'(в виде коллекции)
Public ReadError As Integer 'Номер ошибки при чтении
Public WriteError As Integer 'Код ошибки при записи
' Ещё понадобится одна АПИ-функ., называется «CopyMemory»
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, _
pSrc As Any, ByVal ByteLen As Long)
Ну а теперь, собственно говоря, процедура загрузки (в модуль modIO) :
Public Sub LoadFile(FileName As String, AH As T_ARHIVE_HEADER, FH() As _ T_FILE_HEADER)
On Error Goto ErrorHandler
Dim hFile As Long, fLen As Single, rPos As Single, cPos as Single
If Dir(FileName) = "" Or Trim(FileName) = "" Then
'Нет такого файла
ReadError = 53 '(File Not Found)
End if
hFile = FreeFile 'Хэндл файла, или просто номер
Open FileName For Binary as #hFile 'Открываем файл
fLen = LOF(hFile) 'Опред. длину файла в байтах
Redim bData(fLen) 'Изменяем размер массива
For rPos = 1 To fLen 'Организуем цикл чтения
Get #hFile, rPos, bData(rPos-1) 'Читаем байт и >> его в массив
Next rPos
Close #hFile 'Закрываем файл
CopyMemory AH, bData(0), Len(AH) 'Заполняем структуру данными
Redim FH(AH.Files – 1)
'Теперь нужно проверить формат
If AH.ArhFormat <> "MY_SAF_777" then ReadError = 1001: Exit Sub
For cPos = 0 to AH.Files - 1
'Копируем последовательность байт из нужного байта в нужное место
'bData(Len(AH)+1+ Len(FH(0))*cPos) – формула для определения
'номера байта массива, который начинает след. заголовок файла
CopyMemory FH(cPos), bData(Len(AH)+1+ Len(FH(0))*cPos), Len(FH(0))
Next cPos
StartPos = Len(AH)+Len(FH(0))*AH.Files +1
For i = StartPos to fLen
bData(i-StartPos) = bData(i) 'Сдвигаем данные на StartPos байт.
'P.S. это можно было сделать
'c помощью API (CopyMemory)
Next i
'Обрежем ненужную часть массива bData,
'теперь он будет хранить только содержимое файлов.
Redim Preserve bData(StartPos-1) 'Preserve – указывает на то, что данные
'в массиве останутся
Dim rcp as single 'rcp means Read-Copy-Position, ясно?
Set aFiles = New clFiles
For i = 0 to AH.Files – 1
CopyMemory Dat$, bData(rcp), FH(i).Size
aFiles.AddItem FH(i).PathFileName, FH(i).Flags, FH(i).Size, Dat$
rcp = rcp + FH(i).Size
Next i
ErrorHandler:
ReadError = Err.Number
Err.Clear
Close #hFile
End Sub
CopyMemory
Теперь объясняю, для тех, кто не знает, что за АПИ-функция «CopyMemory». Думаю, что, по крайней мере, по названию все догадались, что она делает, ну а принцип действия такой: функция копирует последовательность байтов определённой длины (указывается в аргументах). Первый аргумент – указатель на переменную-получатель, второй – указатель на переменную-источник, третий – кол-во копируемых байтов. Рисунок показывает принцип действия.
На рисунке показано как 17 байт копируется (допустим из одной переменной в другую), при этом функции передаётся указатель на вторую переменную, указатель на первую, и количество байт, которое необходимо скопировать. Если вы смотрели внимательно на декларацию апишной функции, то наверное заметили, что для первых двух аргуметнов нет ключ. слова ByVal. Так как в VB по умолчанию аргуметы передаются ByRef, в функцию передаётся именно адрес переменной, а не её значение. Если кто не верит, можете написать на С++ пробную функцию (листинг ниже) , а затем вызвать её из VB.
INT TestFunc (INT SomeVar)
{
SomeVar++ ;
return SomeVar ;
}
Теперь, если на VB вы вызовите функцию так Msgbox SomeFunc(6), она возвратит вам не 7, а какое-нибудь семизначное число, т.е. адрес. Короче говоря, если аргумент функции передаётся ByRef, передаётся именно указатель на переменную, а не её значение. Поскольку разыменовывание этого указателя внутри такой функции не делается (VB всё сам делает), многие этого просто не замечают. Можете действительно проверить, написав свою DLL, только помните, что INT в С++ это Long в VB. Теперь создадим функцию SaveFile. Здесь будет попроще – мы не получим ошибку 53, и здесь мы имеем структуры, а нам надо сделать массив.
Public Sub SaveFile(FileName As String, _
AH As T_ARHIVE_HEADER
FH() As T_FILE_HEADER)
Dim wrData() As Byte 'Массив который мы будем записывать в файл
Dim wrPos as Single 'Переменная для циклов копирования байтов
Dim hFile As Long 'Дескриптор свободного файла
On Error Goto ErrorHandler
Redim weData(Len(AH)+Len(FH(0))*AH.Files+UBound(bData))
CopyMemery wrData(0), AH, Len(AH)
For wrPos = 0 to AH.Files – 1
'Копируем в массив заголовки файлов
CopyMemory wrData(Len(AH)+Len(FH(0))*wrPos+1), FH(wrPos), Len(FH(wrPos))
Next wrPos
CopyMemory wrData(Len(AH) + (Len(FH(0)) * AH.Files) + 1), bData(0), _
UBound(bData)+1
'Теперь массив всех данных готов к записи.
If Dir(FileName) <> "" Then
'Файл с таким именем уже существует
If OverWriteQuery(FileName) Then
Kill FileName
Goto Writing
Else
Exit Sub
End If
End if
Writing:
hFile = FreeFile 'Получаем хэндл свободного файла
Open FileName For Binary As #hFile 'Открываем файл
Put #hFile, 1, wrData 'Записываем данные
Close #hFile 'Закрываем файл
ErrorHandler:
Exit Sub
Close #hFile 'Если файл не успел закрыться, то ...
WriteError = Err.Number
' Вообще в такой процедуре ошибок быть не может, но т.к. здесь есть одно
' слабое место – Open, а посему,такие ошибки как Device unavailable, Disk not ready,
' Device I/O error,
'Disk full всё-таки могут произойти
End Sub
Этот код теоретически работоспособный, но если вы его скопируете в VB IDE - получите ошибку (35) Sub or Function not defined. Почему? А потому, что функция OverWriteQuery ещё не описана. Функция спрашивает пользователя, нужно ли переписать файл, если он уже существует. Функция выглядит так:
Public Function OverWriteQuery(FileName as String) As Boolean
Dim Res as vbMSGBoxResult
Res = MsgBox("Файл " + Chr(34) + FileName + Chr(34) + _
" уже существует! Заменить?", vbQuestion + vbYesNO, "Вопрос")
OverWriteQuery = (Res = vbYes) 'Если польз. нажал ДА тогда True, др. кнопку – False
End Function
Как всем этим пользоваться
Чтобы загрузить архив: Нужно воспользоваться функцией LoadFile. Передаёте ей 3 аргумента – имя файла, пустую переменную типа T_ARHIVE_HEADER, пустой массив переменных типа T_FILE_HEADER. После выполнения функции переменная и массив будут заполнены необходимой информацией об архиве. Помимо этого, коллекция aFiles будет тоже содержать в себе информацию и само содержимое файлов. Т.е. после загрузки, обращаетесь к функции-члену ExtractFile любого элемента коллекции, и нужный вам файл окажется там, где вам нужно, т.е. извлечётся. Здесь надо помнить, что если вы извлекаете сразу весь архив, то аргумент Relative функции ExtractFile должен быть равен True, что означает, что относительные пути (до архивирования) извлекаемого файла при распаковке нужно сохранить. Заархивировали вы, например, папку «Crack», а в ней был файл «Cracker.exe» и «ReadMe.TxT». Так вот, если Relative будет False, то при распаковке (на Рабочий стол, например) этого архива, в вас на рабочем столе окажется пустая папка «Crack», и рядом ещё 2 файла, догадались каких? Т.е. если Relative будет False все файлы и папки, независимо от их вложенности, будут помещены в одно место. И второй момент – сначала должны быть извлечены все папки, потом все файлы. Это нужно для того, чтобы при распаковке папка сохраняла свои атрибуты, которые были до того как её «запихали» в архив.
Чтобы сохранить архив: Все файлы и папки в архив добавляются с помощью функции AddFile объекта aFiles не зависимо от того, папка это или файл. Когда вздумаете сохранять файл, заполните массив FH() и bData() информацией о файлах и содержимым файлов соответственно. См. функцию LoadFile, там делается то же самое, но наоборот. Функция CopyMemory здесь опять придёт на помощь. Когда всё всем заполните, вызывайте функцию SaveFile.
Заключение
Этот код, конечно же, ещё «не обтёсанный» - нужно ещё дорабатывать, улучшать, что-то переделать. Это зависит лишь от того, что вы собираетесь делать: шараварную программу типа WinRAR’а, утилиту-однодневку или просто хотите поэкспериментировать с архивами. Даже если вы просто прочитали это, и считаете, что не зря потратили 5 минут – это уже хорошо.
Автор: Владислав Петровский
E-Mail: sls_hacker@mail.ru