Die Community zu .NET und Classic VB.
Menü

VB 5/6-Tipp 0595: Daten in Wave-Datei verstecken

 von 

Beschreibung 

Steganografie ist die Kunst eigene Daten, zum Beispiel geheime Botschaften, in anderen Dateien so zu verstecken, dass sie diese nicht stören und auch wieder ausgelesen werden können. Man kann dies besondes gut in Bild- oder Ton-Dateien tun, indem man die Information im niederwertigsten Bit der Daten unterbringt. Im vorliegenden Beispiel wird diese Methode anhand einer Wav-Datei demonstriert. Nähere Informationen sind der im Download beiliegenden Datei "Info.txt" zu entnehmen.

Schwierigkeitsgrad:

Schwierigkeitsgrad 3

Verwendete API-Aufrufe:

sndPlaySoundA (sndPlaySound)

Download:

Download des Beispielprojektes [101,54 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 Stegano.vbp  -------------
' Die Komponente 'Microsoft Common Dialog Control 6.0 (SP3) (comdlg32.ocx)' wird benötigt.

'--------- Anfang Formular "frmMain" alias Main.frm ---------
' Steuerelement: Schaltfläche "cmdPlay"
' Steuerelement: Schaltfläche "cmdClear"
' Steuerelement: Schaltfläche "cmdInfo"
' Steuerelement: Rahmensteuerelement "fraStatus"
' Steuerelement: Bildfeld-Steuerelement "Picture1" auf fraStatus
' Steuerelement: Beschriftungsfeld "lblStatus" auf fraStatus
' Steuerelement: Standarddialog-Steuerelement "cdlg"
' Steuerelement: Schaltfläche "cmdRead"
' Steuerelement: Schaltfläche "cmdSave"
' Steuerelement: Schaltfläche "cmdPatch"
' Steuerelement: Schaltfläche "cmdOpen"
' Steuerelement: Textfeld "txtText"

' Autor: Johannes Faget (johannes.faget@accsys.de)

' Überarbeitet un kommentiert von
' K. Langbein, Klaus@ActiveVB.de 4.5.03

Option Explicit

Dim sourceInts() As Integer
Dim fileName As String
Private Const PATCHEDFLAG = "ActiveVB"
Dim maxTextLen As Long
Dim startData As Long

Private Declare Function sndPlaySound Lib "winmm.dll" _
        Alias "sndPlaySoundA" (ByVal lpszSoundName _
        As String, ByVal uFlags As Long) As Long

Private Sub cmdClear_Click()
    txtText.Text = ""
End Sub

Private Sub cmdInfo_Click()
    frmInfo.Show vbModal
End Sub

Private Sub cmdOpen_Click()

    Dim fnr As Integer
    Dim i As Long
    Dim l As Long
    Dim key As String * 4
    Dim k As Long
    
    'Datei wählen lassen
    On Error Resume Next
    
    cdlg.CancelError = True
    cdlg.Filter = "Audiodateien (*.wav)|*.wav"
    cdlg.fileName = App.Path & IIf(Right(App.Path, 1) = "\", "", "\") & "sound.wav"
    cdlg.ShowOpen
    
    If Err.Number <> cdlCancel Then
        lblStatus.Caption = "Datei wird ausgelesen..."
        fileName = cdlg.fileName
    
        ' Datei in Integer-Array einlesen. Da es sowohl 8-Bit als auch
        ' 16-Bit-Wavs gibt, lesen wir die Daten einfach generell in ein
        ' Integer-Array ein. Im Fall von 8-Bit-Wavs wird dann nur jedes 2.
        ' Byte verändert. Im Fall von 16-Bit-Wavs wird jedoch nicht das
        ' 9. Bit verändert, was der Fall wäre, wenn wir statt des Integer-
        ' ein Byte-Array verwenden würden.
        
        fnr = FreeFile
        Open fileName For Binary As #fnr
            l = LOF(fnr)
            
            k = l / 2
            If l And 1 = 1 Then
                k = k + 1
            End If
            
            ' Da der Dateiheader von Wavdateien unterschiedliche Längen haben
            ' kann, suchen wir zunächst nach dem Datenanfang. Die Daten beginnen
            ' vier Byte nach dem Schlüsselword "data".
            
            For i = 1 To 100 Step 2
                Get #fnr, i, key$
                If LCase(key$) = "data" Then
                    startData = Seek(fnr) + 4
                    Exit For
                End If
            Next i
            
            ' falls "data" nicht gefunden wurde, ist es keine Wav-Datei
            If startData = 0 Then
                MsgBox "Dies ist keine Wav-Datei!", vbCritical
                Close #fnr
                Exit Sub
            End If
            
            maxTextLen = (k - Len(PATCHEDFLAG) / 2 - startData) \ 8
            
            ReDim sourceInts(1 To k)
            Get #fnr, 1, sourceInts()
        Close #fnr
        
        txtText.MaxLength = maxTextLen
        cmdPatch.Enabled = True
        cmdSave.Enabled = True
        
        lblStatus.Caption = "Datei wurde erfolgreich ausgelesen." & _
            vbCrLf & vbCrLf & "(Es können theoretisch " & maxTextLen & _
            " Zeichen untergebracht werden.)" & vbCrLf & vbCrLf & _
            "Schreiben Sie nun Ihren Text in das Textfeld und klicken " & _
            "Sie die Schaltfläche 'patchen'"
    End If
End Sub

Private Sub cmdPatch_Click()

    Dim textLength As Long
    Dim patchText As String
    Dim textByte As Byte
    Dim textBits As String
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim offset As Long
    
    If txtText.Text = "" Then
        MsgBox "Bitte geben Sie erst den zu versteckenden Text ein."
        txtText.SetFocus
        Exit Sub
    End If

    lblStatus.Caption = "Text wird übernommen..."
        
    ' Text übernehmen. Vor den zu versteckenden Text schreiben wir noch
    ' ein Schlüsselwort um die modifizierten Dateien widerzuerkennen.
    patchText = PATCHEDFLAG + txtText.Text
    textLength = Len(patchText)
    setProgressPercent Picture1, 0, 0, textLength
    
    ' Die ersten 44-56 Bytes sind Header-Infos,
    ' wir schreiben erst ab startData
    
    ' Schreiben des Textes erfolgt nach folgendem Prinzip:
    ' Zunächst setzen wir das niederwertigste Byte mittels
    ' Or-Operator auf 1.
    ' sourceInts(k) = sourceInts(k) Or 1
    
    ' Da wir jetzt wissen, dass es gesetzt ist, können wir es per Xor
    ' wieder löschen. D.h. Bits werden durch eine Or-Verknüpfung mit
    ' anschließendem Xor gelöscht.
    ' sourceInts(k) = sourceInts(k) Xor 1
    
    ' Jetzt können wir also sicher sein, dass das LSB gelöscht ist und
    ' können es bei Bedarf setzen, um unsere Information unterzubringen.
    ' D.h. wenn das enstprechende Bit im unterzubringenden Zahl
    ' (hier textLength) vorhanden ist, setzen wir es, ansonsten nicht.
    ' If textLength And 2 ^ i Then
    '     sourceInts(k) = sourceInts(k) Or 1
    ' End If
    
    ' Zuerst schreiben wir die Länge des enthaltenen Textes, um später
    ' zu wissen, wieviele Byte gelesen werden müssen:
    '
    offset = startData
    For i = 0 To 15
        k = i + offset ' wir berechnen k vor, da wir den Index sonst
                       ' 6 mal berechen müssten
        
        ' Bit 1 setzen & löschen
        sourceInts(k) = sourceInts(k) Or 1
        sourceInts(k) = sourceInts(k) Xor 1
        
        If textLength And 2 ^ i Then
            sourceInts(k) = sourceInts(k) Or 1 ' Bit 1 setzen
        End If
    Next i
    
    'Jetzt der eigentliche Text ab der Position nach Header + 16
    offset = startData + 16
    For i = 0 To (textLength - 1) * 8 Step 8
        textByte = Asc(Mid$(patchText, (i / 8) + 1, 1))
        For j = 0 To 7
            k = i + j + offset
            
            sourceInts(k) = sourceInts(k) Or 1
            sourceInts(k) = sourceInts(k) Xor 1
            
            If textByte And 2 ^ j Then
                sourceInts(k) = sourceInts(k) Or 1
            End If
        Next j
        setProgressPercent Picture1, i, 0, (textLength - 1) * 8
    Next i

    textLength = textLength - Len(PATCHEDFLAG)
    lblStatus.Caption = "Text wurde erfolgreich übernommen." & vbCrLf & _
        "( " & textLength & " Zeichen)" & vbCrLf & vbCrLf & _
        "Klicken Sie 'Speichern', um die Änderungen in eine Kopie der Originaldatei zu schreiben."
        
End Sub

Private Sub cmdPlay_Click()
    
    On Error Resume Next
    
    
    If cmdPlay.Caption = "Spielen" Then
        cdlg.CancelError = True
        cdlg.Filter = "Audiodateien (*.wav)|*.wav"
        cdlg.ShowOpen
        If Err.Number <> cdlCancel Then
            cmdPlay.Caption = "Stopp"
            sndPlaySound cdlg.fileName, 1
        End If
    Else
        sndPlaySound vbNullString, 1
        cmdPlay.Caption = "Spielen"
    End If
     
End Sub

Private Sub cmdSave_Click()

    'gepatchtes Integer-Array in anderes File zurückschreiben
    Dim fnr As Integer
    
    'Datei wählen lassen
    On Error Resume Next ' Sollte man eigentlich vermeiden, aber hier
                         ' lassen wir's mal durchgehen.
    
    cdlg.CancelError = True
    cdlg.Filter = "Audiodateien (*.wav)|*.wav"
    cdlg.fileName = Left$(fileName, InStr(fileName, ".") - 1) & "_patched.wav"
    cdlg.ShowSave
    
    If Err.Number <> cdlCancel Then
        fileName = cdlg.fileName
        fnr = FreeFile
        
        lblStatus.Caption = "Datei wird gespeichert..."
        
        Open fileName For Binary As #fnr
            Put #fnr, , sourceInts()
        Close #fnr
        
        lblStatus.Caption = "Datei wurde erfolgreich gespeichert."
    End If
    
End Sub

Private Sub cmdRead_Click()

    Dim fnr As Integer
    Dim textLength As Long
    Dim textLengthBits As String
    Dim charBits As Long
    Dim myText As String
    Dim myPatchFlag As String
    Dim i As Long
    Dim j As Long
    Dim l As Long
    Dim k As Long
    Dim offset As Long
    Dim key As String * 4
    'Datei wählen lassen
    On Error Resume Next
    
    cdlg.CancelError = True
    cdlg.Filter = "Audiodateien (*.wav)|*.wav"
    cdlg.ShowOpen
    
    If Err.Number <> cdlCancel Then
        lblStatus.Caption = "Datei wird eingelesen..."
        fileName = cdlg.fileName
        
        'Datei in Integer-Array einlesen
        fnr = FreeFile
        Open fileName For Binary As #fnr
        
            l = LOF(fnr)
            k = l / 2    ' Anzahl der benötigten Integer berechnen
            If (l And 1) = 1 Then '
                k = k + 1 '  Falls die Dateilänge ungerade ist, fügen wir noch
            End If        ' eins hinzu
            
            ' Datenanfang suchen. Kommentar in cmdOpen_Click
            For i = 1 To 100 Step 2
                Get #fnr, i, key$
                If LCase(key$) = "data" Then
                    startData = Seek(fnr) + 4
                    Exit For
                End If
            Next i
            
            If startData = 0 Then
                MsgBox "Dies ist keine Wav-Datei!", vbCritical
                Close #fnr
                Exit Sub
            End If
            
            ReDim sourceInts(1 To k)
            Get #fnr, 1, sourceInts()
        Close #fnr
        
        'Ab der Position nach dem Header können wir die Länge
        'des enthaltenen Textes ermitteln
        textLength = 0
        offset = startData
        For i = 0 To 15
            If sourceInts(i + offset) And 1 Then
                textLength = textLength + 2 ^ i
            End If
        Next i
        
        'Und ab der Position danach den Text ermitteln
        lblStatus.Caption = "Enthaltene Informationen werden ermittelt..."
        offset = startData + 16
        For i = 0 To (Len(PATCHEDFLAG) - 1) * 8 Step 8
            
            charBits = 0
            For j = 0 To 7
                k = i + j + offset
                If sourceInts(k) And 1 Then
                    charBits = charBits + 2 ^ j
                End If
            Next j
            myText = myText & Chr(charBits)
        Next i
         
        If myText$ <> PATCHEDFLAG Then
            lblStatus.Caption = "Die Datei enthielt keine verwertbaren " & _
                "Textinformationen."
            Exit Sub
        End If
        
        'Und ab nach dem Flag den Text ermitteln
        myText = ""
        textLength = textLength - Len(PATCHEDFLAG)
        lblStatus.Caption = "Enthaltene Informationen werden ermittelt..."
        
        ' Berechnungen sollten nach möglichkeit außerhalb der Schleifen
        ' erfolgen. Daher berechnen wir den Offset hier:
        offset = startData + 16 + (Len(PATCHEDFLAG)) * 8
        For i = 0 To (textLength - 1) * 8 Step 8
            
            charBits = 0
            For j = 0 To 7
                k = i + j + offset
                If sourceInts(k) And 1 Then
                    charBits = charBits + 2 ^ j
                End If
            Next j
            myText = myText & Chr(charBits)
            setProgressPercent Picture1, i, 1, (textLength - 1) * 8
        Next i
     
        txtText.Text = myText
        lblStatus.Caption = "Es wurden: " & textLength & " Zeichen erfolgreich gelesen."
     End If
    
End Sub


Private Sub Form_Load()
    'Farben der Progressbar setzen
    presetProgressBar Picture1, RGB(156, 182, 173), vbWhite, RGB(106, 127, 148)
End Sub

Private Sub txtText_KeyPress(KeyAscii As Integer)
    'Eingabe auf max. erlaubte Zeichen beschränken
    If Len(txtText) > maxTextLen Then KeyAscii = 0
End Sub
'---------- Ende Formular "frmMain" alias Main.frm ----------
'-------- Anfang Modul "Progress" alias Progress.bas --------

Option Explicit

Private pBar_FillColor As Long  'Farbe des Fortschrittsbalkens
Private lastPrg As Integer      'letzter ganzzahliger Wert

Public Sub presetProgressBar(pBar As PictureBox, backClr As Long, _
    foreClr As Long, fillClr As Long)
    
    'Setzt die Farben Hintergrund, Vordergrund (Schriftfarbe) und Füllfarbe
    'der Picturebox
    With pBar
        .BackColor = backClr
        .ForeColor = foreClr
    End With
    pBar_FillColor = fillClr
End Sub

Public Sub setProgressPercent(pBar As PictureBox, ByVal Prg As Long, _
    Min As Long, Max As Long)
    'Verlaufsbalken der Picturebox zeichnen und
    'Prozentangabe aktualisieren, wird nur ausgeführt,
    'wenn sich der Wert (in ganzen Zahlen) auch verändert hat.
    
    Dim fX As Long
    
    If Prg < Min Or Prg > Max Or Max <= Min Then Exit Sub
    Prg = Int(100 / (Max - Min) * (Prg - Min))
    
    If Prg <> lastPrg Then
        
        With pBar
            .Cls
            If Prg > 0 Then
                fX = (.ScaleWidth - 2) / 100 * Prg
                pBar.Line (0, 0)-(fX + 1, .ScaleHeight - 1), pBar_FillColor, BF
                .CurrentX = .ScaleWidth / 2 - .TextWidth(Trim$(CStr(Prg) & " %")) / 2
                .CurrentY = .ScaleHeight / 2 - .TextHeight(Trim$(CStr(Prg) & " %")) / 2
                pBar.Print Trim$(CStr(Prg) & " %")
            End If
        End With
        DoEvents
        
        lastPrg = Prg
    End If
End Sub

'--------- Ende Modul "Progress" alias Progress.bas ---------
'--------- Anfang Formular "frmInfo" alias Info.frm ---------
' Steuerelement: Schaltfläche "cmdCopy"
' Steuerelement: Schaltfläche "cmdOk"
' Steuerelement: Textfeld "txtInfo"

Option Explicit

Private Sub cmdCopy_Click()
    Clipboard.Clear
    Clipboard.SetText txtInfo.Text
End Sub


Private Sub cmdOk_Click()
    Unload Me
End Sub

Private Sub Form_Load()
    Dim fnr As Integer
    Dim zeile As String
    
    If Dir(App.Path & "\info.txt") <> "" Then
        fnr = FreeFile
        Open App.Path & "\info.txt" For Input As #fnr
        
        Do Until EOF(fnr)
            Line Input #fnr, zeile
            txtInfo.Text = txtInfo.Text & vbCrLf & zeile
        Loop
        
        Close #fnr
    Else
        MsgBox "Infodatei konnte nicht geladen werden."
        Unload Me
    End If
End Sub
'---------- Ende Formular "frmInfo" alias Info.frm ----------
'-------------- Ende Projektdatei Stegano.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.

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 9 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.

Kommentar von AnthraX am 25.08.2004 um 21:54

Kann man das auch wieder rausholen (die Datei)?? Wenn ja, wie?

Greetz

Kommentar von Toni am 01.06.2004 um 17:58

Ich werde es ausprobieren. Hoffentlich funktioniert es mit WindowsMe

Kommentar von Nukeduke am 16.07.2003 um 22:44

Ich habe den Code jetzt noch nicht ausprobiert, aber was passiert denn, wenn der Text zu lang für die Wavedatei ist?
Wird vorher kontrolliert, ob genug Platz da ist?

Kommentar von Johannes Faget am 16.07.2003 um 11:14

@daydreamer

Hallo,

wenn du den Aufbau des MP3-formates kennst und ein paar Bytes findest, denen man die Manipulation nicht anmerkt, spricht nichts dagegen.
Das Bsp. hier war für mich nur eine Spielerei, ob es überhaupt irgendwie möglich ist.
Falls du dich selbst an MP3s versuchen möchtest, findest du weitergehende Infos unter http://123.koehntopp.de/marit/pub/steganographie/

Gruß

Kommentar von daydreamer am 10.07.2003 um 21:01

Genial!
Die Idee ist super!
Die Umsetzung ist noch besser!
Kann man das Eigentlich auch bei MP3's ??

daydreamer

Kommentar von Klaus Langbein am 10.07.2003 um 18:20

@Zacharias

Mit der Folge von OR und dann XOR kann man einzelne Bits aus einer Zahl entfernen. Hiermit entfernt man z.B. das niederwertigste Bit, also die 1:

[code]
Private Sub Command1_Click()

a = 13
a = a Or 1
a = a Xor 1
MsgBox a

End Sub
[/c]

Wenn man 13 AND 0 schreibt, kommt immer 0 raus.

Kommentar von Zacharias am 04.07.2003 um 12:48

Keine schlechte Idee! Läßt sich gut in bestimmten Programmen einsetzten!

Nur warum machste

sourceInts(k) = sourceInts(k) Or 1
sourceInts(k) = sourceInts(k) Xor 1

anstatt einfach
sourceInts(k) = sourceInts(k) And 0

Kommentar von Markus am 16.06.2003 um 21:34

Zustimmung !

sehr schoenes Stück Code

Kommentar von tBX am 01.06.2003 um 10:41

Kommentar: echt gute Idee!! weiter so