VB 5/6-Tipp 0711: Alternative Datenströme in einer Datei erstellen und lesen
von Dario
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: | Verwendete API-Aufrufe: | Download: |
'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-Version | Win32s | Win95 | Win98 | WinME | WinNT4 | Win2000 | WinXP |
VB4 | |||||||
VB5 | |||||||
VB6 |
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.