Форум программистов, компьютерный форум, киберфорум
Visual Basic
Войти
Регистрация
Восстановить пароль
Блоги Сообщество Поиск Заказать работу  
 
 
Рейтинг 3.00/2: Рейтинг темы: голосов - 2, средняя оценка - 3.00
 Аватар для Антихакер32
1201 / 473 / 46
Регистрация: 06.01.2014
Сообщений: 1,797
Записей в блоге: 19

Как программно узнать закончил ли ZIP свою работу?

25.02.2014, 11:19. Показов 13679. Ответов 90
Метки нет (Все метки)

Студворк — интернет-сервис помощи студентам
Тот класс переделал, только не могу понять
как всётаки получить ответ что ZIP закончил свою работу ?

класс переделал ! по рекомендации проффесионала под ником Dragokas
выкладываю все версии в блоге

ниже фрагмент с коментарием где необходим этот код

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
Public Function UnZipFile(ByVal DestPath$, ParamArray Files())
    '
    'Извлечение из архива
    'Аргументы:
    'DestPath - полный путь к папке для распаковки архива
    'Files - Без параметра все файлы, либо по индексу либо имени в архиве
    'Примечание: Имена файлов в архиве, должны быть полными !
    '
    Dim DestDir As Object, s$, f&, j$(), v As Variant
 
    If Not FolderExists(DestPath) Then 'Проверяем есть ли папка
        MkDir (DestPath) 'Создаём папку для перемещаемых туда объектов
    End If
    Set DestDir = Shell.NameSpace((DestPath))
 
    If IsMissing(Files) Then
        DestDir.CopyHere mArchive.Items 'Перемещаем все ...
        '
        '
        '===== Здесь нужен правильный код окончания операции ! ! !
        '
        '
    Else
 
        For Each v In Files 'Подготавливаем список для перемещения
 
            If IsNumeric(v) Then
                s = s & " " & mArchive.Items().Item((v)).Name
            Else
 
                For f = 0 To mArchive.Items.Count - 1
                    If v = mArchive.Items().Item((f)).Name Then s = s & " " & f
                Next
            End If
        Next
        j = Split(Mid$(s, 2)) 'Cписок для перемещения
 
        For f = 0 To mArchive.Items.Count - 1
            s = mArchive.Items().Item(CLng(j(f))).Name
            s = DestPath & "\" & s
            DestDir.CopyHere mArchive.Items.Item(CLng(j(f))) 'Перемещаем указнные инексы
 
            Do 'Ждём пока в папке назначения не появится файл
                Sleep 100 '1/10 доля секунды
            Loop While Len(Dir(s)) = 0
        Next
    End If
End Function
0
cpp_developer
Эксперт
20123 / 5690 / 1417
Регистрация: 09.04.2010
Сообщений: 22,546
Блог
25.02.2014, 11:19
Ответы с готовыми решениями:

Как в VBA узнать когда процесс закончил работу?
Как в VBA узнать когда процесс закончил работу? И существует работа с процессами в VBA

Как уведомить первый поток о том, что второй закончил свою работу
Добрый день. Проблема такая. Есть 2 класса. Первый MyLogic - отвечает за логику приложения, второй MyApplication - отвечает за его...

Как узнать закончил ли поток работу?
Для создания потоков использую ThreadPool.QueueUserWorkItem Как узнать когда, потоки закончат работу, к результату не привязать...

90
Модератор
10048 / 3894 / 883
Регистрация: 22.02.2013
Сообщений: 5,847
Записей в блоге: 79
26.02.2025, 13:41
Студворк — интернет-сервис помощи студентам
HackerVlad, zipfldr распаковывает файлы во временную папку. Вот посмотри у них атрибуты сохраняются? Если да то можно просто оттуда считать их.
0
Испарился
 Аватар для HackerVlad
1741 / 637 / 45
Регистрация: 10.09.2021
Сообщений: 2,769
26.02.2025, 14:00
The trick, ты меня и обрадовал и расстроил
там 79 год ставит в дате...
0
Модератор
10048 / 3894 / 883
Регистрация: 22.02.2013
Сообщений: 5,847
Записей в блоге: 79
26.02.2025, 14:04
HackerVlad, ну значит парси вручную, там же все элементарно. Нет сжатия вроде как. Это сами файлы пожаты.
0
Испарился
 Аватар для HackerVlad
1741 / 637 / 45
Регистрация: 10.09.2021
Сообщений: 2,769
26.02.2025, 18:06
The trick, атрибуты тоже каверкает как попало, они об этом не заботились вообще

Добавлено через 3 часа 50 минут
The trick, ты знаешь, fafalone предложил мне новый, более простой код! и он работает только с простым ZIP (не с SFX-EXE) и только от Vista+

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
Private Const CLSID_IShellItem = "{43826d1e-e718-42ee-bc55-a1e261c37bfe}"
Private Const CLSID_IEnumShellItems = "{70629033-e363-4a28-a567-0db78006e6d7}"
Private Const CLSID_EnumItems = "{94f60519-2850-4924-aa5a-d15e84868039}"
 
