VB 5/6-Tipp 0595: Daten in Wave-Datei verstecken
von Johannes Faget
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: | 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 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-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.
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