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

@JoraVoenyjHaker · 25.10.2013, 17:43. **Показов** 4087. **Ответов** 13

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

Как программно организовать не прибегая к созданию файла CMD... BAT

1. Наличие файла в архиве ?
2. Извлечения из архива ?
3. Добавление в архив ?

какие типы для этого использовать ZIP RAR COM TAR....

Добавлено через 25 минут
может это умеет делать Shell.Application ?

Добавлено через 1 час 13 минут

НАШЁЛ !

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
'***************************************************************
Function CreateArchive(ZipArchivePath) As Boolean
Dim Shell As Object
Dim FileSystemObject As Object
Dim ArchiveFolder As Object
 
      Set Shell = CreateObject("Shell.Application")
      Set FileSystemObject = CreateObject("Scripting.FileSystemObject")
 
      ' Проверка наличия расширения zip в полном пути-имени файла
      If UCase(FileSystemObject.GetExtensionName(ZipArchivePath)) <> "ZIP" Then
           Exit Function
      End If
      ' Создание пустого zip архива
Dim ZipFileHeader As String
      ZipFileHeader = "PK" & Chr(5) & Chr(6) & String(18, 0)
      FileSystemObject.OpenTextFile(ZipArchivePath, 2, True).Write ZipFileHeader
      Set ArchiveFolder = Shell.NameSpace((ZipArchivePath))
      ' проверка создания архива
      If Not (ArchiveFolder Is Nothing) Then CreateArchive = True
End Function
'***************************************************************

@Catstail · 25.10.2013, 17:47

Вот мой довольно старый код получения оглавления zip-архива:

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
Function ZipCont(ArcName As String) As String()
Dim Fnames() As String
   ReDim Fnames(1 To 300) As String
   ZIP% = FreeFile
   Open ArcName For Binary Access Read As #ZIP%
   PZip& = 0
   ptrF% = 0
   sz% = 300
   Do
      C30$ = Space$(30)
      Get ZIP%, , C30$
      PZip& = PZip& + 30
      If Mid$(C30$, 3, 2) <> Chr$(3) + Chr$(4) Then Exit Do
      Ln% = CVI(Mid$(C30$, 27, 2))
      NameFile$ = Space$(Ln%)
      Get ZIP%, , NameFile$
      PZip& = PZip& + Ln%
      C4$ = Mid$(C30$, 19, 4)
      LL& = CVL(C4$)
      L% = Len(NameFile$)
      For ia% = L% To 1 Step -1
          If Mid$(NameFile$, ia%, 1) = "/" Then
             NameFile$ = Right$(NameFile$, (L% - ia%))
             Exit For
          End If
      Next ia%
      NAM$ = ""
      EXT$ = ""
      p% = InStr(NameFile$, ".")
      L% = Len(NameFile$)
      If p% = 0 Then
         NAM$ = NameFile$
      Else
         NAM$ = Left$(NameFile$, (p% - 1))
         EXT$ = Right$(NameFile$, (L% - p%))
      End If
      ptrF% = ptrF% + 1
      If ptrF% > sz% Then
         ReDim Preserve Fnames(1 To sz% + 300) As String
         sz% = sz% + 300
      End If
      Fnames(ptrF%) = NAM$ + "." + EXT$
      PZip& = PZip& + LL&
      Seek ZIP%, PZip& + 1
   Loop
   Close ZIP%
   ReDim Preserve Fnames(1 To ptrF% - 1) As String
   ZipCont = Fnames
End Function
 
Public Function CVI(CC As String)
Dim PP As Integer
    PP = 0
    For i% = 2 To 1 Step -1
        C1$ = Mid$(CC, i%, 1)
        PP = PP * 256 + Asc(C1$)
    Next i%
    CVI = PP
End Function
 
Public Function CVL(CC As String)
Dim PP As Long
    PP = 0
    For i% = 4 To 1 Step -1
        C1$ = Mid$(CC, i%, 1)
        PP = PP * 256 + Asc(C1$)
    Next i%
    CVL = PP
End Function
 
Sub Test()
Dim ZipArc() As String
    zipName$ = "C:\sv00.zip"
    ZipArc = ZipCont(zipName$)
    For i% = 1 To UBound(ZipArc, 1)
        Debug.Print ZipArc(i%)
    Next i%
End Sub

@JoraVoenyjHaker · 25.10.2013, 18:03 **[ТС]**

Запись в архив !

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
'***************************************************************
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
 
