PDA

Vollständige Version anzeigen : Packen + Entpacken


ebs17
02.02.2013, 19:56
Trotz wachsender Bandbreiten bei der Datenübertragung (Internet) und trotz wachsender Speicherkapazitäten (Festplatten) bleibt es interessant, Dateien zum Versand an Dritte sowie Dateien zur eigenen Archivierung zu packen.
Wenn man nun eine Lösung sucht, wo man keine Lizenzkosten beachten muss und wo man sich auch ein wenig unabhängig von der Windows-internen ZIP-Lösung machen kann (ein Sicherheitspatch hat da manchmal gravierende Folgen), kann der Blick auch auf die Open Source-Software 7-Zip (http://www.7-zip.de/) fallen.

Zur Weitergabe einer Packen-/Entpacken-Lösung zusammen mit seiner Anwendung kann man aus der 7-Zip-Installation die Datei 7za.exe entnehmen und verwenden. Diese Exe-Datei kann als Standalone verwendet werden, ist aber gegenüber der Gesamtinstallation etwas in den Möglichkeiten reduziert. Zum Packen und Entpacken und etwas mehr reicht es aber allemal, und das Kopieren dieser EXE-Datei in das eigene Anwendungsverzeichnis ohne jegliche Registrierung ist leicht lösbar. Über Kommandozeilenbefehle, die man der ebenfalls vorhandenen Hilfedatei entnehmen kann, lassen sich die gewünschten Aktionen auslösen.

In der Anwendung können asynchrone Abläufe entstehen: VBA-Code läuft weiter, bevor ein Packen/Entpacken abgeschlossen ist.
Daher wurde im folgenden Codebeispiel der einfache Shell-Aufruf durch einen ShellX-Aufruf (Jost Schwider) ersetzt:
Private Declare Function CloseHandle Lib "kernel32" ( _
ByVal hObject As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" ( _
ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" ( _
ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long

' Programm starten, warten, ExitCode bestimmen
' ©2002 by Jost Schwider, http://vb-tec.de/xshell.htm
Private Function ShellX(ByVal PathName As String, _
Optional ByVal WindowStyle As Long = vbMinimizedFocus, _
Optional ByVal Events As Boolean = True _
) As Long

'Deklarationen:
Const STILL_ACTIVE = &H103&
Const PROCESS_QUERY_INFORMATION = &H400&
Dim ProcId As Long
Dim ProcHnd As Long

'Prozess-Handle holen:
ProcId = Shell(PathName, WindowStyle)
ProcHnd = OpenProcess(PROCESS_QUERY_INFORMATION, True, ProcId)

'Auf Prozess-Ende warten:
Do
If Events Then DoEvents
GetExitCodeProcess ProcHnd, ShellX
Loop While ShellX = STILL_ACTIVE

'Aufräumen:
CloseHandle ProcHnd
End Function

Public Function Zip_7z(ByVal ExecuteFile As String, ByVal ArchivFile As String, _
ByVal AddFiles As String, Optional ByVal KeyWord As String) As Long
Dim sCommand As String

sCommand = Chr(34) & ExecuteFile & Chr(34) & " a " & _
Chr(34) & ArchivFile & Chr(34) & " "
If Len(KeyWord) > 0 Then sCommand = sCommand & "-p" & KeyWord & " "
sCommand = sCommand & Chr(34) & AddFiles & Chr(34)

Zip_7z = ShellX(sCommand)
End Function

Public Function Unzip_7z(ByVal ExecuteFile As String, ByVal ArchivFile As String, _
ByVal TargetDirectory As String, Optional ByVal KeyWord As String) As Long
Dim sCommand As String

sCommand = Chr(34) & ExecuteFile & Chr(34) & " e " & _
Chr(34) & ArchivFile & Chr(34) & " -aoa "
If Len(KeyWord) > 0 Then sCommand = sCommand & "-p" & KeyWord & " "
sCommand = sCommand & "-o" & Chr(34) & TargetDirectory & Chr(34)

Unzip_7z = ShellX(sCommand)
End Function