Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0149: Dateiattribut 'Komprimiert' setzen

VB 5/6-Tipp 0149: Dateiattribut 'Komprimiert' setzen

 von Mario Grimm

Schwierigkeitsgrad:

Verwendete API-Aufrufe: CloseHandle, CreateFileA (CreateFile), DeviceIoControl

Download: Download des Beispielprojektes [31,4 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!

'------------- Anfang Projektdatei PROJECT1.VBP -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Schaltfläche "Command2"
' Steuerelement: Schaltfläche "Command1"

Option Explicit

Private Type SECURITY_ATTRIBUTES
    nLength                 As Long
    lpSecurityDescriptor    As Long
    bInheritHandle          As Long
End Type

Private Type OVERLAPPED
    Internal                As Long
    InternalHigh            As Long
    offset                  As Long
    OffsetHigh              As Long
    hEvent                  As Long
End Type

Private Const GENERIC_READ = &H80000000

Private Const GENERIC_WRITE = &H40000000

Private Const OPEN_EXISTING = 3

Private Const INVALID_HANDLE_VALUE = -1

Private Const COMPRESSION_FORMAT_NONE = (&H0)
Private Const COMPRESSION_FORMAT_DEFAULT = (&H1)

Private Const FILE_DEVICE_FILE_SYSTEM = &H9
Private Const METHOD_BUFFERED = 0
Private Const FILE_READ_DATA = (&H1)
Private Const FILE_WRITE_DATA = (&H2)

Private Const FILE_ATTRIBUTE_COMPRESSED = &H800


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

Private Declare Function DeviceIoControl Lib "kernel32" _
    (ByVal hDevice As Long, ByVal dwIoControlCode As Long, _
    lpInBuffer As Any, ByVal nInBufferSize As Long, _
    lpOutBuffer As Any, ByVal nOutBufferSize As Long, _
    lpBytesReturned As Long, lpOverlapped As Any) As Long

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

Private Function CTL_CODE(lngDeviceType, lngFunction, _
    lngMethod, lngAccess) As Long
    
    CTL_CODE = ((lngDeviceType * (2 ^ 16)) Or _
                (lngAccess * (2 ^ 14)) Or _
                (lngFunction * (2 ^ 2)) Or _
                lngMethod)
End Function

Private Function SetCompressFile(ByVal strFile As String, ByVal blnNewValue As Boolean) As Boolean
    Dim FSCTL_SET_COMPRESSION   As Long
    Dim lngFileHandle           As Long
    Dim lngCompression          As Long
    Dim lngBytesReturned        As Long
    Dim tagSECURITY_ATTRIBUTES  As SECURITY_ATTRIBUTES
    Dim lngResult               As Long

    FSCTL_SET_COMPRESSION = CTL_CODE(FILE_DEVICE_FILE_SYSTEM, _
        16, METHOD_BUFFERED, FILE_READ_DATA Or FILE_WRITE_DATA)
        
    tagSECURITY_ATTRIBUTES.nLength = Len(tagSECURITY_ATTRIBUTES)
    
    'Dateihandle öffnen
    lngFileHandle = CreateFile(strFile, _
        GENERIC_READ Or GENERIC_WRITE, 0, _
        tagSECURITY_ATTRIBUTES, OPEN_EXISTING, 0, 0)
    
    'Bei Fehlschlag aussteigen
    If (lngFileHandle = INVALID_HANDLE_VALUE) Then
        SetCompressFile = False
        Exit Function
    End If
    
    'Kompressionflag berechnen
    If blnNewValue Then
        lngCompression = COMPRESSION_FORMAT_DEFAULT
    Else
        lngCompression = COMPRESSION_FORMAT_NONE
    End If
    
    'Flag setzen
    lngResult = DeviceIoControl(lngFileHandle, _
        FSCTL_SET_COMPRESSION, lngCompression, _
        Len(lngCompression), ByVal 0&, 0, _
        lngBytesReturned, ByVal 0&)
    
    'Prüfen, ob Flag gesetzt werden konnte
    If (lngResult = 0) Then
        CloseHandle (lngFileHandle)
        SetCompressFile = False
        Exit Function
    End If
    
    'Dateihandle wieder schließen
    Call CloseHandle(lngFileHandle)
    
    'Erfolg zurückgeben
    SetCompressFile = True
End Function

'Dateiattribut 'komprimiert' setzen
Private Sub Command1_Click()
    If SetCompressFile(App.Path & "\test.jpg", True) Then
        MsgBox "Das Attribut 'Komprimiert' wurde erfolgreich gesetzt!"
    End If
End Sub

'Dateiattribut 'komprimiert' entfernen
Private Sub Command2_Click()
    If SetCompressFile(App.Path & "\test.jpg", False) Then
        MsgBox "Das Attribut 'Komprimiert' wurde erfolgreich entfernt!"
    End If
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei PROJECT1.VBP --------------

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 1 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.