VB.NET-Tipp 0152: (Un-)Zippen ohne Zusatz-Komponente

von Spatzenkanonier

Beschreibung
Der Windows Dateiexplorer bietet die Möglichkeit über den Kontextmenueintrag "Senden an -> komprimierten Ordner" einen Ordner in einer Zip-Datei zu verpacken. Hier wird dieser Befehl codeseitig ausgeführt. Einigen Aufwand bereitet das "Late Binding" der COM-Library "MS Shell Control and Automation" (Namespace "Shell32"), die neben vielem anderen diese Funktion enthält.

Dank an Timo Boehme (Idee) und Kai (COM-Interface Know How)
Schwierigkeitsgrad:
Schwierigkeitsgrad 3
Framework-Version(en):
.NET Framework 1.0, .NET Framework 1.1, .NET Framework 2.0, .NET Framework 3.0, .NET Framework 3.5, .NET Framework 4
.NET-Version(en):
Visual Basic 2002, Visual Basic 2003, Visual Basic 2005, Visual Basic 2008, Visual Basic 2010
Download:
Download des Beispielprojektes [11,91 KB]
' Dieser Quellcode stammt von http://www.activevb.de
' und kann frei verwendet werden. Für eventuelle Schäden
' wird nicht gehaftet.

' Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
' Ansonsten viel Spaß und Erfolg mit diesem Source!

' Projektversion:   Visual Studio 2008
' Option Strict:    Aus
' Option Explicit:  An
' Option Infer:     An
'
' Referenzen: 
'  - System
'  - System.Data
'  - System.Deployment
'  - System.Xml
'  - System.Core
'  - System.Xml.Linq
'  - System.Data.DataSetExtensions
'
' Imports: 
'  - Microsoft.VisualBasic
'  - System
'  - System.Collections
'  - System.Collections.Generic
'  - System.Data
'  - System.Diagnostics
'  - System.Linq
'  - System.Xml.Linq
'

' ##############################################################################
' ################################ Module1.vb ##################################
' ##############################################################################
Module Module1

    Sub Main()
        ' Zippt und unzippt 2 Ebenen über dem Ausführungs-Ordner
        Dim toZip = "..\..\"
        Dim zipFile = toZip & "..\Zipped.zip"
        Using zp = New ShellZipper
            zp.Zip(toZip, zipFile)
            Console.WriteLine("Zip done")
            Console.ReadLine()
            zp.UnZip(zipFile) '(optionalen Entpack-Zielpfad weggelassen)
            Console.WriteLine("UnZip done")
            Console.ReadLine()
        End Using
    End Sub

End Module

' ##############################################################################
' ################################ Shell32.vb ##################################
' ##############################################################################
Imports System.Runtime.InteropServices

