Работа с zip архивами

@testuser2 · Регистрация: 08.02.2017

Студворк — интернет-сервис помощи студентам

Из всего, что попадалось по теме сжатия/распаковки ZIP наиболее интересные были примеры с использованием библиотеки Zlib. Оригинальная zlib использует cdecl экспорт функций, но есть реализация zlibwapi.dll, которую можно использовать в VB. Вот хороший пример использования. Там можно увидеть как сжть/распаковать массив байтов, но вот беда, очень сложно найти пример под VB с более обширным использованием, способной на большее, данной либы, которая не есть простая, там есть функции с использованием множества параметров констант и длинных структур, которые чтобы узнать наверное надо долго копатся в сишных заголочниках. Но HackerVlad в личной беседе говорил, что у него есть исходники с использованием данной библиотеки, поэтому любезно прошу его поделиться данной информацией.

Добавлено через 1 минуту
кстати словосочетание zip-архивами в названии форум блочит почему-то )

Добавлено через 6 минут
На одном форуме есть хороший пример испльзования функций zlib для извлечения/распаковки отдельных файлов, там

Кликните здесь для просмотра всего текста

обсуждался какой-то экзотический ЯП Clarion, но очень наглядно

Code
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
! Источнег: https://forum.clarionlife.net/viewtopic.php?t=2389
! Для добавления в архив PwlZip ваш пароль
ZipHandle = zipOpen(NEW_ZIPPACK, 0)
If EncryptFlag = 1
Res# = zipOpenNewFileInZip3(ZipHandle, PATH_CURZIP, Zinfo, 0, 0, 0, 0, Comment, Z_DEFLATED, CompressionFlag,0,-15,8,0,PwlZip,0)
Else
Res# = zipOpenNewFileInZip(ZipHandle, PATH_CURZIP, Zinfo, 0, 0, 0, 0, Comment, Z_DEFLATED, CompressionFlag)
.
 
!Для чтения из архива
ZipHandle = unzOpen(PATH_INFILE_PACK)
LocRes1=UnzGoToFirstFile(ZipHandle)
If unzGetCurrentFileInfo(ZipHandle,FinFo,PATH_NAMEUPD_TMP,Size(PATH_NAMEUPD_TMP),0,0,Comment,Size(Comment)).
If FinFo.Flag = 3 !признак шифрованного zip по крайней мере так я понял после мыкания с архивами
LocRes2 = unzOpenCurrentFilePassword(ZipHandle,PwlZip)
Else
LocRes2 = UnzOpenCurrentFile(ZipHandle)

Здесь подробное описание функций, структур и констант, однако я не нашел там unzGetCurrentFileInfo и т.п.

@testuser2 · 04.03.2025, 18:02 **[ТС]**

Сообщение от HackerVlad

у меня класс есть

Да припоминаю, здесь в теме он скорее всего где-то тоже закопан.

@HackerVlad · 04.03.2025, 18:51

Сообщение от testuser2

Да припоминаю, здесь в теме он скорее всего где-то тоже закопан.

Я не помню если честно, я вообще думал, что это обсуждалось в теме CAB, надо чекать, искать...

Добавлено через 3 минуты
testuser2, но для удобства лучше новые темы открывать, чем в одной теме по 100 страниц

@testuser2 · 08.06.2025, 15:04 **[ТС]**

Сообщение от testuser2

На x64 чудо-функции запустить не получилось

Допетрил компрессию DeltaB под x64. Особенностью данной функции является то что, в в качетсве аргументов передаются по значению структуры, имеющие размер 3х указателей. В x86 эти структуры кладутся в стек, согласно соглашению stdcall, а в x64 другое соглашение и там любые аргументы больше 8 байт передаются по указателю. И все что требовалось сделать для работы дельты в x64 это сделать передачу структур, что в общем-то более удобно и обычно.

Кликните здесь для просмотра всего текста

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
Option Explicit
'Компрессия/декомпрессия WinApi DeltaB. Testuser 06.25
'Сделано по образцу статьи https://www.manhunter.ru/assembler/1620_upakovka_i_raspakovka_dannih_s_pomoschyu_delta_funkciy.html
''##В VB6 Разкомментировать в VB6 и удалить все PtrSafe##
'Private Enum LongPtr
'    [_]
'End Enum
''###########################
Enum DELTA_FLAG_TYPE
    DELTA_FLAG_NONE = 0
End Enum
Public Enum BOOL
    apiFalse
    apiTrue
End Enum
Enum ALG_ID 'typedef unsigned int ALG_ID;
    [_]
End Enum
Private Const DELTA_FILE_TYPE_RAW@ = 1 / 10000
Private Const DELTA_FILE_TYPE_SET_RAW_ONLY@ = DELTA_FILE_TYPE_RAW
Private Const DELTA_FLAG_IGNORE_FILE_SIZE_LIMIT@ = 131072 / 10000 '&H20000
Private Type DELTA_INPUT
    lpcStart As LongPtr
    uSize As LongPtr
    Editable As BOOL