Sub CopyFileToArchiv(ZipName As String, FileName As String)
' ZipName - полный путь к архиву
' FileName - полный путь к архивируемому файлу
Dim ShellApp As Object
Dim DestFolder As Object
 
      Set ShellApp = CreateObject("Shell.Application")
      Set DestFolder = ShellApp.NameSpace((ZipName))
      ' копируемый выбранный файл в zip папку
      DestFolder.CopyHere (FileName)
      ' ожидаем окончание сжатия файла
      Do Until DestFolder.Items.Count = 1
           Sleep 100
      Loop
 
      Set ShellApp = Nothing
 
End Sub
'*

Добавлено через 11 минут
Так можно узнать имена фойлов в ZIP-архиве !

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Public Function fnNameArchiveFile(ZipName As String, Optional i As Integer = 0, _
Optional fext As Boolean = True) As String
' ZipName - имя архива
' i - номер файла в архиве (начало с 0), по умолчанию - 0
' fext - включать расширение в имя файла, по умолчанию - true
Dim objShellApp As Object
Dim objFolder As Object
 
      Set objShellApp = CreateObject("Shell.Application")
      Set objFolder = objShellApp.NameSpace((ZipName))
      If fext Then
           fnNameArchiveFile = objFolder.Items().Item((i)).Path
      Else
           fnNameArchiveFile = objFolder.Items().Item((i)).Name
      End If
 
End Function

Добавлено через 4 минуты
И з в л е ч е н и е ! (всё вопрос я снимаю !

)

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
Public Sub UnZipFile(ZipName As String, DestPath As String)
' ZipName - полный путь к архиву
' DestPath - полный путь к папке для распаковки архива
 
Dim ShellApp As Object
 
      Set ShellApp = CreateObject("Shell.Application")
      'Copy the files in the newly created folder
      ShellApp.NameSpace((DestPath)).CopyHere ShellApp.NameSpace((ZipName)).Items
      Set ShellApp = Nothing
 
End Sub

@Catstail · 25.10.2013, 18:26

А вот так - в Arj-архиве:

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
Function ArjCont(ArcName As String) As String()
Dim Fnames() As String
   ReDim Fnames(1 To 300) As String
   sz% = 30
   Arj% = FreeFile
   Open ArcName For Binary Access Read As #Arj%
   OO& = 1
   NE% = 0
   Do
      Seek #Arj%, OO&
      Signature$ = "  "
      Get #Arj%, , Signature$
      If Signature$ <> Chr$(&H60) + Chr$(&HEA) Then
         Close #Arj%
         ReDim Fnames(1 To 1) As String
         ArjCont = Fnames
         Exit Function
      End If
      LL$ = " "
      Get #Arj%, , LL$
      LL_& = Asc(LL$)
      If LL_& = 0 Then Exit Do
      BUF$ = Space$((LL_& + 7))
      Get #Arj%, , BUF$
      NameFile$ = ""
      For i% = 32 To Len(BUF$)
          S$ = Mid$(BUF$, i%, 1)
          If S$ = Chr$(0) Then Exit For
          NameFile$ = NameFile$ + S$
      Next i%
      If NE% > 0 Then
         ptrF% = ptrF% + 1
         If ptrF% > sz% Then
            ReDim Preserve Fnames(1 To sz% + 300) As String
            sz% = sz% + 300
         End If
         Fnames(ptrF%) = NameFile$
      End If
      C4$ = Mid$(BUF$, 14, 4)
      LF& = CVL(C4$)
      If NE% = 0 Then
         OO& = OO& + (LL_& + 10)
      Else
         OO& = OO& + (LL_& + 10 + LF&)
      End If
      NE% = NE% + 1
   Loop
   Close Arj%
   ReDim Preserve Fnames(1 To ptrF%) As String
   ArjCont = Fnames
End Function

@JoraVoenyjHaker · 25.10.2013, 18:39 **[ТС]**

Спасибо, а какой способ лучше Arj или Zip
тоесть
1 совместимость в OS
2 скорость
3 эфективность ?

@Catstail · 25.10.2013, 18:41

Какой архиватор лучше? Это - тема для холивара!
Zip есть везде. По остальным параметрам затрудняюсь ответить.

@JoraVoenyjHaker · 25.10.2013, 18:50 **[ТС]**

Я допишу в своём модуле файловых операций, и вcтавлю дополнительные флаги

Добавлено через 7 минут
% ? кстате почему вы используете интегры а не Long &

@Catstail · 25.10.2013, 18:53