Namespace Shell32
    ' Hier werden die Schnittstellen von Klassen der Com-Library 
    '  "MS Shell Controls and Automation" implementiert, mit denen ein 
    '  Kopiervorgang durchgeführt werden kann. Dieser Kopiervorgang
    '  akzeptiert auch Zip-Dateien, nämlich als "zip-komprimierte Ordner".

    '  Die Information über Typen, Attribute und Reihenfolge der 
    '   Schnittstellenmember sind in C:\Program Files\Microsoft Visual Studio 8\
    '   VC\PlatformSDK\Include\shldisp.idl dokumentiert. Wer diese Doku in 
    '   Augenschein nehmen will, kann, falls er shldisp.idl nicht findet, das
    '   Visual Studio 2008 SDK 1.1 downloaden: 
    '   http://www.microsoft.com/downloads/details.aspx?displaylang=en&FamilyID=59ec6ec3-4273-48a3-ba25-dc925a45584d

    <Guid("00020400-0000-0000-c000-000000000046")> _
    <InterfaceType(ComInterfaceType.InterfaceIsIUnknown)> _
    Public Interface IDispatch
        <PreserveSig()> _
        Function GetTypeInfoCount() As Integer
        Function GetTypeInfo( _
            <MarshalAs(UnmanagedType.U4)> ByVal iTInfo As Integer, _
            <MarshalAs(UnmanagedType.U4)> ByVal lcid As Integer _
            ) As ComTypes.ITypeInfo
        <PreserveSig()> _
        Function GetIDsOfNames(ByRef riid As Guid, ByVal rgsNames As String(), _
          <MarshalAs(UnmanagedType.U4)> ByVal cNames As Integer, _
          <MarshalAs(UnmanagedType.U4)> ByVal lcid As Integer, _
          ByVal rgDispId As Integer()) As Integer
        <PreserveSig()> _
        Function Invoke(ByVal dispIdMember As Integer, ByRef riid As Guid, _
          <MarshalAs(UnmanagedType.U4)> ByVal lcid As Integer, _
          <MarshalAs(UnmanagedType.U4)> ByVal dwFlags As Integer, _
          ByRef pDispParams As ComTypes.DISPPARAMS, _
          <Out()> ByVal pVarResult As Object(), _
          ByRef pExcepInfo As ComTypes.EXCEPINFO, _
          <Out()> ByVal pArgErr As IntPtr()) As Integer
    End Interface

    <ComImport()> _
    <Guid("D8F015C0-C278-11CE-A49E-444553540000")> _
    <TypeLibType(TypeLibTypeFlags.FOleAutomation)> _
    <InterfaceType(ComInterfaceType.InterfaceIsDual)> _
    Public Interface IShellDispatch
        ReadOnly Property Application() As IDispatch
        ReadOnly Property Parent() As IDispatch
        Function [Namespace](ByVal vDir As Object) As Folder
        Function BrowseForFolder(ByVal hWnd As Integer, _
                                 ByVal Title As String, _
                                 ByVal Otions As Integer, _
                                 ByVal RootFolder As Object) As Folder
        Function Windows() As IDispatch 'IDispatch
        Sub Open(ByVal vDir As Object)
        Sub Explore(ByVal vDir As Object)
        Sub MinimizeAll()
        Sub UndoMinimizeALL()
        Sub FileRun()
        Sub CascadeWindows()
        Sub TileVertically()
        Sub TileHorizontally()
        Sub ShutdownWindows()
        Sub Suspend()
        Sub EjectPC()
        Sub SetTime()
        Sub TrayProperties()
        Sub Help()
        Sub FindFiles()
        Sub FindComputer()
        Sub RefreshMenu()
        Sub ControlPanelItem(ByVal bstrDir As String)
    End Interface

    <ComImport()> _
    <Guid("BBCBDE60-C3FF-11CE-8350-444553540000")> _
    <TypeLibType(TypeLibTypeFlags.FOleAutomation)> _
    <InterfaceType(ComInterfaceType.InterfaceIsDual)> _
    Public Interface Folder
        ReadOnly Property Title() As String
        ReadOnly Property Application() As IDispatch
        ReadOnly Property Parent() As IDispatch
        ReadOnly Property ParentFolder() As Folder ' Shell32.Folder

        ' Shell32.FolderItems
        Function Items() As FolderItems
        ' Shell32.FolderItem
        Function ParseName(ByVal bName As String) As FolderItem
        Sub NewFolder(ByVal bName As String, _
                      Optional ByVal vOptions As Object = Nothing)
        Sub MoveHere(ByVal vItem As Object, _
                     Optional ByVal vOptions As Object = Nothing)
        Sub CopyHere(ByVal vItem As Object, _
                     Optional ByVal vOptions As Object = Nothing)
        Function GetDetailsOf(ByVal vItem As Object, _
                              ByVal iColumn As Integer) As String

    End Interface

    <Guid("744129E0-CBE5-11CE-8350-444553540000")> _
    <ComImport()> _
    <TypeLibType(TypeLibTypeFlags.FOleAutomation)> _
    <InterfaceType(ComInterfaceType.InterfaceIsDual)> _
    Public Interface FolderItems
        'Inherits IEnumerable
        ReadOnly Property Count() As Integer
        ReadOnly Property Application() As IDispatch
        ReadOnly Property Parent() As IDispatch
        Function Item(ByVal index As Object) As FolderItem

        <DispId(-4)> _
        <TypeLibFunc(TypeLibFuncFlags.FRestricted Or TypeLibFuncFlags.FHidden)> _
        Function _NewEnum() As ComTypes.IEnumVARIANT

    End Interface

    <ComImport()> _
    <TypeLibType(TypeLibTypeFlags.FOleAutomation)> _
    <InterfaceType(ComInterfaceType.InterfaceIsDual)> _
    <Guid("FAC32C80-CBE4-11CE-8350-444553540000")> _
    Public Interface FolderItem
        ReadOnly Property Application() As IDispatch
        ReadOnly Property Parent() As IDispatch
        Property Name() As String
        ReadOnly Property Path() As String
        ReadOnly Property GetLink() As IDispatch
        ReadOnly Property GetFolder() As IDispatch
        ReadOnly Property IsLink() As Boolean
        ReadOnly Property IsFolder() As Boolean
        ReadOnly Property IsFileSystem() As Boolean
        ReadOnly Property IsBrowsable() As Boolean
        Property ModifyDate() As Date
        ReadOnly Property Size() As Integer
        ReadOnly Property Type() As String
        Function Verbs() As FolderItemVerbs
        Sub InvokeVerb(ByVal vVerb As Object)
    End Interface

    <ComImport()> _
    <TypeLibType(TypeLibTypeFlags.FOleAutomation)> _
    <InterfaceType(ComInterfaceType.InterfaceIsDual)> _
    <Guid("1F8352C0-50B0-11CF-960C-0080C7F4EE85")> _
    Public Interface FolderItemVerbs
        'Inherits IEnumerable
        ReadOnly Property Count() As Integer
        ReadOnly Property Application() As IDispatch
        ReadOnly Property Parent() As IDispatch
        Function Item(ByVal index As Object) As FolderItemVerb

        <DispId(-4)> _
        <TypeLibFunc(TypeLibFuncFlags.FRestricted Or TypeLibFuncFlags.FHidden)> _
        Function _NewEnum() As ComTypes.IEnumVARIANT
    End Interface

    <ComImport()> _
    <TypeLibType(TypeLibTypeFlags.FOleAutomation)> _
    <InterfaceType(ComInterfaceType.InterfaceIsDual)> _
    <Guid("08EC3E00-50B0-11CF-960C-0080C7F4EE85")> _
    Public Interface FolderItemVerb
        ReadOnly Property Application() As IDispatch
        ReadOnly Property Parent() As IDispatch
        ReadOnly Property Name() As String
        Sub DoIt()
    End Interface


