Как Декодировать Vbe?

DarkJoker

New member
28.09.2014
2
0
#1
Здравствуйте подскажите пожалуйста код для декодирования файла vbe нашол вот это
Код:
option explicit
Dim oArgs, NomFichier
'Optional argument : the encoded filename
NomFichier=""
Set oArgs = WScript.Arguments
Select Case oArgs.Count
Case 0 'No Arg, popup a dialog box to choose the file
NomFichier=BrowseForFolder("Choose an encoded file", &H4031, &H0011)
Case 1
If Instr(oArgs(0),"?")=0 Then '-? ou /? => aide
NomFichier=oArgs(0)
End If
Case Else
WScript.Echo "Too many parameters"
End Select
Set oArgs = Nothing

If NomFichier<>"" Then
Dim fso
Dim a
Set fso=WScript.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
'WScript.Echo NomFichier
set a = fso.CreateTextFile(NomFichier & ".txt",1)
a.WriteLine Contenu
a.Close
'WScript.Echo Contenu
Else
WScript.Echo Nomfichier & " not found"
End If
Set fso=Nothing
Else
WScript.Echo "Please give a filename"
WScript.Echo "Usage : " & wscript.fullname & " " & WScript.ScriptFullName & " <filename>"
End If

Function Decode(Chaine)
Dim se,i,c,j,index,ChaineTemp
Dim tDecode(127)
Const Combinaison="1231232332321323132311233213233211323231311231321323112331123132"

Set se=WSCript.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

Function BrowseForFolder(ByVal pstrPrompt, ByVal pintBrowseType, ByVal pintLocation)
Dim ShellObject, pstrTempFolder, x
Set ShellObject=WScript.CreateObject("Shell.Application")
On Error Resume Next
Set pstrTempFolder=ShellObject.BrowseForFolder(&H0,pstrPrompt,pintBrowseType,pintLocation)
BrowseForFolder=pstrTempFolder.ParentFolder.ParseName(pstrTempFolder.Title).Path
If Err.Number<>0 Then BrowseForFolder=""
Set pstrTempFolder=Nothing
Set ShellObject=Nothing
End Function
и вот это
Код:
Const TagInit = "#@~^"
Const TagFin = "==^#~@"
Set oArgs = WScript.Arguments
If oArgs.Count = 0 Then
DisplayHelp ""
WScript.Quit
End If
For Each Arg In oArgs
If InStr (Arg, "?") > 0 Then
DisplayHelp ""
WScript.Quit
End If
Next
Set oFSO = CreateObject ("Scripting.FileSystemObject")
Set oEncoder = CreateObject ("Scripting.Encoder")
For Each Arg In oArgs
If oFSO.FileExists(Arg) Then
sFileExt = oFSO.GetExtensionName(Arg)
ValidExts = Array ("vbs", "js", "jse", "vbe", "htm", "html", "asa", "asp", "cdx")
For Each Ext In ValidExts
If Ext = sFileExt Then
DisplayHelp Process(Arg)
Exit For
End If
Next
Else
DisplayHelp "Argument Is Not a valid file."
End If
Next
DisplayHelp "Process Is complete"
Set oEncoder = Nothing
Set oFSO = Nothing
Set oArgs = Nothing
Function Process(sFileIn)
sSourceExt = "." & oFSO.GetExtensionName(sFileIn)
sSourceFile = oFSO.GetBaseName(sFileIn)
Set fIn = oFSO.OpenTextFile(sFileIn)
sSource = fIn.ReadAll
fIn.Close : Set fIn = Nothing
If InStr (sSource, TagInit) = 0 Then
Decoded = True
End If
If Decoded = True Then
sOut = Encode(sSource, sSourceExt)
Select Case sSourceExt
Case ".vbs"
sOutExt = ".vbe"
Case ".js"
sOutExt = ".jse"
Case Else
sOutExt = sSourceExt
End Select
Process = "File "&sSourceFile&sSourceExt&" encoded And saved As "&sSourceFile&sOutExt&"."
Else
sOut = Decode(sSource, sSourceExt)
Select Case sSourceExt
Case ".vbe"
sOutExt = ".vbs"
Case ".jse"
sOutExt = ".js"
Case Else
sOutExt = sSourceExt
End Select
Process = "File "&sSourceFile&sSourceExt&" decoded And saved As "&sSourceFile&sOutExt&"."
End If
sFileOut = oFSO.GetParentFolderName(sFileIn) & "\" & _
sSourceFile & sOutExt
Set fOut = oFSO.OpenTextFile(sFileOut, 2, True )
fOut.Write sOut
fOut.close : Set fOut = Nothing
End Function
Function Encode(sSource, sSourceExt)
Encode = oEncoder.EncodeScriptFile(sSourceExt, sSource, 0, 0)
Set oEncoder = Nothing
End Function
Function Decode(sSource, sSourceExt)
Do
FinCode = 0
StartCode = InStr (sSource, TagInit)
If StartCode > 0 Then
If (InStr (StartCode, sSource, "==") - StartCode) = 10 Then
FinCode = InStr (StartCode, sSource, TagFin)
If FinCode > 0 Then
sSource = Left (sSource, StartCode - 1) & _
DecodeH(Mid (sSource, StartCode + 12, FinCode - StartCode - 12 - 6)) & _
Mid (sSource, FinCode + 6)
End If
End If
End If
Loop Until FinCode = 0
If Asc (Right (sSource, 1)) = 0 Then sSource = Left (sSource, Len (sSource) - 1)
sSource = Replace (sSource,".Encode","")
Decode = sSource
End Function
Function DecodeH(Chain)
Dim tDecode(127)
Const Combination = "1231232332321323132311233213233211323231311231321323112331123132"
For i = 9 To 127
tDecode(i) = "JLA"
Next
For i = 9 To 127
ChainsTemp = Mid (oEncoder.EncodeScriptFile(".vbs", String (3, i), 0, ""), 13, 3)
For j = 1 To 3
c = Asc (Mid (ChainsTemp, j, 1))
If Not ((c = 42) And (i = 62)) Then
tDecode(c) = Left (tDecode(c), j - 1) & Chr (i) & Mid (tDecode(c), j + 1)
End If
Next
Next
Chain = Replace (Replace (Chain, "@&", Chr (10)), "@#", Chr (13))
Chain = Replace (Replace (Chain,"@*",">"), "@!", "<")
Chain = Replace (Chain,"@$","@")
index = -1
For i = 1 To Len (Chain)
c = Asc (Mid (Chain, 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
Chain = Left (Chain,i - 1) & _
Mid (tDecode(c), Mid (Combination, (index Mod 64) + 1, 1), 1) & _
Mid (Chain,i + 1)
End If
End If
Next
DecodeH = Chain
End Function
Sub DisplayHelp(msg)
CRLF = Chr (13) + Chr (10)
If msg = "" Then msg = msg & " --- About this script ---" & CRLF & _
"Recognized file extensions: " & CRLF & _
" vbs vbe js jse htm html asa asp cdx" & CRLF & CRLF & _
"<file(s) To encode/decode>" & CRLF & _
"? <help>"
MsgBox msg, vbInformation , "ScriptDEcoder"
End Sub
мне как бы нужно что бы файл можно было указать за ранее.
Спасибо за внимание.

Копия темы открыта <div class="sp-wrap"><div class="sp-head-wrap"><div class="sp-head folded clickable">ТУТ</div></div><div class="sp-body"><div class="sp-content">http://forum.script-coding.com/viewtopic.php?pid=86804#p86804