End Type
Private Type DELTA_OUTPUT
    lpStart As LongPtr
    uSize As LongPtr
End Type
#If Win64 Then
  Private Declare PtrSafe Function CreateDeltaB Lib "msdelta" ( _
              ByVal FileTypeSet As Currency, _
              ByVal SetFlags As Currency, _
              ByVal ResetFlags As Currency, _
                    Source As DELTA_INPUT, _
                    Target As DELTA_INPUT, _
                    SourceOptions As DELTA_INPUT, _
                    TargetOptions As DELTA_INPUT, _
                    GlobalOptions As DELTA_INPUT, _
              ByVal lpTargetFileTime As LongPtr, _
              ByVal HashAlgId As ALG_ID, _
                    lpDelta As Any) As BOOL
  Private Declare PtrSafe Function ApplyDeltaB Lib "msdelta" ( _
              ByVal ApplyFlags As Currency, _
                    Source As DELTA_INPUT, _
                    Delta As DELTA_INPUT, _
                    Target As DELTA_OUTPUT) As BOOL  
#Else
  Private Declare PtrSafe Function CreateDeltaB Lib "msdelta" ( _
     Optional ByVal FileTypeSet As Currency = DELTA_FILE_TYPE_RAW, _
     Optional ByVal SetFlags As Currency = DELTA_FLAG_IGNORE_FILE_SIZE_LIMIT, _
     Optional ByVal ResetFlags As Currency, _
     Optional ByVal Src_lpcStart As LongPtr, Optional ByVal Src_uSize As LongPtr, Optional ByVal Src_Editable As BOOL, _
           Optional Trg_lpcStart As Any, _
     Optional ByVal Trg_uSize As LongPtr, _
     Optional ByVal Trg_Editable As BOOL, _
     Optional ByVal SrcOpt_lpcStart As LongPtr, Optional ByVal SrcOpt_uSize As LongPtr, Optional ByVal SrcOpt_Editable As BOOL, _
     Optional ByVal TrgOpt_lpcStart As LongPtr, Optional ByVal TrgOpt_uSize As LongPtr, Optional ByVal TrgOpt_Editable As BOOL, _
     Optional ByVal GlbOpt_lpcStart As LongPtr, Optional ByVal GlbOpt_uSize As LongPtr, Optional ByVal GlbOpt_Editable As BOOL, _
     Optional ByVal lpTargetFileTime As LongPtr, _
     Optional ByVal HashAlgId As ALG_ID, _
           Optional lpDelta As Any) As BOOL
  Private Declare PtrSafe Function ApplyDeltaB Lib "msdelta" ( _
              ByVal ApplyFlags As Currency, _
              ByVal Src_lpcStart As LongPtr, ByVal Src_uSize As LongPtr, ByVal Src_Editable As BOOL, _
                    Dlt_lpcStart As Any, ByVal Dlt_uSize As LongPtr, ByVal Dlt_Editable As BOOL, _
                    lpTarget As DELTA_OUTPUT) As BOOL
#End If
Private Declare PtrSafe Function DeltaFree Lib "msdelta" (ByVal lpMemory As LongPtr) As BOOL
Private Declare PtrSafe Function GetLastError Lib "kernel32.dll" () As Long
Private Declare PtrSafe Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Dst As Any, Src As Any, ByVal ln As LongPtr)
 
Private Sub ExampleDeltaB()
    Dim bBuff() As Byte, bComp() As Byte, bNorm() As Byte, lerr&
 
    bBuff = GetFileBytes("D:\tmp\Zip\Diletant\Simpler Zipper Demo_\Subfolder\zlibwapi.dll")
 
    lerr = CompressDeltaB(bBuff, bComp)
    lerr = DeCompressDeltaB(bComp, bNorm)
    
    Debug.Print "Размер файла:  "; UBound(bBuff) + 1
    Debug.Print "DeltaB:        "; UBound(bComp) + 1
End Sub
 
'В случае удачи функции возвращают ноль, если произошла ошибка, возвращается ответ функции GetLastError
#If Win64 Then
  Function CompressDeltaB(bInp() As Byte, bOut() As Byte, Optional ByVal EditableBuffer As BOOL) As Long
      Dim Delta As DELTA_OUTPUT, Target As DELTA_INPUT, DIdummy As DELTA_INPUT
      
      With Target
          .lpcStart = VarPtr(bInp(0))
          .uSize = UBound(bInp) + 1
          .Editable = EditableBuffer
      End With
      If CreateDeltaB(DELTA_FILE_TYPE_RAW, _
                        DELTA_FLAG_IGNORE_FILE_SIZE_LIMIT, _
                        0, DIdummy, _
                        Target, _
                        DIdummy, DIdummy, DIdummy, 0, 0, _
                        Delta) Then
          With Delta
            ReDim bOut(CLng(.uSize - 1))
            CopyMemory bOut(0), ByVal .lpStart, .uSize
            DeltaFree .lpStart
          End With
      Else: CompressDeltaB = GetLastError()
      End If
  End Function
  Function DeCompressDeltaB(bInp() As Byte, bOut() As Byte, Optional ByVal EditableBuffer As BOOL) As Long
      Dim Delta As DELTA_INPUT, DO_Res As DELTA_OUTPUT, DIdummy As DELTA_INPUT
      
      With Delta
          .lpcStart = VarPtr(bInp(0))
          .uSize = UBound(bInp) + 1
          .Editable = EditableBuffer
      End With
      If ApplyDeltaB(0, DIdummy, Delta, DO_Res) Then
          With DO_Res
            ReDim bOut(CLng(.uSize - 1))
            CopyMemory bOut(0), ByVal .lpStart, .uSize
            DeltaFree .lpStart
          End With
      Else: DeCompressDeltaB = GetLastError
      End If
  End Function
