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

Новые блоги и статьи Все статьи Все блоги /
Конвертировать закладки radiotray-ng в m3u-плейлист damix 19.02.2026 Это можно сделать скриптом для PowerShell. Использование . \СonvertRadiotrayToM3U. ps1 <path_to_bookmarks. json> Рядом с файлом bookmarks. json появится файл bookmarks. m3u с результатом. # Check if. . .	Семь CDC на одном интерфейсе: 5 U[S]ARTов, 1 CAN и 1 SSI Eddy_Em 18.02.2026 Постепенно допиливаю свою "многоинтерфейсную плату". Выглядит вот так: https:/ / www. cyberforum. ru/ blog_attachment. php?attachmentid=11617&stc=1&d=1771445347 Основана на STM32F303RBT6. На борту пять. . .	Символьное дифференцирование igorrr37 13.02.2026 / * Программа принимает математическое выражение в виде строки и выдаёт его производную в виде строки и вычисляет значение производной при заданном х Логарифм записывается как: (x-2)log(x^2+2) -. . .	Камера Toupcam IUA500KMA Eddy_Em 12.02.2026 Т. к. у всяких "хикроботов" слишком уж мелкий пиксель, для подсмотра в ESPriF они вообще плохо годятся: уже 14 величину можно рассмотреть еле-еле лишь на экспозициях под 3 секунды (а то и больше),. . .
И ясному Солнцу zbw 12.02.2026 И ясному Солнцу, и светлой Луне. В мире покоя нет и люди не могут жить в тишине. А жить им немного лет.	«Знание-Сила» zbw 12.02.2026 «Знание-Сила» «Время-Деньги» «Деньги -Пуля»	SDL3 для Web (WebAssembly): Подключение Box2D v3, физика и отрисовка коллайдеров 8Observer8 12.02.2026 Содержание блога Box2D - это библиотека для 2D физики для анимаций и игр. С её помощью можно определять были ли коллизии между конкретными объектами и вызывать обработчики событий столкновения. . . .	SDL3 для Web (WebAssembly): Загрузка PNG с прозрачным фоном с помощью SDL_LoadPNG (без SDL3_image) 8Observer8 11.02.2026 Содержание блога Библиотека SDL3 содержит встроенные инструменты для базовой работы с изображениями - без использования библиотеки SDL3_image. Пошагово создадим проект для загрузки изображения. . .