VBE Decoder

Last version of the vbe decoder

Issues fixed, drag and drop and and more interactivity than original version

File Name : vbe_decoder.vbs
Requirement : none
Author : Rick Valstar
Submitted : 01/11/2006
Category : Other
' VBE_Decoder.vbs
'
' VBE/JSE to VBS/JS Decoder
'
' derived / translated / fixed from original by Jean-Luc Antoine at http://www.interclasse.com/scripts/decovbe.php
'
' ©2006 Rick Valstar. All Rights Reserved.  Same restrictions / permissions for this version as granted by the original author below.
' You can contact me on anything other than the Decode() function at r + last name + at + gmail + dot + com
'
' Key to the decoding process is the Decode() function which is copied "as-is" from the original.  Jean-Luc did all the hard work.
' All I did in this version is fix issues with the original ShellObject.BrowseForFolder logic and add drag-and-drop capability of an 
' encoded file onto this script should one be silly enough to allow default execution of VBS files.  I also added VBE/JSE to VBS/JS 
' file creation logic, simplified some of the looping, added a bunch of MsgBox's to identify if something may not have gone as 
' expected, and tried to clarify the beginning and ending tag detection in an encoded file.
'
' Note on ShellObject.BrowseForFolder:  In XP, it errors if you try to select a file.  Also, folders of type "Folder3" need to be
' resolved to type "Folder2" so that the .Path can be had and one can loop through the files in said folder.
'
' Original:
'
' ©2002 Jean-Luc Antoine. All Rights Reserved. 
' Per http://www.interclasse.com/scripts/decovbe.php:
' Scripts or any other material on this website may not be redistributed or put as part of ANY collection (script archives, CDs etc) 
' without prior written permission. Permission granted to use and modify any of the scripts found on InterClasse.com 

Option Explicit

Const BIF_NEWDIALOGSTYLE = &H40
Const BIF_NONEWFOLDERBUTTON = &H200
Const BIF_RETURNONLYFSDIRS = &H1

Const FOR_READING = 1
Const FOR_WRITING = 2
'Const FOR_APPENDING = 8

Const TAG_BEGIN1 = "#@~^" 
Const TAG_BEGIN2 = "==" 
Const TAG_BEGIN2_OFFSET = 10 
Const TAG_BEGIN_LEN = 12
Const TAG_END = "==^#~@" 
Const TAG_END_LEN = 6

Dim argv
Dim wsoShellApp
Dim oFolder
Dim sFolder
Dim sFileSource
Dim sFileDest
Dim fso
Dim fld
Dim fc
Dim bEncoded
Dim fSource
Dim tsSource
Dim tsDest
Dim iNumExamined
Dim iNumProcessed
Dim iNumSkipped

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