End Namespace

' ##############################################################################
' ############################# Shell32ZipOnly.vb ##############################
' ##############################################################################
Imports System.Runtime.InteropServices

Public Class Shell32ZipOnly
    ' Hier eine radikal abgespeckte Version der Com-Interfaces, die ganz 
    '  speziell nur die zum Zippen notwendigen Teile der Schnittstellen-
    '  Definitionen von Shell32 implementiert. Einige Member sind als "DummiXY" 
    '  implementiert, und dienen nur als Platzhalter, damit die Member 
    '  "NameSpace()", "CopyHere()" und "Items()" in der VTable richtig 
    '  addressiert werden. Weitere Member wurden weggelassen.

    ''' <summary>
    ''' Hier als "DummiXX" implementierte Member sind nicht zur Verwendung 
    '''  vorgesehen.
    ''' </summary>
    <ComImport()> _
    <Guid("D8F015C0-C278-11CE-A49E-444553540000")> _
    <TypeLibType(TypeLibTypeFlags.FOleAutomation)> _
    <InterfaceType(ComInterfaceType.InterfaceIsDual)> _
    Public Interface IShellDispatch
        ReadOnly Property Dummi1() As Object
        ReadOnly Property Dummi2() As Object
        Function [Namespace](ByVal vDir As Object) As ShellFolder
    End Interface

    ''' <summary>
    ''' Hier als "DummiXX" implementierte Member sind nicht zur Verwendung 
    '''  vorgesehen.
    ''' </summary>
    <ComImport()> _
    <Guid("BBCBDE60-C3FF-11CE-8350-444553540000")> _
    <TypeLibType(TypeLibTypeFlags.FDispatchable Or TypeLibTypeFlags.FDual)> _
    <InterfaceType(ComInterfaceType.InterfaceIsIDispatch)> _
    Public Interface ShellFolder
        <DispId(1610743809)> _
        ReadOnly Property Dummi1() As Object
        <DispId(1610743810)> _
        ReadOnly Property Dummi2() As Object
        <DispId(1610743811)> _
        ReadOnly Property ParentFolder() As ShellFolder
        <DispId(0)> _
        ReadOnly Property Title() As String
        <DispId(1610743816)> _
        Sub CopyHere( _
            <System.Runtime.InteropServices.In()> _
            ByVal vItem As Object, _
            <System.Runtime.InteropServices.In()> _
            Optional ByVal vOptions As Object = Nothing)
        <DispId(1610743817)> _
        Function Dummi3(ByVal vItem As Object, _
                        ByVal iColumn As Integer) As String
        <DispId(1610743815)> _
        Sub MoveHere(ByVal vItem As Object, ByVal vOptions As Object)
        <DispId(1610743814)> _
        Sub Dummi4(ByVal bName As String, ByVal vOptions As Object)
        ' Ist nicht der korrekte Datentyp, aber für CopyHere() reichts
        <DispId(1610743812)> _
        Function Items() As Object
    End Interface

