MyTetra Share
Делитесь знаниями!
Работа с архивом - Visual Basic
Время создания: 31.07.2019 22:59
Текстовые метки: vba_zip
Раздел: !Закладки - VBA - VBA ZIP
Запись: xintrea/mytetra_db_adgaver_new/master/base/1511687487yny8d9nvwk/text.html на raw.githubusercontent.com

1c yberforum.ru

Работа с архивом - Visual Basic

18-25 минут



@JoraVoenyjHaker

Заблокирован

#1

25.10.2013, 17:43. Просмотров 1193. Ответов 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


@Catstail

Модератор

22842 / 11208 / 1813

Регистрация: 12.02.2012

Сообщений: 18,447

25.10.2013, 17:47

#2

Сообщение было отмечено автором темы, экспертом или модератором как ответ

Вот мой довольно старый код получения оглавления 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

Модератор

22842 / 11208 / 1813

Регистрация: 12.02.2012

Сообщений: 18,447

25.10.2013, 18:26

#4

Сообщение было отмечено автором темы, экспертом или модератором как ответ

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



Visual BasicВыделить код

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

Модератор

22842 / 11208 / 1813

Регистрация: 12.02.2012

Сообщений: 18,447

25.10.2013, 18:41

#6

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

0


@JoraVoenyjHaker

Заблокирован

25.10.2013, 18:50  [ТС]

#7

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

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


% ?

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

0


@Catstail

Модератор

22842 / 11208 / 1813

Регистрация: 12.02.2012

Сообщений: 18,447

25.10.2013, 18:53

#8

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

0


@JoraVoenyjHaker

Заблокирован

25.10.2013, 18:56  [ТС]

#9

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

0


@Catstail

Модератор

22842 / 11208 / 1813

Регистрация: 12.02.2012

Сообщений: 18,447

25.10.2013, 19:07

#1 0

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

1


@JoraVoenyjHaker

Заблокирован

25.10.2013, 19:17  [ТС]

#1 1

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

0


Dragokas

16045 / 6863 / 826

Регистрация: 25.12.2011

Сообщений: 10,619

Записей в блоге:

16

26.10.2013, 00:58

#1 2

Сообщение было отмечено автором темы, экспертом или модератором как ответ

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  [ТС]

#1 3

Сообщение от

Dragokas

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

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

0


Dragokas

26.10.2013, 01:15     Работа с архивом

Не по теме:

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

0


MoreAnswers

Эксперт

37091 / 29110 / 5898

Регистрация: 17.06.2006

Сообщений: 43,301

26.10.2013, 01:15

14


 
MyTetra Share v.0.59
Яндекс индекс цитирования