Этот код работал еще в DOS... А integer вдвое короче long.

@JoraVoenyjHaker · 25.10.2013, 18:56 **[ТС]**

Я читал статью что процессоры X86 наоборот с Long быстрее работают, ну тоесть 32бит

@Catstail · 25.10.2013, 19:07

Да, быстрее, но 640K памяти в DOS-е не всегда хватало.

@JoraVoenyjHaker · 25.10.2013, 19:17 **[ТС]**

Ястно % для DOS варианта

Dragokas · 26.10.2013, 00:58

JoraVoenyjHaker, спасибо, и особенно Catstail - шикарно!

Из интернетов еще - VBScript Class:

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
'/// Класс создания ZIP-файла средствами Windows
'/// Автор: ALX_2002
 
'/// Пример работы с классом 
Set FileSytemObject = CreateObject("Scripting.FileSystemObject") 
 
'/// Получаем путь до каталога в котором находимся 
ParentFolderName = FileSytemObject.GetParentFolderName(Wscript.ScriptFullName) 
 
'/// Строим путь для создания тестового файла 
SourceFilePath = FileSytemObject.BuildPath(ParentFolderName,"Текстовый документ.txt") 
 
'/// Создаём и заполняем файл содержимым 
FileSytemObject.OpenTextFile(SourceFilePath,2,True).write "Содержимое файла" 
 
'/// Создаём архив 
DestFilePath = FileSytemObject.BuildPath(ParentFolderName,"1.zip") 
 
'/// Создаём класс создания ZIP файла 
Set Zip = New ZipClass 
 
'/// Открываем новый архив 
Zip.CreateArchive DestFilePath 
'/// Добавляем файл в архив 
Zip.CopyFileToArchive SourceFilePath 
'/// Закрываем архив 
Zip.CloseArchive 
 
MsgBox "Архив создан",vbInformation,"ZipClass" 
 
 
'/// Код класса 
Class ZipClass 
        Private Shell 
 
        Private FileSystemObject 
 
        Private ArchiveFolder 
 
        Private ItemsCount 
        
        Private Sub Class_Initialize() 
            Set Shell = CreateObject("Shell.Application") 
            Set FileSystemObject = CreateObject("Scripting.FileSystemObject") 
        End Sub 
 
        Function CreateArchive(ZipArchivePath) 
 
            If UCase(FileSystemObject.GetExtensionName(ZipArchivePath)) <> "ZIP" Then 
                Exit Function 
            End If 
            
            Dim ZipFileHeader 
            
            ZipFileHeader = "PK" & Chr(5) & Chr(6) & String(18, 0) 
            
            FileSystemObject.OpenTextFile(ZipArchivePath, 2, True).Write ZipFileHeader 
            
            Set ArchiveFolder = Shell.NameSpace(ZipArchivePath) 
        
                if Not (ArchiveFolder is Nothing) Then CreateArchive = True 
        End Function 
 
        Function CopyFileToArchive(FilePath) 
                if (ArchiveFolder is Nothing) Then Exit Function 
            ArchiveFolder.CopyHere FilePath 
                ItemsCount = ItemsCount + 1 
        End Function 
 
        Function CopyFolderToArchive(FolderPath) 
                if (ArchiveFolder is Nothing) Then Exit Function 
            ArchiveFolder.CopyHere FolderPath 
                ItemsCount = ItemsCount + 1 
        End Function 
 
        Function CloseArchive 
                if (ArchiveFolder is Nothing) Then Exit Function 
                Set WsriptShell = CreateObject("Wscript.Shell") 
      if IsObject(Wscript) Then 
         Do 
            Wscript.Sleep 100 
                    Loop Until ArchiveFolder.Items.Count => ItemsCount 
      Else 
         ServerSleep 
      End if 
           ItemsCount = 0 
        End Function 
 
   Private Function ServerSleep 
                Set WsriptShell = CreateObject("Wscript.Shell") 
      Do 
         WsriptShell.Popup "",1,"" 
                Loop Until ArchiveFolder.Items.Count => ItemsCount 
   End Function 
 
        Function MoveFileToArchive(FilePath) 
                if (ArchiveFolder is Nothing) Then Exit Function 
            ArchiveFolder.MoveHere FilePath 
        End Function 
End Class

Добавлено через 3 минуты

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

Спасибо, а какой способ лучше Arj или Zip
тоесть
1 совместимость в OS
2 скорость
3 эфективность ?

