Die Community zu .NET und Classic VB.
Menü

VB 5/6-Tipp 0711: Alternative Datenströme in einer Datei erstellen und lesen

 von 

Beschreibung 

Bei den Dateisystem NTFS und HFS besteht die Möglichkeit, über sogenannte alternative Datenströme weitere Daten an die Datei anzuhängen, welche beim regulären Öffnen nicht angezeigt bzw. gelesen werden. Tipp 651 zeigt, wie man ermitteln kann, welche alternativen Datenströme für eine Datei existieren, dieser Tipp zeigt, wie einfach es ist, einen alternativen Datenstrom zu lesen bzw. zu schreiben, wenn der Name des alternativen Datenstroms bekannt ist.

Schwierigkeitsgrad:

Schwierigkeitsgrad 1

Verwendete API-Aufrufe:

GetVolumeInformationA (GetVolumeInformation)

Download:

Download des Beispielprojektes [3,74 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 Projekt1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Schaltfläche "Command5"
' Steuerelement: Rahmensteuerelement "Frame1"
' Steuerelement: Schaltfläche "Command3" auf Frame1
' Steuerelement: Textfeld "txtRead" auf Frame1
' Steuerelement: Schaltfläche "Command2" auf Frame1
' Steuerelement: Textfeld "txtAttach" auf Frame1
' Steuerelement: Beschriftungsfeld "Label2" auf Frame1
' Steuerelement: Beschriftungsfeld "Label1" auf Frame1
' Steuerelement: Schaltfläche "Command1"

Option Explicit

Private Const Filename  As String = "Probe.xyz"
Private Const Attach    As String = "attach.txt"

Private FileExisting    As Boolean


Private Property Get AppPathEx() As String
   AppPathEx = App.Path & IIf(Right$(App.Path, 1) = "\", "", "\")
End Property

Private Sub Command1_Click()
   Dim i As Integer
   
   i = FreeFile
   
   Open AppPathEx & Filename For Output As #i
      Print #i, "So! Hier steht sehr sinnvoller Text."
   Close #i

   FileExisting = True
   Frame1.Enabled = True
   Command1.Enabled = False
   Command5.Enabled = True
End Sub

Private Sub Command2_Click()
   Dim i As Integer
   
   i = FreeFile
   
   Open AppPathEx & Filename & ":" & Attach For Output As #i
      Print #i, txtAttach.Text
   Close #i
   
   txtAttach.Text = ""
   
   Call MsgBox("Anhang geschrieben", 64)
End Sub

Private Sub Command3_Click()
   On Error Goto NoFile
   Dim i As Integer, Buffer As String
   
   i = FreeFile
   
   Open AppPathEx & Filename & ":" & Attach For Input As #i
      Line Input #i, Buffer
   Close #i
   
   txtRead.Text = Buffer
   
   Exit Sub
NoFile:
   Call MsgBox("Es wurden keine Daten angehängt", vbCritical)
End Sub

Private Sub Command5_Click()
   Call Kill(AppPathEx & Filename)
   
   FileExisting = False
   Frame1.Enabled = False
   
   Command1.Enabled = True
   Command5.Enabled = False
End Sub

Private Sub Form_Load()
   ' Fehlerprüfung
   If Not IsValidFileSystem Then
      Call MsgBox("Das Dateisystem muss 'NTFS' oder 'HFS' sein", vbCritical, "Fehler")
      Call Unload(Me)
      
      Set Form1 = Nothing
   End If
   
   FileExisting = False
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'--- Anfang Modul "mdlFileSystem" alias mdlFileSystem.bas ---

Option Explicit

' Erforderliche API
Private Declare Function GetVolumeInformation Lib "Kernel32" Alias _
    "GetVolumeInformationA" (ByVal lpRootPathName As String, _
    ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, _
    lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, _
    lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, _
    ByVal nFileSystemNameSize As Long) As Long

' Ist das Dateisystem NTFS
Private Function IsNTFS(ByVal DriveName As String)
   IsNTFS = (GetFileSystemName(DriveName) = "NTFS")
End Function

' Ist das Dateisystem HFS
Private Function IsHFS(ByVal DriveName As String)
   IsHFS = (GetFileSystemName(DriveName) = "HFS")
End Function

' Ist unser Dateisystem für den weiteren Programmablauf in Ordnung?
' Falls DriveName nicht übergeben wurde, wird das aktuelle Laufwerk geprüft
Public Function IsValidFileSystem(Optional ByVal DriveName As String = vbNullString) As Boolean
   IsValidFileSystem = (IsHFS(DriveName) Or IsNTFS(DriveName))
End Function

' Dateisystemnamen auslesen
Private Function GetFileSystemName(ByVal DriveName As String) As String
   Dim Dummy  As String ' Dummy
   Dim FSName As String ' Buffer
   Dim RetVal As Long   ' Rückgabe

   ' Buffer füllen
   FSName = String$(255, Chr$(0))
   
   ' API aufrufen
   RetVal = GetVolumeInformation(DriveName, Dummy, 0&, 0&, 0&, 0&, FSName, 255)
   
   ' Hier gibts ein Problem
   If RetVal = 0 Then
      Call MsgBox("Ein Fehler ist beim Lesen des Dateisystems aufgetreten", _
        vbCritical, "Fehler")
      GetFileSystemName = vbNullString
      Exit Function
   End If

   ' Ausgabe trimmen
   FSName = Strings.Left$(FSName, Strings.InStr(1, FSName, Chr$(0)) - 1)

   GetFileSystemName = Strings.UCase(FSName)
End Function

'---- Ende Modul "mdlFileSystem" alias mdlFileSystem.bas ----
'-------------- Ende Projektdatei Projekt1.vbp --------------

Tipp-Kompatibilität:

Windows/VB-VersionWin32sWin95Win98WinMEWinNT4Win2000WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version:

Windows-Version:

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.