Sub Process (s)
	Dim bProcess
	Dim iTagBeginPos
	Dim iTagEndPos

	'MsgBox sFileSource & " " & sFileDest & " " & Len(s)

	iNumExamined = iNumExamined + 1

	iTagBeginPos = Instr(s, TAG_BEGIN1)

	Select Case iTagBeginPos
	Case 0
		MsgBox sFileSource & " does not appear to be encoded.  Missing Beginning Tag.  Skipping file."
		iNumSkipped = iNumSkipped + 1

	Case 1
		If (Instr(iTagBeginPos, s, TAG_BEGIN2) - iTagBeginPos) = TAG_BEGIN2_OFFSET Then
			iTagEndPos = Instr(iTagBeginPos, s, TAG_END)

			If iTagEndPos > 0 Then
				Select Case Mid(s, iTagEndPos + TAG_END_LEN)
				Case "", Chr(0)
					bProcess = True

					If fso.FileExists(sFileDest) Then
						If MsgBox("File """ & sFileDest & """ exists.  Overwrite?", vbYesNo + vbDefaultButton2) <> vbYes Then
							bProcess = False
							iNumSkipped = iNumSkipped + 1
						End If
					End If

					If bProcess Then
						s = Decode(Mid(s, iTagBeginPos + TAG_BEGIN_LEN, iTagEndPos - iTagBeginPos - TAG_BEGIN_LEN - TAG_END_LEN))

						'MsgBox s

						Set tsDest = fso.CreateTextFile(sFileDest, TRUE, FALSE)
						tsDest.Write s
						tsDest.Close
						Set tsDest = Nothing

						iNumProcessed = iNumProcessed + 1
					End If

				Case Else
					MsgBox sFileSource & " does not appear to be encoded.  Found " & Len(Mid(s, iTagEndPos + TAG_END_LEN)) & " characters AFTER Ending Tag.  Skipping file."
					iNumSkipped = iNumSkipped + 1
				End Select

			Else
				MsgBox sFileSource & " does not appear to be encoded.  Missing ending Tag.  Skipping file."
				iNumSkipped = iNumSkipped + 1
			End If

		Else
			MsgBox sFileSource & " does not appear to be encoded.  Incomplete Beginning Tag.  Skipping file."
			iNumSkipped = iNumSkipped + 1
		End If

	Case Else
		MsgBox sFileSource & " does not appear to be encoded.  Found " & (iTagBeginPos - 1) & "characters BEFORE Beginning Tag.  Skipping file."
		iNumSkipped = iNumSkipped + 1
	End Select
End Sub

Set argv = WScript.Arguments 

sFileSource = ""
sFolder = ""
iNumExamined = 0
iNumProcessed = 0
iNumSkipped = 0

Select Case argv.Count
Case 0
	Set wsoShellApp = WScript.CreateObject("Shell.Application")

	On Error Resume Next
	set oFolder = wsoShellApp.BrowseForFolder (0, "Select a folder containing files to decode", BIF_NEWDIALOGSTYLE + BIF_NONEWFOLDERBUTTON + BIF_RETURNONLYFSDIRS)
	If Err.Number = 0 Then 
		If TypeName(oFolder) = "Folder3" Then Set oFolder = oFolder.Items.Item
		sFolder = oFolder.Path
	End If
	On Error GoTo 0

	Set oFolder = Nothing
	Set wsoShellApp = Nothing

	If sFolder = "" Then
		MsgBox "Please pass a full file spec or select a folder containing encoded files"
		WScript.Quit 
	End If

Case 1
	sFileSource = argv(0)

	If InStr(sFileSource, "?") > 0 Then 
		MsgBox "Pass a full file spec or no arguments (browse for a folder)"
		WScript.Quit
	End If

Case Else
	MsgBox "Pass a full file spec, -?, /?, ?, or no arguments (browse for a folder)"
	WScript.Quit 
End Select

Set fso = WScript.CreateObject("Scripting.FileSystemObject")

If sFolder <> "" Then
	On Error Resume Next
	Set fld = fso.GetFolder(sFolder)
	If Err.Number <> 0 Then 
		Set fld = Nothing
		Set fso = Nothing
		MsgBox "Folder """ & sFolder & """ is not valid in this context"
		WScript.Quit 
	End If
	On Error GoTo 0

	Set fc = fld.Files

	For Each fSource In fc
		sFileSource = fSource.Path

		Select Case LCase(Right(sFileSource, 4))
		Case ".vbe"
			sFileDest = Left(sFileSource, Len(sFileSource) - 1) & "s"
			bEncoded = True
		Case ".jse"
			sFileDest = Left(sFileSource, Len(sFileSource) - 1)
			bEncoded = True
		Case Else
			bEncoded = False
		End Select

		If bEncoded Then
			Set tsSource = fSource.OpenAsTextStream(FOR_READING)
			Process tsSource.ReadAll
			tsSource.Close
			Set tsSource = Nothing
		End If
	Next ' fSource

	Set fc = Nothing
	Set fld = Nothing

Else
	If Not fso.FileExists(sFileSource) Then
		MsgBox "File """ & sFileSource & """ not found"
	Else
		bEncoded = False

		Select Case LCase(Right(sFileSource, 4))
		Case ".vbe"
			sFileDest = Left(sFileSource, Len(sFileSource) - 1) & "s"
			bEncoded = True
		Case ".jse"
			sFileDest = Left(sFileSource, Len(sFileSource) - 1)
			bEncoded = True
		Case Else
			MsgBox "File """ & sFileSource & """ needs to be of type VBE or JSE"
			bEncoded = False
		End Select

		If bEncoded Then
			Set tsSource = fso.OpenTextFile(sFileSource, FOR_READING)
			Process tsSource.ReadAll
			tsSource.Close
			Set tsSource = Nothing
		End If
	End If
End If

Set fso = Nothing

MsgBox iNumExamined & " Files Examined; " & iNumProcessed & " Files Processed; " & iNumSkipped & " Files Skipped"
Server Info
Remote Info
Compress

Batchs
BootSector
Droit
Accessoire GFA
On Now
Ecran plasma
Système d'exploitation
Son
Unités
Scripting
Multilingue
Site Web
Bruit et son
Architecture Google


4K
Color picker
TaskList
Backup files
Mini Port Scanner
Website To CHM
PixyDemo
Web password recovery
4KWebServer
Kill Popup
VBE decoder
Script Optimizer
Database Password Recovery
Class
Ini
EMail validator
Graphical Class
MP3 Info
Pinger Class
IP ranger class
SoftwareMetering
Path Validator
Time Stamper Class
LoggerCLS
HTA
Keyword Ranking
DOM Explorer
HTA-Notepad
PixyPortManager
Other
flashMessage
Kill Popup
VBE decoder (fixed)
Error Codes
Maze generator
Char counter
HTML To Word
ICQ Choose User
ScreenSaver Password decoder
Mp3Playlister - singleList
Long Filename To Short
Trace Math
Dump Hexa File
Self modifying script
Mp3Playlister - multiList
HTANoid
PixyWebServer
Python
Progress indication

©2002 Jean-Luc Antoine. All Rights Reserved. Scripts or any other material on this website may not be redistributed or put as part of ANY collection (script archives, CDs etc) without prior written permission. Permission granted to use and modify any of the scripts found on InterClasse.com