VBE decoder

this script give you a decoded listing from an encoded file.
supports *,je, ,vbe, .asp, .hta, .htm, .html…
if used under cscript, puts the result to stdout.
the file can be multi-encoded (many scripts in the file, for ex. in an html file)
used under wscript, pops up the decoded file in a message box.

file name : decovbe.vbs
requirement : none
author : jean-luc antoine
submitted : 05/09/2001
updated : 09/12/2001
category : 4k

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
 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 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

原文： http://www.interclasse.com/scripts/decovbe.php