Feedback

VB - Ordner-Komprimierung

Veröffentlicht von am 14.06.2007
(0 Bewertungen)
Komprimiert einen ausgewählten Ordner, seine Unterordner und vorhandenen Dateien. (Visual Basic .NET 2003)
GFU-Schulungen  [Anzeige]

VB.NET Einführung

Die Schulung zeigt Ihnen, wie Sie einfache, benutzerorientierte Programme, die auf Datenbanken zugreifen, in VB.NET eigenständig entwickeln. 

JavaScript für .NET-Entwickler

Sie sind .NET-Entwickler und nun stehen Sie vor der Aufgabe, JavaScript in Ihre Arbeit einzubinden. Die Schulung vermittelt Ihnen die JavaScript Grundlagen und die Funktionen der Scriptsprache. Sie wissen, wie objektorientierte Programmierung in JavaScript funktioniert und lernen abschließend Best Practicies Fälle kennen.

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")	


Abgelegt unter Komprimierung, NTFS, komprimieren, zip.

Kommentare zum Snippet

 

Logge dich ein, um hier zu kommentieren!