Ну архив ZIP открывается по-умолчанию средствами XP, поэтому лично для меня выбор очевиден.
Остальные обсуждения - да, тема для холиваров.

@JoraVoenyjHaker · 26.10.2013, 01:09 **[ТС]**

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

'/// Открываем новый архив
Zip.CreateArchive DestFilePath

с ним ещё и как с объектом можно работать ! Неожиданное для меня познание

Dragokas · 26.10.2013, 01:15

Не по теме:

Да, я тоже раньше не знал, что VBScript поддерживает классы.

Новые блоги и статьи Все статьи Все блоги /
Модель заражения группы наркоманов alhaos 17.04.2026 Условия задачи сформулированы тут Суть: - Группа наркоманов из 10 человек. - Только один инфицирован ВИЧ. - Колются одной иглой. - Колются раз в день. - Колются последовательно через. . .	Мысли в слух. Про "навсегда". kumehtar 16.04.2026 Подумалось тут, что наверное очень глупо использовать во всяких своих установках понятие "навсегда". Это очень сильное понятие, и я только начинаю понимать край его смысла, не смотря на то что давно. . .	My Business CRM MaGz GoLd 16.04.2026 Всем привет, недавно возникла потребность создать CRM, для личных нужд. Собственно программа предоставляет из себя базу данных клиентов, в которой можно фиксировать звонки, стадии сделки, а также. . .	Знаешь почему 90% людей редко бывают счастливыми? kumehtar 14.04.2026 Потому что они ждут. Ждут выходных, ждут отпуска, ждут удачного момента. . . а удачный момент так и не приходит.
Фиксация колонок в отчете СКД Maks 14.04.2026 Фиксация колонок в СКД отчета типа Таблица. Задача: зафиксировать три левых колонки в отчете. Процедура ПриКомпоновкеРезультата(ДокументРезультат, ДанныеРасшифровки, СтандартнаяОбработка) / / . . .	Настройки VS Code Loafer 13.04.2026 { "cmake. configureOnOpen": false, "diffEditor. ignoreTrimWhitespace": true, "editor. guides. bracketPairs": "active", "extensions. ignoreRecommendations": true, . . .	Оптимизация кода на разграничение прав доступа к элементам формы Maks 13.04.2026 Алгоритм из решения ниже реализован на нетиповом документе, разработанного в конфигурации КА2. Задачи, как таковой, поставлено не было, проделанное ниже исключительно моя инициатива. Было так:. . .	Контроль заполнения и очистка дат в зависимости от значения перечислений Maks 12.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "ПланированиеПерсонала", разработанного в конфигурации КА2. Задача: реализовать контроль корректности заполнения дат назначения. . .

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

Решение

Решение

Решение

@JoraVoenyjHaker Заблокирован
	25.10.2013, 18:39 [ТС]
	Спасибо, а какой способ лучше Arj или Zip тоесть 1 совместимость в OS 2 скорость 3 эфективность ? 0

@Catstail Супер-модератор 38203 / 21135 / 4310 Регистрация: 12.02.2012 Сообщений: 34,741 Записей в блоге: 14
	25.10.2013, 18:41
	Какой архиватор лучше? Это - тема для холивара! Zip есть везде. По остальным параметрам затрудняюсь ответить. 0

@JoraVoenyjHaker Заблокирован
	25.10.2013, 18:50 [ТС]
	Я допишу в своём модуле файловых операций, и вcтавлю дополнительные флаги Добавлено через 7 минут % ? кстате почему вы используете интегры а не Long & 0

@Catstail Супер-модератор 38203 / 21135 / 4310 Регистрация: 12.02.2012 Сообщений: 34,741 Записей в блоге: 14
	25.10.2013, 18:53
	Этот код работал еще в DOS... А integer вдвое короче long. 0

@JoraVoenyjHaker Заблокирован
	25.10.2013, 18:56 [ТС]
	Я читал статью что процессоры X86 наоборот с Long быстрее работают, ну тоесть 32бит 0

@Catstail Супер-модератор 38203 / 21135 / 4310 Регистрация: 12.02.2012 Сообщений: 34,741 Записей в блоге: 14
	25.10.2013, 19:07
	Да, быстрее, но 640K памяти в DOS-е не всегда хватало. 1

@JoraVoenyjHaker Заблокирован
	25.10.2013, 19:17 [ТС]
	Ястно % для DOS варианта 0

Dragokas
	26.10.2013, 01:15
	Не по теме: Да, я тоже раньше не знал, что VBScript поддерживает классы. 0