1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
| Option Explicit
Dim dotNetVersion, ScriptFile, ScriptType, LaunchWith, EXEFile, icofile
Dim fso, WshShell, sysroot, ScriptSource, ScriptContent, workingdir, vbfile, vbsource
Dim vbcPath, vbcArgs, strCMDLine, debugger, objArgs
dotNetVersion = "v1.1.4322"
Set objArgs = WScript.Arguments
If objArgs.Count < 4 Then
MsgBox "Missing one or more arguments..." & vbCrLf & _
"Correct Usage: dotNetWrapper [Script File] [Script Type] [Script Engine] [Output File] [opt - Icon File]" & vbcrlf & vbcrlf & _
"Script File (ex: C:\Scripts\myscript.vbs)" & vbcrlf & _
"Script Type (ex: .vbs)" & vbcrlf & _
"Script Engine (ex: cscript.exe)" & vbcrlf & _
"Output File (ex: C:\Programs\myscript.exe)" & vbcrlf & _
"Icon File --optional (ex. C:\Icons\mypicture.ico)"
WScript.Quit
End If
ScriptFile = objArgs(0)
ScriptType = objArgs(1)
LaunchWith = objArgs(2)
EXEFile = objArgs(3)
If objArgs(4) <> "" Then
icofile = objArgs(4)
End If
Set fso = CreateObject ("Scripting.FileSystemObject")
Set WshShell = CreateObject("WScript.Shell")
Set sysroot = fso.GetSpecialFolder(0)
If Not(fso.FileExists("C:\" & sysroot.name & "\Microsoft.Net\Framework\" & dotNetVersion & "\vbc.exe")) Then
MsgBox "Unable to locate vbc.exe compiler. Confirm your version of .NET", 16, "ERROR"
WScript.Quit
End If
Set ScriptSource = fso.OpenTextFile(ScriptFile, 1)
ScriptContent = ""
Do While Not ScriptSource.AtEndOfStream
ScriptContent = ScriptContent & CHR(34) & Replace(EncodeScript(ScriptSource.readline), CHR(34), CHR(34) & " & CHR(34) & " & CHR(34)) & CHR(34) & " & vbcrlf & _" & vbcrlf
Loop
ScriptContent = ScriptContent & CHR(34) & CHR(34)
ScriptContent = "ScriptContent = " & CHR(34) & CHR(34) & " & _" & vbcrlf & ScriptContent
Set workingdir = fso.GetFile(ScriptFile)
vbfile = "Module Module1" & vbcrlf & _
"Sub Main()" & vbcrlf & _
"On Error Resume Next" & vbcrlf & _
"Dim sPath As String" & vbcrlf & _
"sPath = System.Environment.GetFolderPath(Environment.SpecialFolder.LocalApplicationData)" & vbcrlf & _
"Dim ScriptContent As String" & vbcrlf & _
ScriptContent & vbcrlf & _
"Dim oFile As System.IO.File" & vbcrlf & _
"Dim oWrite As System.IO.StreamWriter" & vbcrlf & _
"oWrite = oFile.CreateText(sPath & ""\compiledScript" & ScriptType & """)" & vbcrlf & _
"If Err.Number <> 0 Then" & vbcrlf & _
"MsgBox(""Unable to open Program. Please make sure you are running this locally."", MsgBoxStyle.Critical, ""Error"")" & vbcrlf & _
"Exit Sub" & vbcrlf & _
"End If" & vbcrlf & _
"oWrite.WriteLine(EncodeScript(ScriptContent))" & vbcrlf & _
"oWrite.Flush()" & vbcrlf & _
"oWrite.Close()" & vbcrlf & _
"System.Threading.Thread.Sleep(1000)" & vbcrlf & _
"Shell(""" & LaunchWith & " "" & Chr(34) & sPath & ""\compiledScript" & ScriptType & """ & Chr(34), AppWinStyle.NormalFocus, False)" & vbcrlf & _
"System.Threading.Thread.Sleep(1000)" & vbcrlf & _
"oFile.Delete(sPath & ""\compiledScript" & ScriptType & """)" & vbcrlf & _
"End Sub" & vbcrlf & _
"Function EncodeScript(ByVal stringinfo As String)" & vbcrlf & _
"Dim i As Int16" & vbcrlf & _
"Dim newstr As String" & vbcrlf & _
"Dim curchar As Int16" & vbcrlf & _
"For i = 1 to len(stringinfo)" & vbcrlf & _
"curchar = asc(mid(stringinfo,i,1))" & vbcrlf & _
"If (curchar >= 66 and curchar <= 122) or (curchar >=194 and curchar <= 250) then" & vbcrlf & _
"If curchar >= 66 and curchar <= 122 Then" & vbcrlf & _
"newstr = newstr & chr(curchar+128)" & vbcrlf & _
"else " & vbcrlf & _
"newstr = newstr & chr(curchar-128)" & vbcrlf & _
"End If" & vbcrlf & _
"Else" & vbcrlf & _
"newstr = newstr & chr(curchar)" & vbcrlf & _
"end if" & vbcrlf & _
"next" & vbcrlf & _
"EncodeScript = newstr" & vbcrlf & _
"End Function" & vbcrlf & _
"End Module" & vbcrlf
Set vbsource = fso.OpenTextFile(workingdir.ParentFolder & "\compiledscript.vb", 2, True)
vbsource.Write vbfile
Set vbsource = Nothing
vbcPath = "C:\" & sysroot.name & "\Microsoft.NET\Framework\" & dotNetVersion & "\vbc.exe"
vbcArgs = " /out:" & CHR(34) & exefile & CHR(34) & _
" /nowarn /nologo /quiet /debug- /optimize+ /optionstrict- /optionexplicit- " & _
"/imports:Microsoft.VisualBasic,System /t:winexe " & _
CHR(34) & workingdir.ParentFolder & "\compiledscript.vb" & CHR(34) & " > " & _
CHR(34) & workingdir.ParentFolder & "\debug.txt" & CHR(34)
If icofile <> "" Then
vbcargs = " /win32icon:" & CHR(34) & icofile.Value & CHR(34) & vbcArgs & CHR(34)
End If
strCMDLine = vbcPath & vbcArgs
debugger = WshShell.Run("cmd /c " & strCmdLine, 1, True)
If debugger <> 0 Then
WshShell.Run CHR(34) & workingdir.ParentFolder & "\debug.txt" & CHR(34), 1, True
Else
MsgBox ".EXE Created Successfully!", 64, "Complete"
End If
fso.DeleteFile workingdir.ParentFolder & "\debug.txt"
fso.DeleteFile workingdir.ParentFolder & "\compiledscript.vb"
Function EncodeScript(stringinfo)
Dim i, curchar, newstr
for i = 1 to len(stringinfo)
curchar = asc(mid(stringinfo,i,1))
If (curchar >= 66 and curchar <= 122) or (curchar >=194 and curchar <= 250) then
If curchar >= 66 and curchar <= 122 Then
newstr = newstr & chr(curchar+128)
else
newstr = newstr & chr(curchar-128)
End If
Else
newstr = newstr & chr(curchar)
End If
Next
EncodeScript = newstr
End Function |
DotNetWrapper.vbs pour convertir ".vbs" et ".hta" en ".exe"
Répondre avec citation
Partager