http://dieseyer.de • all rights reserved • © 2011 v11.4
<script language="VBScript" type="text/vbscript">
'*** v8.4 *** www.dieseyer.de *******************************
'
' Datei: nachrichtverstecken.hta
' Autor: mike-winxp@gmx.de
' Auf: www.dieseyer.de
'
'*********************************************************
Dim zzz : zzz=0
Do while zzz<100
on error resume next
window.resizeTo 0,0
window.moveTo -2000,-2000
zzz=zzz+1
Loop
on error goto 0
</script>
<head>
<title>Geheime Nachricht in Datei verstecken</title>
<style type="text/css"> </style>
<HTA:APPLICATION
ID="objTestHTA"
BORDER="thick"
BORDERSTYLE="normal"
CAPTION="yes"
MAXIMIZEBUTTON="no"
MINIMIZEBUTTON="yes"
SHOWINTASKBAR="yes"
SINGLEINSTANCE="yes"
SELECTION="no"
SCROLL="no"
SYSMENU="yes"
VERSION="1.1"
WINDOWSTATE="normal"
icon="%systemroot%\system32\migpwd.exe"
>
</head>
<script language="VBscript">
Dim WshShell : Set WSHShell = CreateObject("Wscript.Shell")
Dim MyFiles : Set MyFiles = CreateObject("Scripting.FileSystemObject")
Dim Pfad, gesb, f, BFile
'******************************************************
Sub Window_onLoad
'******************************************************
' window.resizeto Breite, Höhe
window.resizeto 700, 750
' window.moveto Links, Oben
Window.moveTo (Screen.Width-700)/2,(Screen.Height-750)/2
If instr(1,objTestHTA.commandLine,chr(32) & chr(32),1) > 1 Then
MeinArray = Split(objTestHTA.commandLine, chr(32) & chr(32), -1, 1)
Pfad = Replace(MeinArray(1), chr(34), "")
Else
Pfad = ""
End If
if Len(Pfad) > 60 Then
messenge = "... " & Right(Pfad,55)
Else
messenge = Pfad
End if
document.all.Aktueller_File.innerHTML = "Derzeit geöffnete/zu bearbeitende Datei: " & messenge
If Pfad = "" Then Exit Sub
If MyFiles.FileExists(Pfad) = False Then Datfeh = Msgbox ("Die Datei existiert nicht.") : self.close
Set f = MyFiles.GetFile(Pfad)
gesb = Left(Pfad ,Len(Pfad) - len(f.Name))
End Sub
'******************************************************
Sub Verschluesseln()
'******************************************************
lesen = Document.All.Textfeld.Value
If lesen = "" Then Msgbox "Du musst eine Nachricht eingeben, die du verschlüsseln möchtest" : Exit Sub
Code = Document.All.UserPwd.Value
If Code = "" Then Msgbox "Ein Passwort ist erforderlich" : Exit Sub
umftxt = len(lesen)
umfcode = Len(Code)
Do
For t = 1 To umfcode
counter=counter + 1
If counter > umftxt Then Exit Do
c = Asc(Mid(Code, t, 1))
z = Asc(Mid(lesen,counter, 1))
v = c + z + 95 + umfcode + t
w = w & cstr(v)
Next
Loop
If Pfad = "" Then
Document.All.Textfeld.Value = w
Else
Set objDialog = CreateObject("SAFRCFileDlg.FileSave")
objDialog.FileName = "*." & Right(Pfad,len(Pfad) - Instrrev(Pfad, ".",-1,1))
objDialog.FileType = "Alle Dateien"
intReturn = objDialog.OpenFileSaveDlg
If intReturn Then
Set schreiben = MyFiles.CreateTextFile(objDialog.FileName & ".temp")
schreiben.Write "*****######*****" & w
schreiben.close
w = ""
Else
Exit Sub
End If
Return = WshShell.Run("cmd /c copy /B " & chr(34) & Pfad & chr(34) & " + " & chr(34) & objDialog.FileName & ".temp" & chr(34) & " " & chr(34) & objDialog.FileName & chr(34), 0, True)
MyFiles.DeleteFile(objDialog.FileName & ".temp")
Document.All.Textfeld.Value = w
End If
document.all.Aktueller_File.innerHTML = "Derzeit geöffnete/zu bearbeitende Datei: " : Pfad = ""
End Sub
'******************************************************
Sub Entschluesseln()
'******************************************************
On Error Resume next
Code = Document.All.UserPwd.Value
If Code = "" Then Msgbox "Ein Passwort ist erforderlich" : Exit Sub
umfcode = Len(Code)
If Pfad = "" Then
lesen = Document.All.Textfeld.Value
if lesen = "" Then If lesen = "" Then Msgbox "Du musst eine Nachricht eingeben oder importieren, die du entschlüsseln möchtest" : Exit Sub
Else
Set file = MyFiles.OpenTextFile(Pfad,1,True)
var = file.readall
file.Close
If Instrrev(var, "*****######*****",-1,1) < 1 Then
Msgbox "Datei enthält keine Nachricht. Möglicherweiße ist die Datei beschädigt."
Exit Sub
End If
lesen = Mid(var, Instrrev(var, "*****######*****",-1,1) + 16,len(var))
End if
umftxt = len(lesen)
counter = 1
Do
For t = 1 To umfcode
c = Asc(Mid(Code, t, 1))
z = Mid(lesen, counter, 3)
v = eval(z) - c - 95 - umfcode - t
w = w & chr(v)
counter=counter + 3
If counter > umftxt Then Exit Do
Next
Loop
Document.All.Textfeld.Value = w
document.all.Aktueller_File.innerHTML = "Derzeit geöffnete/zu bearbeitende Datei: " : Pfad = ""
End sub
'******************************************************
Sub Text_speichern()
'******************************************************
Set objDialog = CreateObject("SAFRCFileDlg.FileSave")
objDialog.FileName = "Document1.txt"
objDialog.FileType = "Text Document"
intReturn = objDialog.OpenFileSaveDlg
If intReturn Then
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.CreateTextFile(objDialog.FileName)
objFile.WriteLine Document.All.Textfeld.Value
objFile.Close
Else
Exit Sub
End If
End Sub
'******************************************************
Sub Text_importieren()
'******************************************************
call BFF() : Datei = BFile
If Datei = "" then exit sub
if MyFiles.FileExists(Datei) = FALSE then Datfeh = Msgbox ("Die Datei existiert nicht.") : Exit Sub
Set txt = MyFiles.OpenTextFile(Datei, 1)
Document.All.Textfeld.Value = txt.readall
txt.close
End Sub
'******************************************************
Function BFF()
'******************************************************
Dim Dialog : Set Dialog = CreateObject("UserAccounts.CommonDialog")
' Dialog.Filter = "Text Files|*.txt|All Files|*.*" ' zeigt nur *.txt
' Dialog.Filter = "Excel-Arbeitsmappen|*.xls|Alle Dateien|*.*" ' zeigt nur *.xls
Dialog.Filter = "Alle Dateien|*.*" ' zeigt nur *.* - also ALLES
' Dialog.Filter = "Textdateien|*.txt|Excel-Arbeitsmappen|*.xls|Alle Dateien|*.*"
Dialog.FilterIndex = 2 ' von den drei auswählbaren Filtern wird der 2. eingesetzt
Dialog.ShowOpen
BFile = Dialog.FileName
End Function
'******************************************************
Sub Datei_waelen()
'******************************************************
call BFF() : Pfad = BFile
if Pfad = "" Then document.all.Aktueller_File.innerHTML = "Derzeit geöffnete/zu bearbeitende Datei: " : exit Sub
Set f = MyFiles.GetFile(Pfad)
gesb = Left(Pfad ,Len(Pfad) - len(f.Name))
if Len(Pfad) > 60 Then
messenge = "... " & Right(Pfad,55)
Else
messenge = Pfad
End if
document.all.Aktueller_File.innerHTML = "Derzeit geöffnete/zu bearbeitende Datei: <font color='#FF0000'>" & messenge & "</font>"
End Sub
'******************************************************
Sub Hilfe()
'******************************************************
BtnCode = WshShell.Popup( chr(169) &" mike-winxp@gmx.de" & vbcr &_
"Version 1.1" & vbcr &vbcr &_
"Zweck und Funktion des Programms:" & vbcr &_
"Nachrichten/Textdateien in anderen Dateien zu verstecken. Hierbei wird die Nachricht zunächst mit" & vbcr &_
"einem beliebigen Passwort verschlüsselt (einfacher Algorithmus für niedrige Sicherheitsansprüche)" & vbcr &_
"und anschließend an eine Datei gehängt. Die Tarnung ist perfekt." & vbcr &_
"Wenn dann noch der Name der Datei mit Nachricht geändert wird, ist es für einen Außenstehenden" & vbcr &_
"fast unmöglich festzustellen 1. in welcher Datei sich eine Nachricht befindet, 2. Was in der Nachricht steht." & vbcr &_
"Gehen Sie hierzu auf 'Datei öffnen' um eine Datei auszuwählen, in der die Nachricht versteckt werden soll." & vbcr &_
"Anschließend geben Sie eine Nachricht in das Textfeld ein, oder importieren einen bereits fertigen Text." & vbcr &_
"Nach der Eingabe eines Passworts (je länger dieses ist desto besser ist die Verschlüsselung) erstellen" & vbcr &_
"Sie durch einen klick auf 'Nachricht verschlüsseln' eine neue Datei, die aussieht wie die Originaldatei," & vbcr &_
"jedoch die von Ihnen eingegebene Botschaft (in verschlüsselter Form) enthält." & vbcr & vbcr &_
"Des weiteren können Sie Nachrichten verschlüsseln, ohne sie anschließend in eine andere Datei " & vbcr &_
"zu packen. Dies macht vor allem bei vertraulichen Emailnachrichten Sinn." & vbcr &_
"Geben Sie hierzu eine Nachricht in das Textfeld ein, oder importieren einen bereits fertigen Text. " & vbcr &_
"Geben Sie ein beliebiges Passwort ein und klicken Sie anschließend auf 'Nachricht verschlüsseln'." & vbcr & vbcr &_
"Um aus einer Datei eine verschlüsselte Botschaft auszulesen, gehen Sie auf 'Datei öffnen' und " & vbcr &_
"wählen die Datei aus, die die Nachricht enthält." & vbcr &_
"Nun geben sie das Passwort ein klicken auf 'Nachricht entschlüsseln'" & vbcr & vbcr &_
"Um eine Nachricht aus einem Textdokument zu entschlüsseln. Klicken sie auf 'Text importieren'." & vbcr &_
"Dann geben sie das Passwort ein und klicken 'Nachricht entschlüsseln'" & vbcr & vbcr &_
"Rechtliches:" & vbcr &_
"Mit der Benutzung dieses Programms erklären Sie sich einverstanden, dass der Autor nicht die fehlerfreie "& vbcr &_
"Funktion dieses Programms garantiert und keine Haftung für Schäden aller Art übernimmt, die durch dieses " & vbcr &_
"Programm an Hardware und Software des Benutzers entstanden sind.",1000,"Hilfe",0)
End sub
</script>
<body bgcolor="#FF9900">
<div id=Aktueller_File style="width: 664; height: 19" title="Diese Datei ist gerade geöffet. Sie können eine Nachricht in dieser Datei verstecken, oder eine versteckte Nachricht entschlüsseln."> </div>
<p> <font size="2"><input type="button" value="Datei öffnen" name="B8" onclick="Datei_waelen()" title="Wählen sie eine Datei, in der sie eine Nachricht verstecken wollen/oder in der eine Nachricht versteckt ist." style="color: #460000; background-color: #FCF5C7; border-style: ridge; border-color: #CC3300">
Öffnen Sie eine Datei, um eine verschlüsselte Nachricht darin zu
verstecken </font>
</p>
<p><font size="2">----------------------------------------------------------------------------------------------------------------------------------------------------------------------</font>
</p>
<p><font size="3">Passwort:</font> <input Type="Password" Name="UserPwd" Value="" size="35" title="Geben sie hier das Passwort ein, mit dem Sie die Nachricht verschlüsseln wollen, oder mit dem die Datei verschlüsselt ist." style="background-color: #FCF5C7; border-style: inset; border-color: #CC3300" >
<font size="2"> <input type="button" value="Text importieren" name="B7" onclick="Text_importieren()" title="Wenn sie eine Nachricht als .txt Datei gespeichert haben, können Sie diese importieren." style="background-color: #FCF5C7; border-style: ridge; border-color: #6F1C00">
</font>
</p>
<p><font size="2" face="Arial" title="Tragen Sie hier die Nachricht ein, die Sie verschlüsseln wollen. Sie haben auch die Möglichkeit einen Text zu importieren. Falls ein entschlüsselter Text nur teilweise oder gar nicht leserlich ist, haben Sie ein falsches Passwort verwendet." ><u>Nachricht:</u></font>
</p>
<p><textarea rows="25" id="Textfeld" name="Textfeld" cols="108" style="font-family: Arial; position: relative; background-color: #FCF5C7; border-style: inset; border-color: #CC3300"></textarea>
</p>
<p><input type="button" value="Nachricht entschlüsseln" name="B5" onclick="Entschluesseln()" title="Wenn sie eine Datei geöffnet haben, wird versucht aus dieser eine Nachricht zu entschlüsseln. Wenn Sie keine Datei geöffnet haben, wird die Nachricht, die Sie ins Nachrichtenfeld eingetragen haben, entschlüsselt." style="background-color: #FCF5C7; border-style: ridge; border-color: #6F1C00" >
<input type="button" value="Nachricht verschlüsseln" name="B3" onclick="Verschluesseln" title="Wenn sie eine Datei geöffnet haben, wird ihre Nachricht verschlüsselt in einer Kopie dieser Datei gespeichert. Wenn Sie keine Datei geöffnet haben, wird die Nachricht, die Sie ins Nachrichtenfeld eingetragen haben, nur verschlüsselt." style="background-color: #FCF5C7; border-style: ridge; border-color: #6F1C00" >
<input type="button" value="Nachricht speichern" name="B5" onclick="Text_speichern()" title="Speichert den aktuellen Text." style="background-color: #FCF5C7; border-style: ridge; border-color: #6F1C00">
</p>
<p><input type="button" value="Hilfe" name="B3" onclick="Hilfe()" style="background-color: #FCF5C7; border-style: ridge; border-color: #6F1C00"></p>
</body>
http://dieseyer.de • all rights reserved • © 2011 v11.4