VBE,VBS: Как декодировать 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