Script Optimizer

This script removes all unnecessary code in order to shorten the file.

option explicit
Dim fSource, fDest,x,fTemp,Flag
fDest=""
If Wscript.Arguments.Count<>1 Then
	WScript.Echo "You must supply a vbs file as parameter (drag and drop it!)"
Else
	fSource=WScript.Arguments(0)
	If ucase(right(fSource,4))<>".VBS" Then
		WScript.Echo "A VBS file and no other must be supplied !" & vbCrLF & fSource
	Else
		x=InstrRev(fSource,"\")
		fDest=Left(fSource,x) & "!" & Mid(fSource,x+1)
	End If
End If
If fDest="" Then WScript.Quit
fTemp=fSource & ".TMP"
Dim fso,fs,fd,Chaine,ScrAll,Consts(),NbConsts,strTemp
NbConsts=-1
ScrAll="" 'All the code without constant declarations
Set fso=CreateObject("Scripting.FileSystemObject")
Set fs=fso.OpenTextFile(fSource,1)
Set fd=fso.OpenTextFile(fTemp,2,True)
While Not fs.AtEndOfStream
	Chaine=fs.ReadLine

	Chaine=DelLeftSpace(Chaine)

	If Left(Chaine,1)="'" Then Chaine=""

	'Supress comments at the end of the line
	x=InstrRev(Chaine,"'")
	If x>0 Then
		If x>InstrRev(Chaine,"""") Then
			Chaine=Trim(Left(Chaine,x-1))
		End If
	End If

	Chaine=DelRightSpace(Chaine)

	If Chaine<>"" Then
		'Schrink the first space
		x=Instr(Chaine," ")
		Flag=Instr(Chaine,chr(9))
		If (Flag<x) And (Flag>0) Then x=Flag
		If x>0 Then
			Flag=Instr(Chaine,"""")
			If (x<Flag) Or (Flag=0) Then
				Chaine=DelRightSpace(Left(Chaine,x)) & " " & DelLeftSpace(Mid(Chaine,x))
			End If
		End If

		fd.WriteLine Chaine

		'Remember all constant declarations
		If UCase(Left(Chaine,"6"))="CONST " Then
			strTemp=LTrim(Mid(Chaine,7))
			x=Instr(strTemp,"=")
			If x>0 Then
				strTemp=RTrim(Left(strTemp,x-1))
				NbConsts=NbConsts+1
				Redim Preserve Consts(NbConsts)
				Consts(NbConsts)=UCase(strTemp)
			End If
		Else
			ScrAll=ScrAll & Chaine & vbCrLf
		End If
	End If

Wend
fd.Close
fs.close
Set fs=Nothing
Set fd=Nothing

'Constant analysis
'Forget all unused constants
ScrAll=UCase(ScrAll)
For x=NbConsts To 0 Step -1
	If Instr(ScrAll,Consts(x))=0 Then
		Consts(x)=Consts(NbConsts)
		NbConsts=NbConsts-1
	End If
Next

'Consts() has only used constants
Set fs=fso.OpenTextFile(fTemp,1)
Set fd=fso.OpenTextFile(fDest,2,True)
While Not fs.AtEndOfStream
	Chaine=fs.ReadLine
	If Ucase(Left(Chaine,6))="CONST " Then
		'Delete All Unused declarations
		Flag=False
		For x=0 to NbConsts
			If Instr(Ucase(Chaine),Consts(x))>0 Then Flag=True
		Next
		If Not Flag Then Chaine=""
	End If
	If Chaine<>"" Then fd.WriteLine Chaine
Wend
fd.Close
fs.close
Set fs=Nothing
Set fd=Nothing
fso.DeleteFile(fTemp)

msgbox "OK"
Set fso=Nothing

Function DelRightSpace(ByVal Chaine)
	'Delete space at the end of the line
	Chaine=Trim(Chaine)
	Do While Chaine<>""
		If Right(Chaine,1)=chr(9) Then
			Chaine=RTrim(Left(Chaine,Len(Chaine)-1))
		Else
			Exit Do
		End If
	Loop
	DelRightSpace=Chaine
End Function

Function DelLeftSpace(ByVal Chaine)
	'Delete Space at the beginning of the line
	Chaine=Trim(Chaine)
	Do While Chaine<>""
		If Left(Chaine,1)=chr(9) Then
			Chaine=LTrim(Mid(Chaine,2))
		Else
			Exit Do
		End If
	Loop
	DelLEftSpace=Chaine
End Function