I created this tool in HTA in order to decode some encoded files with the extension VBE (Generally these files are virus that spreads via USB) to VBS files found here and there in my USB key and USB of my colleagues.
<html>
<head>
<title>Encode VBS2VBE & Decode VBE2VBS Files ? Hackoo ? 2012</title>
<HTA:APPLICATION
APPLICATIONNAME="Encode VBS2VBE & Decode VBE2VBS Files ? Hackoo ? 2012"
ID="Encode & Decode Files"
ICON="Explorer.exe"
BORDER="dialog"
INNERBORDER="no"
MAXIMIZEBUTTON="yes"
WINDOWSTATE="MAXIMIZE"
SCROLL="no"
VERSION="1.0"/>
<bgsound src="http://hackoo.alwaysdata.net/pirates.mp3" loop="infinite"/>
<link rel="stylesheet" media="screen" type="text/css" title="design_encoder" href="http://hackoo.alwaysdata.net/design_encoder.css"/>
<style>
Label
{
color : white;
font-family : "Courrier New";
}
input.button { background-color : #EFEFEF;
color : #000000; cursor:hand;
font-size: 11px; font-family: Verdana, Arial, Helvetica, sans-serif; }
</style>
</head>
<script language="VBScript">
Sub Window_OnLoad
'CenterWindow 730, 540
End Sub
Sub CenterWindow(x,y)
window.resizeTo x, y
iLeft = window.screen.availWidth/2 - x/2
itop = window.screen.availHeight/2 - y/2
window.moveTo ileft, itop
End Sub
Sub OnClickButtonCancel()
Window.Close
End Sub
Sub Decode_Textarea
Const FOR_READING = 1, FOR_WRITING = 2, BOOL_CREATION = True, BOOL_TRISTATETRUE = -1, BOOL_NO_CREATION = False
Set objFso = CreateObject("Scripting.FileSystemObject")
Set Ws = CreateObject("wscript.Shell")
code = txtBody.value
Set F = objFso.OpenTextFile("DecodeMe.vbs",2,True)
F.writeline "Msg=" & code & ""
F.WriteLine "Set objFso = CreateObject(""Scripting.FileSystemObject"")"
F.WriteLine "objFso.OpenTextFile(""DecodedFile.txt"",2,True).WriteLine Msg"
F.Close
If objFSO.FileExists("DecodeMe.vbs") Then
Ws.Run "DecodeMe.vbs",True
End If
Sleep 2000
If objFSO.FileExists("DecodedFile.txt") Then
Set Readme = objFso.OpenTextFile("DecodedFile.txt",1)
LireTout = Readme.ReadAll
txtBody.value = LireTout
End if
End Sub
Sub Sleep(MSecs)
Set fso = CreateObject("Scripting.FileSystemObject")
If Fso.FileExists("sleeper.vbs")=False Then
Set objOutputFile = fso.CreateTextFile("sleeper.vbs", True)
objOutputFile.Write "wscript.sleep WScript.Arguments(0)"
objOutputFile.Close
End If
CreateObject("WScript.Shell").Run "sleeper.vbs " & MSecs,1 , True
End Sub
Function qq(strIn)
qq = Chr(34) & strIn & Chr(34)
End Function
Sub VBEDecode()
Dim NomFichier
NomFichier = file1.value
If NomFichier<>"" Then
Dim fso
Set fso=CreateObject("Scripting.FileSystemObject")
If fso.FileExists(NomFichier) Then
Dim fic,contenu
Set fic = fso.OpenTextFile(NomFichier, 1)
Contenu=fic.readAll
fic.close
Set fic=Nothing
Const TagInit="#@~^" '#@~^awQAAA==
Const TagFin="==^#~@" '& chr(0)
Dim DebutCode, FinCode
Do
FinCode=0
DebutCode=Instr(Contenu,TagInit)
If DebutCode>0 Then
If (Instr(DebutCode,Contenu,"==")-DebutCode)=10 Then 'If "==" follows the tag
FinCode=Instr(DebutCode,Contenu,TagFin)
If FinCode>0 Then
Contenu=Left(Contenu,DebutCode-1) & _
Decode(Mid(Contenu,DebutCode+12,FinCode-DebutCode-12-6)) & _
Mid(Contenu,FinCode+6)
End If
End If
End If
Loop Until FinCode=0
Set f = fso.OpenTextFile(NomFichier &"_Decodee.txt",2,true)
f.writeLine contenu
If fso.FileExists(NomFichier &"_Decodee.txt") Then
Set fic = fso.OpenTextFile(NomFichier &"_Decodee.txt", 1)
Contenu=fic.ReadAll
txtBody.value = Contenu
fic.Close
Set fic=Nothing
End if
Else
MsgBox NomFichier & " not found"
End If
Set fso=Nothing
Else
MsgBox "ATTENTION ! ! ! ! ! !" & vbcr & "Le fichier n'existe pas ? " & vbcr &_
"Veuillez SVP choisir un fichier !",48,"Le Fichier n'existe pas ? "
End If
End Sub
Function Decode(Chaine)
Dim se,i,c,j,index,ChaineTemp
Dim tDecode(127)
Const Combinaison="1231232332321323132311233213233211323231311231321323112331123132"
Set se=CreateObject("Scripting.Encoder")
For i=9 to 127
tDecode(i)="JLA"
Next
For i=9 to 127
ChaineTemp=Mid(se.EncodeScriptFile(".vbs",string(3,i),0,""),13,3)
For j=1 to 3
c=Asc(Mid(ChaineTemp,j,1))
tDecode(c)=Left(tDecode(c),j-1) & chr(i) & Mid(tDecode(c),j+1)
Next
Next
'Next line we correct a bug, otherwise a ")" could be decoded to a ">"
tDecode(42)=Left(tDecode(42),1) & ")" & Right(tDecode(42),1)
Set se=Nothing
Chaine=Replace(Replace(Chaine,"@&",chr(10)),"@#",chr(13))
Chaine=Replace(Replace(Chaine,"@*",">"),"@!","<")
Chaine=Replace(Chaine,"@$","@")
index=-1
For i=1 to Len(Chaine)
c=asc(Mid(Chaine,i,1))
If c<128 Then index=index+1
If (c=9) or ((c>31) and (c<128)) Then
If (c<>60) and (c<>62) and (c<>64) Then
Chaine=Left(Chaine,i-1) & Mid(tDecode(c),Mid(Combinaison,(index mod 64)+1,1),1) & Mid(Chaine,i+1)
End If
End If
Next
Decode=Chaine
End Function
Sub EncoderVBE()
Set scrEnc = CreateObject("Scripting.Encoder")
Set scrFSO = CreateObject("Scripting.FileSystemObject")
MonFichier = file1.value
If MonFichier = "" Then
MsgBox "ATTENTION ! ! ! ! ! !" & vbcr & "Le fichier n'existe pas ? " & vbcr &_
"Veuillez SVP choisir un fichier !",48,"Le Fichier n'existe pas ? "
Exit Sub
End If
myfile = scrFSO.OpenTextFile(MonFichier).ReadAll
If scrFSO.FileExists(MonFichier&"_encode.vbe") Then scrFSO.DeleteFile MonFichier&"_encode.vbe", True
myFileEncode=scrENC.EncodeScriptFile(".vbs", myfile, 0, "")
Set ts = scrFSO.CreateTextFile(MonFichier&"_encode.vbe.txt", True, False)
ts.Write myFileEncode
ts.Close
Set fic = scrFSO.OpenTextFile(MonFichier&"_encode.vbe.txt", 1)
Contenu=fic.ReadAll
txtBody.value = Contenu
fic.Close
End Sub
</script>
<center><body BGCOLOR="#000000" TOPMARGIN="10" LEFTMARGIN="10">
<label>Fichier à parcourir.... </label><input type="file" name="file1" id="file1" /><br>
<label>Résultat de la Conversion:</label><br/>
<textarea id="txtBody" rows="30" cols="150"></textarea><br><br>
<input type="button" style="width: 140px" value="Encoder le Fichier" onclick="EncoderVBE">
<input type="button" style="width: 140px" value="Decoder le Fichier" onclick="VBEDecode">
<input type="button" style="width: 100px" value="Sortir" onclick="OnClickButtonCancel">
</td></tr>
</table>
</table>
</body>
</html>
