VB - Ordner-Komprimierung

Imports System.IO
   .............

   Private Const COMPRESSION_FORMAT_NONE As Short = 0
   Private Const COMPRESSION_FORMAT_LZNT1 As Short = 2

   Private Const FSCTL_SET_COMPRESSION As Integer = 639040

   Private Const FILE_SHARE_NONE As Short = 0
   Private Const OPEN_EXISTING As Short = 3
   Private Const INVALID_HANDLE_VALUE As Short = -1
   Private Const GENERIC_READ As Integer = &H80000000
   Private Const GENERIC_WRITE As Integer = &H40000000
   Private Const FILE_FLAG_BACKUP_SEMANTICS As Integer = &H2000000

   Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" _
             (ByVal lpFileName As String, _
              ByVal dwDesiredAccess As Integer, _
              ByVal dwShareMode As Integer, _
              ByVal lpSecurityAttributes As IntPtr, _
              ByVal dwCreationDisposition As Integer, _
              ByVal dwFlagsAndAttributes As Integer, _
              ByVal hTemplateFile As IntPtr) As IntPtr

   Private Declare Function CloseHandle Lib "kernel32" _
             (ByVal hObject As IntPtr) As Boolean

   Private Declare Function DeviceIoControl Lib "kernel32" _
             (ByVal hDevice As IntPtr, _
              ByVal dwIoControlCode As Integer, _
              ByRef lpInBuffer As Short, _
              ByVal nInBufferSize As Short, _
              ByVal lpOutBuffer As Integer, _
              ByVal nOutBufferSize As Integer, _
              ByRef lpBytesReturned As Integer, _
              ByVal lpOverlapped As IntPtr) As Boolean

   Private Sub CompressFolder(ByVal fullpath As String)
      Dim Files() As FileInfo
      Dim Subfolders() As DirectoryInfo
      Dim CurrentFolder As DirectoryInfo

      SetCompressionState(fullpath)
      CurrentFolder = New DirectoryInfo(fullpath)

      Try
         Files = CurrentFolder.GetFiles()

         For Each CurrentFile As FileInfo In Files
            With CurrentFile
               If .Attributes And FileAttributes.ReadOnly Then
                  ' Schreibschutzattribut vorübergehend entfernen
                  .Attributes = .Attributes And Not FileAttributes.ReadOnly
                  .Refresh()

                  CompressFile(.FullName)

                  ' Schreibschutzattribut wieder setzen
                  .Attributes = .Attributes Or FileAttributes.ReadOnly
                  .Refresh()
               Else
                  CompressFile(.FullName)
               End If
            End With
         Next

      Catch
         '
      End Try

      Try
         Subfolders = CurrentFolder.GetDirectories()

         For Each Subfolder As DirectoryInfo In Subfolders
            fullpath = Subfolder.FullName & "\"
            CompressFolder(fullpath)
         Next

      Catch
         '
      End Try

   End Sub

   Private Sub SetCompressionState(ByVal folder As String)
      Dim Size As Short = 2
      Dim ReturnedBytes As Integer
      Dim Result As Boolean
      Dim Handle As IntPtr

      Handle = CreateFile(folder, _
                                    GENERIC_READ Or GENERIC_WRITE, _
                                    FILE_SHARE_NONE, _
                                    IntPtr.Zero, _
                                    OPEN_EXISTING, _
                                    FILE_FLAG_BACKUP_SEMANTICS, _
                                    IntPtr.Zero)

      If Handle.ToInt32 <> INVALID_HANDLE_VALUE Then
         Result = DeviceIoControl(Handle, _
                                              FSCTL_SET_COMPRESSION, _
                                              COMPRESSION_FORMAT_LZNT1, _
                                              Size, _
                                              0, _
                                              0, _
                                              ReturnedBytes, _
                                              IntPtr.Zero)

         CloseHandle(Handle)
      End If

   End Sub

   Private Sub CompressFile(ByVal file As String)
      Dim Size As Short = 2
      Dim ReturnedBytes As Integer
      Dim Result As Boolean
      Dim Stream As FileStream

      Try
         Stream = New FileStream(file, FileMode.Open, _
                                               FileAccess.ReadWrite, FileShare.None)

         Result = DeviceIoControl(Stream.Handle, _
                                               FSCTL_SET_COMPRESSION, _
                                               COMPRESSION_FORMAT_LZNT1, _
                                               Size, _
                                               0, _
                                               0, _
                                               ReturnedBytes, _
                                               IntPtr.Zero)
         Stream.Close()

      Catch
         If Not Stream Is Nothing Then
            Stream.Close()
         End If
      End Try

   End Sub
   
   -------------------------------------------------
   Beispiel :  CompressFolder("C:\Temp")