Форум программистов, компьютерный форум, киберфорум
Наши страницы
Visual Basic
Войти
Регистрация
Восстановить пароль
 
Рейтинг 5.00/8: Рейтинг темы: голосов - 8, средняя оценка - 5.00
JoraVoenyjHaker
Заблокирован
1

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

25.10.2013, 17:43. Просмотров 1500. Ответов 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
'***************************************************************
0
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
25.10.2013, 17:43
Ответы с готовыми решениями:

Работа с zip архивом
Заинтересовался вот чем: Как с помощью кода С++ разархивировать запароленую папку зная пароль?...

Работа с архивом через ZipForge
Добрый день, вобщем проблема такая... на форме содержится канва и поле мемо, как можно всю...

JavaScript. Работа с архивом - распаковка
Доброго времени суток. Ищу уже 2-й день работу с архивом. Примеров тьма, но я так и не могу понять...

Работа с архивом (Избегайте использования "\\.\" в пути.)
Здравствуйте! При извлечении архива: код: ZipFile zf = new...

Передача файлов по сети архивом
Добрый день. Пишу что-то вроде своей системы обновления версий. Мне надо скопировать файлы на...

13
Catstail
Модератор
24290 / 12257 / 2209
Регистрация: 12.02.2012
Сообщений: 19,889
25.10.2013, 17:47 2
Лучший ответ Сообщение было отмечено The trick как решение

Решение

Вот мой довольно старый код получения оглавления 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
1
JoraVoenyjHaker
Заблокирован
25.10.2013, 18:03  [ТС] 3
Запись в архив !

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
0
Catstail
Модератор
24290 / 12257 / 2209
Регистрация: 12.02.2012
Сообщений: 19,889
25.10.2013, 18:26 4
Лучший ответ Сообщение было отмечено The trick как решение

Решение

А вот так - в 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
1
JoraVoenyjHaker
Заблокирован
25.10.2013, 18:39  [ТС] 5
Спасибо, а какой способ лучше Arj или Zip
тоесть
1 совместимость в OS
2 скорость
3 эфективность ?
0
Catstail
Модератор
24290 / 12257 / 2209
Регистрация: 12.02.2012
Сообщений: 19,889
25.10.2013, 18:41 6
Какой архиватор лучше? Это - тема для холивара!
Zip есть везде. По остальным параметрам затрудняюсь ответить.
0
JoraVoenyjHaker
Заблокирован
25.10.2013, 18:50  [ТС] 7
Я допишу в своём модуле файловых операций, и вcтавлю дополнительные флаги

Добавлено через 7 минут
% ? кстате почему вы используете интегры а не Long &
0
Catstail
Модератор
24290 / 12257 / 2209
Регистрация: 12.02.2012
Сообщений: 19,889
25.10.2013, 18:53 8
Этот код работал еще в DOS... А integer вдвое короче long.
0
JoraVoenyjHaker
Заблокирован
25.10.2013, 18:56  [ТС] 9
Я читал статью что процессоры X86 наоборот с Long быстрее работают, ну тоесть 32бит
0
Catstail
Модератор
24290 / 12257 / 2209
Регистрация: 12.02.2012
Сообщений: 19,889
25.10.2013, 19:07 10
Да, быстрее, но 640K памяти в DOS-е не всегда хватало.
1
JoraVoenyjHaker
Заблокирован
25.10.2013, 19:17  [ТС] 11
Ястно % для DOS варианта
0
Dragokas
Эксперт WindowsАвтор FAQ
17058 / 7113 / 861
Регистрация: 25.12.2011
Сообщений: 10,924
Записей в блоге: 16
26.10.2013, 00:58 12
Лучший ответ Сообщение было отмечено The trick как решение

Решение

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, поэтому лично для меня выбор очевиден.
Остальные обсуждения - да, тема для холиваров.
2
JoraVoenyjHaker
Заблокирован
26.10.2013, 01:09  [ТС] 13
Цитата Сообщение от Dragokas Посмотреть сообщение
'/// Открываем новый архив
Zip.CreateArchive DestFilePath
с ним ещё и как с объектом можно работать ! Неожиданное для меня познание
0
Dragokas
26.10.2013, 01:15     Работа с архивом
  #14

Не по теме:

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

0
26.10.2013, 01:15
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
26.10.2013, 01:15
Привет! Вот еще темы с ответами:

ZipFile распаковка в директорию с архивом
Мне надо сделать так, что архив распаковывался в папку с архивом (Архив находится в папке с...

Не могу воспользоваться архивом Хорстманна, подскажите
Не могу воспользоваться архивом Хорстманна, подскажите, пожалуйста Посмотрел по запросу Google:...

Как заставить PS работать с архивом EventLog'a?
Доброго времени суток. Имеется некоторые сервер на котором генерируется туча событий в минуту...


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

Или воспользуйтесь поиском по форуму:
14
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2019, vBulletin Solutions, Inc.
Рейтинг@Mail.ru