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

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

Новые блоги и статьи Все статьи Все блоги /
Транслитерация текста с кириллицы на латиницу (вариант №2) Maks 13.11.2026 Обновленная версия ранее созданной обработки. Добавлено: - Проверка исходного текста на кириллицу, через обращение к стандартной функции "ТолькоКириллицаВСтроке" из общего модуля. . .	Часы с термометром и праздничным календарем yariko 12.11.2026 Сегодня мы рассмотрим как можно сделать отличные многофункциональные часы. Итак, поставим конкретную задачу: разработать часы с календарем, двумя термодатчиками, выводом поздравительных сообщений. . .	Транслитерация текста с кириллицы на латиницу (вариант №1) Maks 11.11.2026 Решил облегчить жизнь себе и коллегам админам при создании электронных почтовых ящиков для пользователей, в результате написал обработку "Транслитерация текста" с кириллицы на латиницу, а в ней. . .	Книги по геймдизайну, левел-дизайну, игровым механикам и проектированию игрового опыта 8Observer8 08.11.2026 Содержание блога \| English Version 1. 2003 - 06 - Designing Virtual Worlds (1st Edition) Автор: Richard A. Bartle \| Объем: 768 стр. Ссылки: Amazon . . .
Родители токсичные абьюзеры по отношению к своим детям ругают их оскорбляют не любят zorxor 08.11.2026 Жить в атмосфере постоянных оскорблений, критики и холодности со стороны родителей — это тяжелое и болезненное испытание, которое оставляет глубокие эмоциональные раны. Токсичное и абьюзивное. . .	Как только я захожу к себе в свою комнату я сразу же с себя снимаю свои трусы. Ответ от Джемени ИИ. zorxor 08.11.2026 Джемени, как только я захожу к себе в свою комнату я сразу же с себя снимаю свои трусы. Многие люди, возвращаясь домой, сразу переодеваются в максимально свободную одежду или вовсе предпочитают. . .	Паттерн очереди действий/команд (Action / Command Queue). Система очереди действий и кат-сцен с SDL3 Callbacks, cglm и OpenGL 8Observer8 07.11.2026 Содержание блога \| English Version Руководство для начинающих по реализации паттерна очереди действий/ команд (Action / Command Queue) на C++ (C++20) с использованием официального SDL3 Callbacks. . .	Проверка полного ФИО в типовом справочнике Maks 07.11.2026 Решение реализовано в конфигурации КА2, на примере справочника "КонтактныеЛицаПартнеров". Задача: Запрет инициалов. Не допускаеть использование сокращений вида "И. И. ", "И. И. ", "И И" и. . .