Private Function ExtractByShell(pszZip As String, pszDest As String) As Long
    If PathFileExists(pszZip) = 0 Then
        ExtractByShell = 0
        Exit Function
    End If
    If PathFileExists(pszDest) = 0 Then
        SHCreateDirectory 0, StrPtr(pszDest)
    End If
    
    Dim siZip As IShellItem
    Dim siDest As IShellItem
    Dim siChild As IShellItem
    Dim pEnum As IEnumShellItems
    Dim pArray As IShellItemArray
    Dim pCopy As New FileOperation
    Dim pidl() As Long
    Dim cPidl As Long
    Dim pPIDL As IPersistIDList
    Dim lRet As Long
    
    Dim IID_IShellItem As UUID
    Dim IID_IEnumShellItems As UUID
    Dim BHID_EnumItems As UUID
    
    CLSIDFromString CLSID_IShellItem, IID_IShellItem
    CLSIDFromString CLSID_IEnumShellItems, IID_IEnumShellItems
    CLSIDFromString CLSID_EnumItems, BHID_EnumItems
    
    lRet = SHCreateItemFromParsingName(StrPtr(pszZip), Nothing, IID_IShellItem, siZip)
    lRet = SHCreateItemFromParsingName(StrPtr(pszDest), Nothing, IID_IShellItem, siDest)
    
    If (siZip Is Nothing) Or (siDest Is Nothing) Then
        ExtractByShell = 0
        Exit Function
    End If
    
    siZip.BindToHandler 0, BHID_EnumItems, IID_IEnumShellItems, pEnum
    
    If (pEnum Is Nothing) = False Then
        Do While pEnum.Next(1, siChild, 0) = S_OK
            Set pPIDL = siChild
            ReDim Preserve pidl(cPidl)
            pPIDL.GetIDList pidl(cPidl)
            cPidl = cPidl + 1
        Loop
        If cPidl Then
            SHCreateShellItemArrayFromIDLists cPidl, VarPtr(pidl(0)), pArray
            If (pArray Is Nothing) = False Then
                pCopy.CopyItems pArray, siDest
                pCopy.PerformOperations
                pCopy.GetAnyOperationsAborted lRet
            End If
            'FreeIDListArray pidl, cPidl
        End If
    End If
    ExtractByShell = lRet
End Function
Добавлено через 59 секунд
Суть этого кода в том что система атоматически проставляет атрибуты и дату и время файлов, и самому с этим не нужно мучиться вообще.

Добавлено через 9 минут
И я вот не знаю как заставить этот код работать с SFX-EXE, как твой код.
1
Модератор
10048 / 3894 / 883
Регистрация: 22.02.2013
Сообщений: 5,847
Записей в блоге: 79
26.02.2025, 19:49
HackerVlad, нужно реверсить и смотреть как там все отрабатывает. Пока нет времени и желания.
0
Испарился
 Аватар для HackerVlad
1741 / 637 / 45
Регистрация: 10.09.2021
Сообщений: 2,769
26.02.2025, 20:17
The trick, да и не стоит, того что есть достаточно)
0
Испарился
 Аватар для HackerVlad
1741 / 637 / 45
Регистрация: 10.09.2021
Сообщений: 2,769
01.03.2025, 20:07
The trick, да и не стоит, того что есть достаточно)
Цитата Сообщение от The trick Посмотреть сообщение
ну значит парси вручную, там же все элементарно.
Для тебя это может и элементарно, но у меня на это ушло целых 3 дня. Чтобы сделать читалку атрибутов файлов из ZIP. Но в итоге, сейчас я уже закончил эту большую работу и написал совершенно новый и уже полностью готовый класс для чтения ZIP-файлов этот код читает ни только атрибуты файлов, внутри ZIP, но ещё и дату и время файлов, другие свойства не добавлял, такие как размер файла, так как они мне и не нужны, так как это всё остальное я читаю другим кодом Shell.

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
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
Option Explicit
'////////////////////////////////////////////
'// Класс для чтения ZIP-файлов            //
'// Copyright (c) 01.03.2025 by HackerVlad //
'// e-mail: vladislavpeshkov@ya.ru         //
'// Версия 1.0                             //
'////////////////////////////////////////////
 
' Декларации API ...
Private Declare Function CreateFileW Lib "kernel32" (ByVal lpFileName As Long, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function CreateFileA Lib "kernel32" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, ByVal lpBuffer As Long, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Any) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cbMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function GetMem2 Lib "msvbvm60" (src As Any, dst As Any) As Long
Private Declare Function GetMem4 Lib "msvbvm60" (src As Any, dst As Any) As Long
 
' Константы ...
Private Const OPEN_EXISTING As Long = 3
Private Const FILE_SHARE_READ = &H1
Private Const GENERIC_READ As Long = &H80000000
Private Const CREATE_ALWAYS = 2
Private Const EndOFCentralDirSignature As Long = &H6054B50
Private Const CentralFileHeaderSigniature As Long = &H2014B50
Private Const CP_UTF8 As Long = 65001
Private Const CP_OEMCP = 1 ' default to OEM code page
Private Const MB64 As Long = 67108864
 