End Class

' ##############################################################################
' ############################## ShellZipper.vb ################################
' ##############################################################################
Imports System.IO
Imports System.Runtime.InteropServices
Imports System.Runtime.InteropServices.Marshal
'Imports nsShellZipper.Shell32
Imports nsShellZipper.Shell32ZipOnly

Public Class ShellZipper : Implements IDisposable

    Private _shell As Shell32.IShellDispatch

    Public Sub Zip(ByVal folderName As String, _
                   Optional ByVal zipFileName As String = Nothing)

        folderName = Path.GetFullPath(folderName)
        If zipFileName Is Nothing Then
            zipFileName = folderName & ".zip"
        Else
            zipFileName = Path.GetFullPath(zipFileName)
        End If
        If File.Exists(zipFileName) Then File.Delete(zipFileName)
        'leeres ZipFile erzeugen
        Dim emptyZipData = New Byte() {80, 75, 5, 6, 0, 0, 0, 0, 0, 0, 0, 0, _
                                       0, 0, 0, 0, 0, 0, 0, 0, 0, 0}
        Using fs = New FileStream(zipFileName, FileMode.CreateNew)
            fs.Write(emptyZipData, 0, emptyZipData.Length)
        End Using
        ShellCopy(folderName, zipFileName)
    End Sub

    Public Sub UnZip(ByVal zipFileName As String, _
                     Optional ByVal folderName As String = Nothing)
        zipFileName = Path.GetFullPath(zipFileName)
        If folderName Is Nothing Then
            Dim i = zipFileName.LastIndexOf("."c)
            folderName = zipFileName.Substring(0, i)
        Else
            folderName = Path.GetFullPath(folderName)
        End If
        If Directory.Exists(folderName) Then Directory.Delete(folderName, True)
        Directory.CreateDirectory(folderName)
        ShellCopy(zipFileName, folderName)
    End Sub

    Private Sub ShellCopy(ByVal source As String, ByVal destination As String)
        ' Für die Shell sind Zip-Dateien einfach Datei-Ordner. Zippen/UnZippen 
        '  ist also ein simpler Kopier-Vorgang von einen in den 
        '  anderen ShellFolder
        If _shell Is Nothing Then _shell = _
            DirectCast(CreateObject("Shell.Application"), IShellDispatch)
        Dim dst = _shell.Namespace(destination)
        Dim src = _shell.Namespace(source)
        Dim itms = src.Items
        dst.CopyHere(itms)
        ' COM-Objekte sind speziell aufzuräumen - beachte auch die Reihenfolge
        FinalReleaseComObject(itms)
        FinalReleaseComObject(src)
        FinalReleaseComObject(dst)
    End Sub


#Region "IDisposable"

    Protected Overridable Sub Dispose(ByVal disposing As Boolean)
        If _shell Is Nothing Then Return
        FinalReleaseComObject(_shell)
        _shell = Nothing
    End Sub

    Public Sub Dispose() Implements IDisposable.Dispose
        Dispose(True)
        GC.SuppressFinalize(Me)
    End Sub

#End Region 'IDisposable

End Class
Ihre Meinung

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.
SHFormatDrive (Laufwerk formatieren) - AAAAA 24.01.20 20:53 20 Antworten