Работа с 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.

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

Новые блоги и статьи Все статьи Все блоги /
Программный домашний кинотеатр russiannick 27.09.2026 Сподобился на программный домашний кинотеатр. В качестве ЯВУ по традиции выбрал js. В помощники взял Яндекс-Алису. Было создано три зала на разные интересы. исторические и ретро сериал Хичкок. . .	Беседа с ИИ о программистах, недопускающих к созданию и правке кода генеративные ИИ и причины этого zorxor 21.09.2026 Раньше я радовался или получал некоторые эмоции, пусть небольшие, но всё же, от самого процесса написания кода, рекомпиляции и запуска, видя постепенное развитие программы и прочее. А теперь лень. . .	Мобильное приложение ColorStep pavlinmavlin 17.09.2026 Реализовал приложение Красный, Зеленый, Синий в Unity3d + c#. Название изменил на ColorStep. Приложение прошло модерацию и теперь доступно для скачивания. Делал его сам, шаг за шагом — и вот,. . .	Запрет дублирования строк в табличной части Maks 13.09.2026 Реализация из решения ниже выполнена на нетиповом справочнике "Нормы ТО" с табличной часть "Виды ТО", разработанного в КА2, со следующими реквизитами: - ВидТО (СправочникСсылка. ВидыТО); - ВидГСМ. . .
Скрипты Tampermonkey для CyberForum, ChatGPT, Claude и пр. Jin X 06.09.2026 Скрипты Tampermonkey для CyberForum, ChatGPT, Claude и пр. Работая с форумом и нейросетями в браузере часто хочется что-то подкорректировать или добавить какого-то функционала. Ниже прикреплён. . .	Программа опроса у.з. расходомера SLS-720F Argus19 02.09.2026 Программа опроса у. з. расходомера SLS-720F Программа опрашивает один раз в минуту три ультразвуковых расходомера SLS-720F через интерфейс RS-485 по протоколу Modbus RTU. Опрашиваются регистры. . .	Hyper-V: Компьютер должен поддерживать доверенный платформенный модуль 2.0. Maks 31.08.2026 При установке Windows 11 на виртуальную машину Hyper-V 2-го поколения вылезла такая ошибка: Решение: в параметрах виртуальной машины, в разделе "Безопасность" (Security) активировать флаг. . .	Архитектура биовида Стива в Майнкрафте: Зачем бонобо кубический каннибализм anaschu 30.08.2026 Кубический Вагинокапитализм в Minecraft: Математический инвариант ОДУ и рок Стивов-бонобо Главная задача разработанной «Модели Всего» — наглядно продемонстрировать наличие системной «судьбы». . .