#Else
  Function CompressDeltaB(bInp() As Byte, bOut() As Byte, Optional ByVal EditableBuffer As BOOL) As Long
      Dim Delta As DELTA_OUTPUT
  
      If CreateDeltaB(Trg_lpcStart:=bInp(0), _
                         Trg_uSize:=UBound(bInp) + 1, _
                         TrgOpt_Editable:=EditableBuffer, _
                         lpDelta:=Delta) Then
          With Delta
            ReDim bOut(CLng(.uSize - 1))
            CopyMemory bOut(0), ByVal .lpStart, .uSize
            DeltaFree .lpStart
          End With
      Else: CompressDeltaB = GetLastError()
      End If
  End Function
  Function DeCompressDeltaB(bInp() As Byte, bOut() As Byte, Optional ByVal EditableBuffer As Long) As Long
      Dim Delta As DELTA_OUTPUT
  
      If ApplyDeltaB(0, 0, 0, 0, bInp(0), UBound(bInp) + 1, EditableBuffer, Delta) Then
          With Delta
            ReDim bOut(CLng(.uSize - 1))
            CopyMemory bOut(0), ByVal .lpStart, .uSize
            DeltaFree .lpStart
          End With
      Else: DeCompressDeltaB = GetLastError()
      End If
  End Function
#End If
 
Private Function GetFileBytes(sFlPt As String) As Byte()
    Dim fNum&, fLen&, bBuff() As Byte
    fNum = FreeFile
    Open sFlPt For Binary Access Read As #fNum
    fLen = LOF(fNum)
    If fLen Then
        ReDim bBuff(fLen - 1)
        Get fNum, , bBuff
    End If
    Close fNum
    GetFileBytes = bBuff
End Function

@HackerVlad · 30.04.2026, 12:59

Сообщение от testuser2

Допетрил компрессию DeltaB под x64.

Ты большой молодец :-)

Новые блоги и статьи Все статьи Все блоги /
Асинхронный приём данных из COM-порта Argus19 01.05.2026 Асинхронный приём данных из COM-порта Купил на aliexpress термопринтер QR701. Он оказался странным. Поключил к Arduino Nano. Был очень удивлён. Наотрез отказывается печатать русские буквы. Чтобы. . .	попытка написать игровой сервер на C++ pyirrlicht 29.04.2026 попытка написать игровой сервер на плюсах с открытым бесконечным миром. возможно получится прикрутить интерпретатор питон для кастомизации игровой логики. что есть на текущий момент:. . .	Контроль уникальности выбранного документа-основания при изменении реквизита Maks 28.04.2026 Алгоритм из решения ниже разработан на примере нетипового документа "ЗаявкаНаРемонтСпецтехники", разработанного в КА2. Задача: уведомлять пользователя, если указанная заявка (документ-основание). . .	Благородство как наказание Maks 24.04.2026 У хорошего человека отношения с женщинами всегда складываются трудно. А я человек хороший. Заявляю без тени смущения, потому что гордиться тут нечем. От хорошего человека ждут соответствующего. . .
Валидация и контроль данных табличной части документа перед записью Maks 22.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа, разработанного в КА2. Задача: контроль и валидация данных табличной части документа перед записью с учетом регламента компании. . .	Отчёт о затраченных материалах за определенный период с макетом печатной формы Maks 21.04.2026 Отчёт из решения ниже размещён в конфигурации КА2. Задача: разработка отчёта по затраченным материалам за определённый период, с возможностью вывода печатной формы отчёта с шапкой и подвалом. В. . .	Отчёт о спецтехнике находящейся в ремонте Maks 20.04.2026 Отчёт из решения ниже размещен в конфигурации КА2. Задача: отобразить спецтехнику, которая на данный момент находится в ремонте. Есть нетиповой документ "Заявка на ремонт спецтехники" который. . .	Памятка для бота и "визитка" для читателей "Semantic Universe Layer (Слой семантической вселенной)" Hrethgir 19.04.2026 Сгенерировано для краткого описания по случаю сборки и компиляции скелета серверного приложения. И пусть после этого скажут, что статьи сгенерированные AI - туфта и не интересно. И это не реклама -. . .