Public Enum AttributesInZip
    zipFileAttr
    zipFileDate
    zipFileTime
    zipFileDateAndTime
End Enum
 
Public Enum FileNameCodePageInZip
    zipCodePageAutoDetect
    zipCodePageCP866
    zipCodePageUTF8
End Enum
 
' Переменные для хранения внутри экземпляра класса
Dim EntriesInTheCentralDir As Integer
Dim zipCountFiles As Integer
Dim zipCountDirs As Integer
Dim zipListFiles As New Collection
Dim zipListFilesCP866 As New Collection
Dim zipListFilesUTF8 As New Collection
Dim zipFileAttributes As New Collection
Dim zipFileDosDate As New Collection
Dim zipFileDosTime As New Collection
 
' Открыть файл ZIP на чтение
Public Function OpenZip(ByVal ZipFileName As String) As Boolean
    Dim hFile As Long
    Dim dwBytesReaded As Long
    Dim nFileSize As Long
    Dim bArray() As Byte
    Dim i As Long
    Dim signature As Long
    Dim FileName As String
    Dim FileNameCP866 As String
    Dim FileNameUTF8 As String
    Dim OffSet As Long
    Dim FileNameLength As Integer
    Dim LastModFileTime As Integer
    Dim LastModFileDate As Integer
    Dim ExtraFieldLength As Integer
    Dim FileCommentLength As Integer
    Dim ExternalFileAttributes As Long
    Dim nOutputCharLen As Long
    Dim numread As Long
    Dim SetNewPosition As Long
    Dim MajorWindowsVersion As Long
    
    hFile = CreateFileW(StrPtr(ZipFileName), GENERIC_READ, FILE_SHARE_READ, ByVal 0&, OPEN_EXISTING, 0, 0)
    If hFile = 0 Then hFile = CreateFileA(ZipFileName, GENERIC_READ, FILE_SHARE_READ, ByVal 0&, OPEN_EXISTING, 0, 0)
    
    If hFile <> -1 And hFile <> 0 Then
        nFileSize = GetFileSize(hFile, ByVal 0&)
        
        If nFileSize <> -1 Then
            If nFileSize <= MB64 Then ' Если размер файла меньше 64 МБ то читать весь файл
                ReDim bArray(nFileSize - 1)
                ReadFile hFile, VarPtr(bArray(0)), nFileSize, dwBytesReaded, ByVal 0&
            Else ' Размер файла больше 64 МБ
                ReDim bArray(MB64 - 1)
                
                ' Прочитать только последние 64 МБ
                SetNewPosition = nFileSize - MB64
                SetFilePointer hFile, SetNewPosition, ByVal 0&, 1
                ReadFile hFile, VarPtr(bArray(0)), MB64, dwBytesReaded, ByVal 0&
            End If
            
            If dwBytesReaded > 0 Then
                For i = UBound(bArray) - 3 To LBound(bArray) Step -1
                    GetMem4 bArray(i), signature
                    
                    If signature = EndOFCentralDirSignature Then
                        Exit For
                    End If
                Next
                
                ' Загрузить в переменные данные из файла (я решил не использовать структуры)
                GetMem2 bArray(i + 10), EntriesInTheCentralDir
                GetMem4 bArray(i + 16), OffSet
                
                If SetNewPosition > 0 Then
                    OffSet = OffSet - SetNewPosition
                End If
                
                GetMem4 ByVal &H7FFE026C, MajorWindowsVersion
                If zipListFiles.Count > 0 Then Set zipListFiles = Nothing
                If zipListFilesCP866.Count > 0 Then Set zipListFilesCP866 = Nothing
                If zipListFilesUTF8.Count > 0 Then Set zipListFilesUTF8 = Nothing
                If zipFileAttributes.Count > 0 Then Set zipFileAttributes = Nothing
                If zipFileDosDate.Count > 0 Then Set zipFileDosDate = Nothing
                If zipFileDosTime.Count > 0 Then Set zipFileDosTime = Nothing
                zipCountFiles = 0
                zipCountDirs = 0
                
                For i = 1 To EntriesInTheCentralDir
                    GetMem4 bArray(OffSet), signature
                    
                    If signature = CentralFileHeaderSigniature Then
                        ' Получить всю необходимую информацию о файле
                        GetMem2 bArray(OffSet + 12), LastModFileTime
                        GetMem2 bArray(OffSet + 14), LastModFileDate
                        GetMem2 bArray(OffSet + 28), FileNameLength
                        GetMem2 bArray(OffSet + 30), ExtraFieldLength
                        GetMem2 bArray(OffSet + 32), FileCommentLength
                        GetMem4 bArray(OffSet + 38), ExternalFileAttributes
                        
                        OffSet = OffSet + 46
                        
                        FileName = String$(FileNameLength, vbNullChar)
                        CopyMemory ByVal StrPtr(FileName), bArray(OffSet), FileNameLength
                        
                        OffSet = OffSet + FileNameLength + ExtraFieldLength + FileCommentLength
                        
                        FileNameCP866 = Space$(FileNameLength)
                        FileNameUTF8 = Space$(FileNameLength)
                        
                        nOutputCharLen = MultiByteToWideChar(CP_OEMCP, 0&, StrPtr(FileName), -1, 0&, 0&) ' Получить размер буфера в символах для кодировки DOS
                        MultiByteToWideChar CP_OEMCP, 0&, StrPtr(FileName), -1, StrPtr(FileNameCP866), nOutputCharLen ' Преобразовать кодировки
                        nOutputCharLen = 0
                        nOutputCharLen = MultiByteToWideChar(CP_UTF8, 0&, StrPtr(FileName), -1, 0&, 0&) ' Получить размер буфера в символах для кодировки UTF8
                        MultiByteToWideChar CP_UTF8, 0&, StrPtr(FileName), -1, StrPtr(FileNameUTF8), nOutputCharLen ' Преобразовать кодировки
                        
                        FileNameUTF8 = Left$(FileNameUTF8, nOutputCharLen - 1)
                        FileNameCP866 = Replace$(FileNameCP866, "/", "\")
                        FileNameUTF8 = Replace$(FileNameUTF8, "/", "\")
                        
                        If (ExternalFileAttributes And vbDirectory) <> 0 Then
                            zipCountDirs = zipCountDirs + 1
                        Else
                            zipCountFiles = zipCountFiles + 1
                        End If
                        
                        If MajorWindowsVersion >= 6 And MajorWindowsVersion < 600 Then
                            If FileNameUTF8 Like "*[" & ChrW(-3) & "]*" Then ' Авто-определение кодировок
                                zipListFiles.Add FileNameCP866 ' Кодировка DOS
                            Else
                                zipListFiles.Add FileNameUTF8 ' Кодировка UTF8
                            End If
                        Else ' Windows версии меньше чем Vista
                            zipListFiles.Add FileNameCP866 ' Кодировка DOS
                        End If
                        
                        zipListFilesCP866.Add FileNameCP866
                        zipListFilesUTF8.Add FileNameUTF8
                        zipFileAttributes.Add ExternalFileAttributes
                        zipFileDosDate.Add LastModFileDate
                        zipFileDosTime.Add LastModFileTime
                        
                        If OpenZip = False Then OpenZip = True
                    End If
                Next
            End If
        End If
        
        CloseHandle hFile
    End If
End Function
 
' Возвращает количество файлов и каталогов внутри ZIP
Public Property Get CountFilesAndDirs() As Long
    CountFilesAndDirs = EntriesInTheCentralDir
End Property
 
' Возвращает количество файлов внутри ZIP
Public Property Get CountFiles() As Long
    CountFiles = zipCountFiles
End Property
 
' Возвращает количество каталогов внутри ZIP
Public Property Get CountDirs() As Long
    CountDirs = zipCountDirs
End Property
 
' Возвращает список файлов внутри ZIP
Public Function ListFiles(arrFileNames() As String, Optional ByVal CodePage As FileNameCodePageInZip) As Boolean
    Dim i As Integer
    
    If zipListFiles.Count > 0 Then
        ReDim arrFileNames(zipListFiles.Count - 1)
        
        For i = 1 To zipListFiles.Count
            If CodePage = zipCodePageAutoDetect Then
                arrFileNames(i - 1) = zipListFiles(i)
            ElseIf CodePage = zipCodePageCP866 Then
                arrFileNames(i - 1) = zipListFilesCP866(i)
            ElseIf CodePage = zipCodePageUTF8 Then
                arrFileNames(i - 1) = zipListFilesUTF8(i)
            End If
        Next
        
        ListFiles = True
    End If
End Function
 
' Возвращает атрибуты файла внутри ZIP, а так же дату и время создания файлов
Public Function GetFileAttributesInZip(ByVal FileNameInZip As String, Optional ByVal AttrInZip As AttributesInZip) As Long
    Dim i As Integer
    
    If zipListFilesCP866.Count > 0 Then
        For i = 1 To zipListFilesCP866.Count
            If zipListFilesCP866(i) = FileNameInZip Then
                GoTo Subroutine
                Exit For
            End If
        Next
    End If
    If zipListFilesUTF8.Count > 0 Then
        For i = 1 To zipListFilesUTF8.Count
            If zipListFilesUTF8(i) = FileNameInZip Then
                GoTo Subroutine
                Exit For
            End If
        Next
    End If
    Exit Function
Subroutine:
    If AttrInZip = zipFileAttr Then
        GetFileAttributesInZip = zipFileAttributes(i)
    ElseIf AttrInZip = zipFileDate Then
        GetFileAttributesInZip = zipFileDosDate(i)
    ElseIf AttrInZip = zipFileTime Then
        GetFileAttributesInZip = zipFileDosTime(i)
    ElseIf AttrInZip = zipFileDateAndTime Then
        GetFileAttributesInZip = ((zipFileDosTime(i) And &H7FFF&) * &H10000) Or (zipFileDosDate(i) And &HFFFF&) Or (&H80000000 And zipFileDosTime(i) < 0)
    End If
End Function
Миниатюры
Как программно узнать закончил ли ZIP свою работу?  
Вложения
Тип файла: zip Чтение ZIP-файлов.zip (152.5 Кб, 11 просмотров)
1
Испарился
 Аватар для HackerVlad
1741 / 637 / 45
Регистрация: 10.09.2021
Сообщений: 2,769
01.03.2025, 20:20
Проверил это работает во всех системах, даже в Windows 98, сам лично проверял)
Удивляет тут то, что оказывается формат ZIP хранит имена файлов в досовской OEM-кодировке, а не в ANSI-Windows1251 как я думал, и как врут некоторые источники в интернете. Или в кодировке UTF8 но это только если уникодные имена там всякие китайские иероглифы содержатся например...
0
Испарился
 Аватар для HackerVlad
1741 / 637 / 45
Регистрация: 10.09.2021
Сообщений: 2,769
02.03.2025, 02:50
Цитата Сообщение от The trick Посмотреть сообщение
Тем более ты для инсталлятора делаешь.
С помощью этой технологии, которую я создал, можно теперь уже точно осуществить давнею мечту Антихакера и написать инсталлятор, я усовершенствовал код The trick для извлечения всех подпапок кодом zipfldr.dll плюс написал класс для того чтобы устанавливать время и атрибуты этим извлечённым файлам. Я уже всё проверил, у меня всё работает, и совершенно спокойно всё распаковывает из SFX-EXE (чем не инсталлятор) так что всё гуд.

Добавлено через 4 минуты
Мне пришлось написать этот класс и потратить целых 3 дня, только потому что почему-то нету атрибутов у извлекаемых файлов кодом zipfldr.dll.

Добавлено через 2 минуты
Цитата Сообщение от HackerVlad Посмотреть сообщение
Windows - это вообще странная штука. Упаковывать юникодные имена не хочет, а распаковывает спокойно...
И то распаковывает юникодные имена и залазит в папки с юникодными именами только начиная от Windows 7 видимо, так как в XP не работает это, я проверил.
Да и в XP время не проставляется атрибутом файлов кодом zipfld.dll (только в семёрке проставляется), поэтому приходится самому вручную устанавливать время файлам в XP кодом моего этого нового класса, который я написал
0
Испарился
 Аватар для HackerVlad
1741 / 637 / 45
Регистрация: 10.09.2021
Сообщений: 2,769
02.03.2025, 15:04
Я тут узнал, что Word записывает внутрь DOCX файла (а это как бы ZIP!) файлы PNG без сжатия, я понял это потому что наверное PNG - это итак формат картинок сжатых зипом. А если записывать внуть ZIP файлов картинки PNG ещё и сжимая буфер, то сжатый буфер будет даже больше чем сама картинка PNG на несколько байт...
0
Испарился
 Аватар для HackerVlad
1741 / 637 / 45
Регистрация: 10.09.2021
Сообщений: 2,769
02.03.2025, 15:26
Написал новую версию класса. Версия 1.2. Более удобная реализация. Теперь можно использовать класс как список (вместо массива) и теперь появились свойства размеров файлов и сжатых блоков файлов.

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
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
Option Explicit
'////////////////////////////////////////////
'// Класс для чтения ZIP-файлов            //
'// Copyright (c) 02.03.2025 by HackerVlad //
'// e-mail: vladislavpeshkov@ya.ru         //
'// Версия 1.2                             //
'////////////////////////////////////////////
 
' Декларации API ...
Private Declare Function CreateFileW Lib "kernel32" (ByVal lpFileName As Long, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function CreateFileA Lib "kernel32" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, ByVal lpBuffer As Long, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Any) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cbMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function GetMem2 Lib "msvbvm60" (src As Any, dst As Any) As Long
Private Declare Function GetMem4 Lib "msvbvm60" (src As Any, dst As Any) As Long
 
' Константы ...
Private Const OPEN_EXISTING As Long = 3
Private Const FILE_SHARE_READ = &H1
Private Const GENERIC_READ As Long = &H80000000
Private Const CREATE_ALWAYS = 2
Private Const EndOFCentralDirSignature As Long = &H6054B50
Private Const CentralFileHeaderSigniature As Long = &H2014B50
Private Const CP_UTF8 As Long = 65001
Private Const CP_OEMCP = 1 ' default to OEM code page
Private Const MB64 As Long = 67108864
 
Public Enum AttributesInZip
    zipFileAttr
    zipFileDate
    zipFileTime
    zipFileDateAndTime
End Enum
 
Public Enum FileNameCodePageInZip
    zipCodePageAutoDetect
    zipCodePageCP866
    zipCodePageUTF8
End Enum
 
' Переменные для хранения внутри экземпляра класса
Dim EntriesInTheCentralDir As Integer
Dim zipCountFiles As Integer
Dim zipCountDirs As Integer
Dim zipListFiles As New Collection
Dim zipListFilesCP866 As New Collection
Dim zipListFilesUTF8 As New Collection
Dim zipFileAttributes As New Collection
Dim zipFileDosDate As New Collection
Dim zipFileDosTime As New Collection
Dim zipFileSize As New Collection
Dim zipFileSizeCompressed As New Collection
 
' Открыть файл ZIP на чтение
Public Function OpenZip(ByVal ZipFileName As String) As Boolean
    Dim hFile As Long
    Dim dwBytesReaded As Long
    Dim nFileSize As Long
    Dim bArray() As Byte
    Dim i As Long
    Dim signature As Long
    Dim FileName As String
    Dim FileNameCP866 As String
    Dim FileNameUTF8 As String
    Dim OffSet As Long
    Dim FileNameLength As Integer
    Dim LastModFileTime As Integer
    Dim LastModFileDate As Integer
    Dim CompressedSize As Long
    Dim UnCompressedSize As Long
    Dim ExtraFieldLength As Integer
    Dim FileCommentLength As Integer
    Dim ExternalFileAttributes As Long
    Dim nOutputCharLen As Long
    Dim numread As Long
    Dim SetNewPosition As Long
    Dim MajorWindowsVersion As Long
    
    hFile = CreateFileW(StrPtr(ZipFileName), GENERIC_READ, FILE_SHARE_READ, ByVal 0&, OPEN_EXISTING, 0, 0)
    If hFile = 0 Then hFile = CreateFileA(ZipFileName, GENERIC_READ, FILE_SHARE_READ, ByVal 0&, OPEN_EXISTING, 0, 0)
    
    If hFile <> -1 And hFile <> 0 Then
        nFileSize = GetFileSize(hFile, ByVal 0&)
        
        If nFileSize <> -1 Then
            If nFileSize <= MB64 Then ' Если размер файла меньше 64 МБ то читать весь файл
                ReDim bArray(nFileSize - 1)
                ReadFile hFile, VarPtr(bArray(0)), nFileSize, dwBytesReaded, ByVal 0&
            Else ' Размер файла больше 64 МБ
                ReDim bArray(MB64 - 1)
                
                ' Прочитать только последние 64 МБ
                SetNewPosition = nFileSize - MB64
                SetFilePointer hFile, SetNewPosition, ByVal 0&, 1
                ReadFile hFile, VarPtr(bArray(0)), MB64, dwBytesReaded, ByVal 0&
            End If
            
            If dwBytesReaded > 0 Then
                For i = UBound(bArray) - 3 To LBound(bArray) Step -1
                    GetMem4 bArray(i), signature
                    
                    If signature = EndOFCentralDirSignature Then
                        Exit For
                    End If
                Next
                
                If i > 0 Then
                    ' Загрузить в переменные данные из файла (я решил не использовать структуры)
                    GetMem2 bArray(i + 10), EntriesInTheCentralDir
                    GetMem4 bArray(i + 16), OffSet
                    
                    If SetNewPosition > 0 Then
                        OffSet = OffSet - SetNewPosition
                    End If
                    
                    GetMem4 ByVal &H7FFE026C, MajorWindowsVersion
                    
                    If zipListFiles.Count > 0 Then Set zipListFiles = Nothing
                    If zipListFilesCP866.Count > 0 Then Set zipListFilesCP866 = Nothing
                    If zipListFilesUTF8.Count > 0 Then Set zipListFilesUTF8 = Nothing
                    If zipFileAttributes.Count > 0 Then Set zipFileAttributes = Nothing
                    If zipFileDosDate.Count > 0 Then Set zipFileDosDate = Nothing
                    If zipFileDosTime.Count > 0 Then Set zipFileDosTime = Nothing
                    If zipFileSize.Count > 0 Then Set zipFileSize = Nothing
                    If zipFileSizeCompressed.Count > 0 Then Set zipFileSizeCompressed = Nothing
                    
                    zipCountFiles = 0
                    zipCountDirs = 0
                    
                    For i = 1 To EntriesInTheCentralDir
                        GetMem4 bArray(OffSet), signature
                        
                        If signature = CentralFileHeaderSigniature Then
                            ' Получить всю необходимую информацию о файле
                            GetMem2 bArray(OffSet + 12), LastModFileTime
                            GetMem2 bArray(OffSet + 14), LastModFileDate
                            GetMem4 bArray(OffSet + 20), CompressedSize
                            GetMem4 bArray(OffSet + 24), UnCompressedSize
                            GetMem2 bArray(OffSet + 28), FileNameLength
                            GetMem2 bArray(OffSet + 30), ExtraFieldLength
                            GetMem2 bArray(OffSet + 32), FileCommentLength
                            GetMem4 bArray(OffSet + 38), ExternalFileAttributes
                            
                            OffSet = OffSet + 46
                            
                            FileName = String$(FileNameLength, vbNullChar)
                            CopyMemory ByVal StrPtr(FileName), bArray(OffSet), FileNameLength
                            
                            OffSet = OffSet + FileNameLength + ExtraFieldLength + FileCommentLength
                            
                            FileNameCP866 = Space$(FileNameLength)
                            FileNameUTF8 = Space$(FileNameLength)
                            
                            nOutputCharLen = MultiByteToWideChar(CP_OEMCP, 0&, StrPtr(FileName), -1, 0&, 0&) ' Получить размер буфера в символах для кодировки DOS
                            MultiByteToWideChar CP_OEMCP, 0&, StrPtr(FileName), -1, StrPtr(FileNameCP866), nOutputCharLen ' Преобразовать кодировки
                            nOutputCharLen = 0
                            nOutputCharLen = MultiByteToWideChar(CP_UTF8, 0&, StrPtr(FileName), -1, 0&, 0&) ' Получить размер буфера в символах для кодировки UTF8
                            MultiByteToWideChar CP_UTF8, 0&, StrPtr(FileName), -1, StrPtr(FileNameUTF8), nOutputCharLen ' Преобразовать кодировки
                            
                            FileNameUTF8 = Left$(FileNameUTF8, nOutputCharLen - 1)
                            FileNameCP866 = Replace$(FileNameCP866, "/", "\")
                            FileNameUTF8 = Replace$(FileNameUTF8, "/", "\")
                            
                            If (ExternalFileAttributes And vbDirectory) <> 0 Then
                                zipCountDirs = zipCountDirs + 1
                            Else
                                zipCountFiles = zipCountFiles + 1
                            End If
                            
                            If MajorWindowsVersion >= 6 And MajorWindowsVersion < 600 Then
                                If FileNameUTF8 Like "*[" & ChrW(-3) & "]*" Then ' Авто-определение кодировок
                                    zipListFiles.Add FileNameCP866 ' Кодировка DOS
                                Else
                                    zipListFiles.Add FileNameUTF8 ' Кодировка UTF8
                                End If
                            Else ' Windows версии меньше чем Vista
                                zipListFiles.Add FileNameCP866 ' Кодировка DOS
                            End If
                            
                            zipListFilesCP866.Add FileNameCP866
                            zipListFilesUTF8.Add FileNameUTF8
                            zipFileAttributes.Add ExternalFileAttributes
                            zipFileDosDate.Add LastModFileDate
                            zipFileDosTime.Add LastModFileTime
                            zipFileSize.Add UnCompressedSize
                            zipFileSizeCompressed.Add CompressedSize
                            
                            If OpenZip = False Then OpenZip = True
                        End If
                    Next
                End If
            End If
        End If
        
        CloseHandle hFile
    End If
End Function
 
' Возвращает количество файлов и каталогов внутри ZIP
Public Property Get CountFilesAndDirs() As Long
    CountFilesAndDirs = EntriesInTheCentralDir
End Property
 
' Возвращает количество файлов внутри ZIP
Public Property Get CountFiles() As Long
    CountFiles = zipCountFiles
End Property
 
' Возвращает количество каталогов внутри ZIP
Public Property Get CountDirs() As Long
    CountDirs = zipCountDirs
End Property
 
' Возвращает список файлов внутри ZIP, по индексу
Public Property Get List(ByVal Index As Integer, Optional ByVal CodePage As FileNameCodePageInZip) As String
    If zipListFiles.Count > 0 And Index > 0 Then
        If CodePage = zipCodePageAutoDetect Then
            List = zipListFiles(Index)
        ElseIf CodePage = zipCodePageCP866 Then
            List = zipListFilesCP866(Index)
        ElseIf CodePage = zipCodePageUTF8 Then
            List = zipListFilesUTF8(Index)
        End If
    End If
End Property
 
' Возвращает атрибуты файла внутри ZIP, по индексу
Public Property Get FileAttributes(ByVal Index As Integer) As Long
    If zipFileAttributes.Count > 0 And Index > 0 Then
        FileAttributes = zipFileAttributes(Index)
    End If
End Property
 
' Возвращает дату файла внутри ZIP, по индексу
Public Property Get FileDosDate(ByVal Index As Integer) As Integer
    If zipFileDosDate.Count > 0 And Index > 0 Then
        FileDosDate = zipFileDosDate(Index)
    End If
End Property
 
' Возвращает время создания файла внутри ZIP, по индексу
Public Property Get FileDosTime(ByVal Index As Integer) As Integer
    If zipFileDosTime.Count > 0 And Index > 0 Then
        FileDosTime = zipFileDosTime(Index)
    End If
End Property
 
' Возвращает размер файла внутри ZIP, по индексу
Public Property Get FileSize(ByVal Index As Integer) As Long
    If zipFileSize.Count > 0 And Index > 0 Then
        FileSize = zipFileSize(Index)
    End If
End Property
 
' Возвращает размер сжатого блока файла внутри ZIP, по индексу
Public Property Get FileSizeCompressed(ByVal Index As Integer) As Long
    If zipFileSizeCompressed.Count > 0 And Index > 0 Then
        FileSizeCompressed = zipFileSizeCompressed(Index)
    End If
End Property
 
' Записывает в массив список файлов из ZIP
Public Function ListFiles(arrFileNames() As String, Optional ByVal CodePage As FileNameCodePageInZip) As Boolean
    Dim i As Integer
    
    If zipListFiles.Count > 0 Then
        ReDim arrFileNames(zipListFiles.Count - 1)
        
        For i = 1 To zipListFiles.Count
            If CodePage = zipCodePageAutoDetect Then
                arrFileNames(i - 1) = zipListFiles(i)
            ElseIf CodePage = zipCodePageCP866 Then
                arrFileNames(i - 1) = zipListFilesCP866(i)
            ElseIf CodePage = zipCodePageUTF8 Then
                arrFileNames(i - 1) = zipListFilesUTF8(i)
            End If
        Next
        
        ListFiles = True
    End If
End Function
 
' Возвращает атрибуты файла внутри ZIP, а так же дату и время создания файлов
Public Function GetFileAttributesInZip(ByVal FileNameInZip As String, Optional ByVal AttrInZip As AttributesInZip) As Long
    Dim i As Integer
    
    If zipListFilesCP866.Count > 0 Then
        For i = 1 To zipListFilesCP866.Count
            If zipListFilesCP866(i) = FileNameInZip Then
                GoTo Subroutine
                Exit For
            End If
        Next
    End If
    If zipListFilesUTF8.Count > 0 Then
        For i = 1 To zipListFilesUTF8.Count
            If zipListFilesUTF8(i) = FileNameInZip Then
                GoTo Subroutine
                Exit For
            End If
        Next
    End If
    Exit Function
Subroutine:
    If AttrInZip = zipFileAttr Then
        GetFileAttributesInZip = zipFileAttributes(i)
    ElseIf AttrInZip = zipFileDate Then
        GetFileAttributesInZip = zipFileDosDate(i)
    ElseIf AttrInZip = zipFileTime Then
        GetFileAttributesInZip = zipFileDosTime(i)
    ElseIf AttrInZip = zipFileDateAndTime Then
        GetFileAttributesInZip = ((zipFileDosTime(i) And &H7FFF&) * &H10000) Or (zipFileDosDate(i) And &HFFFF&) Or (&H80000000 And zipFileDosTime(i) < 0)
    End If
End Function
Миниатюры
Как программно узнать закончил ли ZIP свою работу?  
Вложения
Тип файла: zip Чтение ZIP-файлов 1.2.zip (229.8 Кб, 2 просмотров)
2
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
raxper
Эксперт
30234 / 6612 / 1498
Регистрация: 28.12.2010
Сообщений: 21,154
Блог
02.03.2025, 15:26
Помогаю со студенческими работами здесь

Закончил ли свою работу animate, toggle
Вот к примеру есть код спойлера: var Spoiler = { showClass: 'plus', hideClass: 'minus', toggle: function(el) { var...

Как определить закончил ли работу поток?
Здравствуйте, как определить закончил ли работу поток? begin Potok1 := ParallelObj.Create(true); Potok2 :=...

Как узнать что WinSock закончил загрузку файла?
Здравствуйте! Наверняка, все кто начинали работать с winsock спрашивали о том-же, что и я сейчас хочу спросить. 1. Моя программа...

Как узнать, что клиет закончил отсылать пакеты?
Забиндил локалхост, посылаю на него пакеты последовательно одной секцией sequence number, после чего на стороне клиента завершаю...

Как сделать, чтобы один поток не закончил работу, пока второй работает?
Подскажите, есть например 2 потока, которые ну например отсчитывают в цикле до 100. Как сделать чтоб один не закончил работу пока второй...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
91
Ответ Создать тему
Новые блоги и статьи
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. Пошагово создадим проект для загрузки изображения. . .
SDL3 для Web (WebAssembly): Загрузка PNG с прозрачным фоном с помощью SDL3_image
8Observer8 10.02.2026
Содержание блога Библиотека SDL3_image содержит инструменты для расширенной работы с изображениями. Пошагово создадим проект для загрузки изображения формата PNG с альфа-каналом (с прозрачным. . .
Установка Qt-версии Lazarus IDE в Debian Trixie Xfce
volvo 10.02.2026
В общем, достали меня глюки IDE Лазаруса, собранной с использованием набора виджетов Gtk2 (конкретно: если набирать текст в редакторе и вызвать подсказку через Ctrl+Space, то после закрытия окошка. . .
SDL3 для Web (WebAssembly): Работа со звуком через SDL3_mixer
8Observer8 08.02.2026
Содержание блога Пошагово создадим проект для загрузки звукового файла и воспроизведения звука с помощью библиотеки SDL3_mixer. Звук будет воспроизводиться по клику мышки по холсту на Desktop и по. . .
SDL3 для Web (WebAssembly): Основы отладки веб-приложений на SDL3 по USB и Wi-Fi, запущенных в браузере мобильных устройств
8Observer8 07.02.2026
Содержание блога Браузер Chrome имеет средства для отладки мобильных веб-приложений по USB. В этой пошаговой инструкции ограничимся работой с консолью. Вывод в консоль - это часть процесса. . .
SDL3 для Web (WebAssembly): Обработчик клика мыши в браузере ПК и касания экрана в браузере на мобильном устройстве
8Observer8 02.02.2026
Содержание блога Для начала пошагово создадим рабочий пример для подготовки к экспериментам в браузере ПК и в браузере мобильного устройства. Потом напишем обработчик клика мыши и обработчик. . .
Философия технологии
iceja 01.02.2026
На мой взгляд у человека в технических проектах остается роль генерального директора. Все остальное нейронки делают уже лучше человека. Они не могут нести предпринимательские риски, не могут. . .
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2026, CyberForum.ru