Hola,
después de la gran acogida que tuvo la v1 (nótese el sarcasmo), os traigo la v2 con las siguientes mejoras:
- Arreglados varios fallos (regexes mejorados gracias overxfl0w y sanko)
- Elimina comentarios (excepto el de la última línea si lo hay)
- Reordena (aleatoriamente) los subs y funciones
- Reemplaza las strings por Chr's

Lo he probado con una versión de la SafeLoader y funciona correctamente (si se elimina el sub de mutex).
[Enlace externo eliminado para invitados]
[Enlace externo eliminado para invitados]

Call ItsMorphinTime
MsgBox "¡Hecho!"

'####################################'
'=> By Blau (2016) - Indetectables.NET
'=> Function: ItsMorphinTime
'=> 	Description: Randomize declarations (variables, subs and functions) and shuffle at runtime
Sub ItsMorphinTime()
	Dim objMatches
	Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
	Dim objME: Set objMe = objFSO.OpenTextfile(WScript.ScriptFullName, 1)
	Dim sScript: sScript = objMe.ReadAll
	Dim objRegExp: Set objRegExp = New RegExp: objRegExp.IgnoreCase = True: objRegExp.Global = True
	
	'=> Replace all subs & functions
	objRegExp.Pattern = "\s*(Sub|Function)\s+([a-zA-Z]+)\s*\("
	If objRegExp.Test(sScript) Then
		Set objMatches = objRegExp.Execute(sScript)
		For i = 0 To (objMatches.Count - 1): sScript = Replace(sScript, objMatches.Item(i).SubMatches(1), RandomString(25)): Next
	End If
	'=> Replace variables (starting with Dim)
	objRegExp.Pattern = "\s*(\bDim|\bConst)\s+([a-zA-Z0-9, ]+)"
	If objRegExp.Test(sScript) Then
		Set objMatches = objRegExp.Execute(sScript)
		Dim sVarSplit, objVarMatches
		For i = 0 To (objMatches.Count - 1)
			sVarSplit = Split(objMatches.Item(i).SubMatches(1), ",")
			If (UBound(sVarSplit) > 0) Then: For j = LBound(sVarSplit) To UBound(sVarSplit): objRegExp.Pattern = "(\W)(" & sVarSplit(j) & ")(\W)":	sScript = objRegExp.Replace(sScript, "$1" & RandomString(25) & "$3"): Next
			Else: objRegExp.Pattern = "(\W)(" & objMatches.Item(i).SubMatches(1) & ")(\W)": sScript = objRegExp.Replace(sScript, "$1" & RandomString(25) & "$3")
			End If
		Next		
	End If
	
	'=> Shuffle functions & subs
	objRegExp.Pattern = "(\s*(Sub|Function)\s+([\S\s]*?)End\s+(Sub|Function))"
	If objRegExp.Test(sScript) Then
		Set objMatches = objRegExp.Execute(sScript)
		Dim ArrSubs(): Redim ArrSubs(objMatches.Count)
		Dim sReplaced: sReplaced = RandomString(100)
		For i = 0 To (objMatches.Count - 1): ArrSubs(i) = objMatches.Item(i).SubMatches(0): sScript = Replace(sScript, ArrSubs(i), sReplaced): Next
		Dim ArrShuffled: ArrShuffled = JumbleArray(ArrSubs)
		For i = LBound(ArrShuffled) To UBound(ArrShuffled):	sScript = Replace(sScript, sReplaced, ArrShuffled(i), 1, 1): Next
	End If
	
	'=> Replace strings to Chr
	objRegExp.Pattern = "(\" & Chr(34) & ".+?\" & Chr(34) & ")"
	If objRegExp.Test(sScript) Then
		Set objMatches = objRegExp.Execute(sScript)
		For i = 0 To (objMatches.Count - 1)
			Dim sString: sString = objMatches.Item(i).SubMatches(0): If sString = vbNullString Then Continue
			Dim sChrString: sChrString = vbNullString
			For j = 2 To Len(sString)-1: sChrString = sChrString & "Chr(" & Asc(Mid(sString, j)) & ")": If Not j = Len(sString)-1 Then sChrString = sChrString & " & ": Next
			sScript = Replace(sScript, sString, sChrString)
		Next
	End If	
	'=> Remove comments (except last if any)
	objRegExp.Pattern = "([\'][\s\S]+?)([\n])": sScript = objRegExp.Replace(sScript, "$2")
		
	'=> Rewrite	
	Set objMe = objFSO.OpenTextfile(WScript.ScriptFullName, 2): objMe.Write sScript
End Sub

Function RandomString(nMax)
	Randomize:	For i = 1 To (Int(Rnd*nMax)+nMax): RandomString = RandomString & Chr(Int(26*Rnd+97)): Next
End Function

Function JumbleArray(ByVal aArray)
    Randomize: For i = LBound(aArray) To UBound(aArray) - 1: j = Int((UBound(aArray)- i) * Rnd + i): tmp = aArray(i): aArray(i) = aArray(j): aArray(j) = tmp: Next: JumbleArray = aArray
End Function
'####################################'