VBScript to PureBasic program code generator
Posted: Thu Mar 26, 2015 4:30 pm
This program creates a complete PureBasic program from a VBScript source.
The created pb-program uses Thomas "ts-soft" Schultz' ScriptControl library in include-file format.
I will post the source of the ScriptControl include directly under this one.
You will probably have to tweak the created pb-program a bit:
- you may want to use an IncludePath
- the procedure that processes the script (DoTheScript) returns a string, you may want to change that
- the ScriptControl functions for passing the output of the VBScript to the pb-program are:
SCtr_EvalNum, SCtr_EvalStr, SCtr_EvalStr_UNICODE ; in the created program you will see an example
of using SCtr_EvalStr: "SCtr_EvalStr(strMsg)", which you may want to change
- etc. according to what you need
The created pb-program uses Thomas "ts-soft" Schultz' ScriptControl library in include-file format.
I will post the source of the ScriptControl include directly under this one.
You will probably have to tweak the created pb-program a bit:
- you may want to use an IncludePath
- the procedure that processes the script (DoTheScript) returns a string, you may want to change that
- the ScriptControl functions for passing the output of the VBScript to the pb-program are:
SCtr_EvalNum, SCtr_EvalStr, SCtr_EvalStr_UNICODE ; in the created program you will see an example
of using SCtr_EvalStr: "SCtr_EvalStr(strMsg)", which you may want to change
- etc. according to what you need
Code: Select all
;
; VBS to PB prog version 1.1
; Ferdinand Schinkel
; Date: March 2015
; PureBasic version: 5.31
;
Global RecNum
Procedure.s ProcessInputRecord(Record$)
If Len(LTrim(Record$))=0
ProcedureReturn ""
EndIf
For x=1 To Len(Record$) ; check for comment lines
If Mid(Record$,x,1)="'": ProcedureReturn "": EndIf ; get rid of comment line by jumping out with empty string
If Not(Mid(Record$,x,1)=" " Or Asc(Mid(Record$,x,1))=9): Break: EndIf ; take space and TAB into account
Next x
;
If FindString(Record$, "Wscript.Quit",1,#PB_String_NoCase): ProcedureReturn "": EndIf
Record$=ReplaceString(Record$, "Wscript.Echo", "MsgBox",#PB_String_NoCase)
Record$=ReplaceString(Record$, "Wscript.Arguments.Count", "Wscript_Arguments_Count",#PB_String_NoCase)
Record$=ReplaceString(Record$, "Wscript.Arguments.Named.Count", "Wscript_Arguments_Named_Count",#PB_String_NoCase)
Record$=ReplaceString(Record$, "Wscript.Arguments.UnNamed.Count", "Wscript_Arguments_UnNamed_Count",#PB_String_NoCase)
Record$=ReplaceString(Record$, "Wscript.CreateObject", "CreateObject",#PB_String_NoCase)
Record$=ReplaceString(Record$, "WScript.Shell", "Wscript.Shell",#PB_String_NoCase)
Record$=ReplaceString(Record$, "WScript.Network", "Wscript.Network",#PB_String_NoCase)
Record$=ReplaceString(Record$, "WScript", "WSCRIPT")
;
RecOut$=" code$ + " + Chr(34)
For i=1 To Len(record$)
If Mid(Record$,i,1)=Chr(34)
k=0
For j=i+1 To Len(Record$)
If Mid(Record$,j,1)=Chr(34)
k=j
Break
EndIf
Next j
If k=0
ProcedureReturn ";starting quote in line "+Str(RecNum)+" with no ending quote - line skipped"
EndIf
If i <> 1: RecOut$ + Chr(34) + "+": EndIf
RecOut$ + "Chr(34)+"+Chr(34)+Mid(Record$,i+1,k-i-1)+Chr(34)+"+Chr(34)"
If Not k=Len(Record$)
RecOut$ + "+" + Chr(34)
EndIf
i=k
Else
RecOut$ + Mid(Record$,i,1)
EndIf
Next i
;
; quote after the end of the line EXCEPT if the line ended with Chr(34)
If Len(RecOut$)>=7
If Mid(RecOut$,Len(RecOut$)-6,7)<>"Chr(34)"
RecOut$ + Chr(34)
EndIf
EndIf
;
RecOut$ + " + #CRLF$"
ProcedureReturn RecOut$
EndProcedure
StandardFile$ = GetCurrentDirectory()
Pattern$ = "VBS (*.vbs)|*.vbs|Text (*.txt)|*.txt|All files (*.*)|*.*"
Pattern = 0 ; use the first of the three possible patterns as standard
InputFile$ = OpenFileRequester("Choose the VBScript .vbs or text file to convert", StandardFile$, Pattern$, Pattern)
If InputFile$=""
MessageRequester("Information", "The requester was canceled", 0)
End
EndIf
If Not ReadFile(1, InputFile$) ; if the file could be read, we continue...
MessageRequester("Information","could not open the text file")
End
EndIf
;
InputFile$=GetFilePart(InputFile$)
FindPoint=FindString(InputFile$,".")
If FindPoint=0: FindPoint=Len(InputFile$)+1: EndIf
OutputFile$=GetCurrentDirectory()
OutputFile$+Mid(InputFile$,1,FindPoint-1)+".pb"
If Not CreateFile(2, OutputFile$)
MessageRequester("Information","could not create the output file!")
End
EndIf
WriteStringN(2, "")
WriteStringN(2, "; program created with VBS_to_PB_prog_converter")
WriteStringN(2, "")
WriteStringN(2, "IncludePath "+Chr(34)+"..\..\RESOURCES\IncludeFiles\"+Chr(34))
WriteStringN(2, "IncludeFile "+Chr(34)+"ScriptControl.pbi"+Chr(34))
WriteStringN(2, "")
WriteStringN(2, "Procedure.s DoTheScript()")
WriteStringN(2, " Protected code$")
WriteStringN(2, " Protected Wscript_Arguments_Count")
WriteStringN(2, " Protected Wscript_Arguments_Named_Count")
WriteStringN(2, " Protected Wscript_Arguments_UnNamed_Count")
WriteStringN(2, "")
WriteStringN(2, "; WScript: VBScript files sometimes make use of the WScript (script root) object, for example in:")
WriteStringN(2, "; WScript.Echo, WScript.Quit, WScript.Arguments.Count, etc.;")
WriteStringN(2, "; however, when running VBScript with the ScriptControl the WScript object is not present;")
WriteStringN(2, "; the program has made workarounds for some of the common WScript properties and methods,")
WriteStringN(2, "; but when you see WSCRIPT (capital letters) in a code$-line, it means there is no workaround")
WriteStringN(2, "; and you may have to manually create a workaround yourself")
WriteStringN(2, "")
RecNum=0
Repeat
If Not Eof(1)
FileRead$=ReadString(1)
RecNum+1
OutputRecord.s=ProcessInputRecord(FileRead$)
If OutputRecord<>""
WriteStringN(2, OutputRecord)
EndIf
EndIf
Until Eof(1)
WriteStringN(2,"")
WriteStringN(2," ScriptControl_Init()")
WriteStringN(2," SCtr_Reset()")
WriteStringN(2," SCtr_SetLanguage("+Chr(34)+"VBScript"+Chr(34)+")")
WriteStringN(2," SCtr_AddCode(code$)")
WriteStringN(2,";the following line is just an example of returning a VBScript value to PureBasic")
WriteStringN(2," ReturnValue.s=SCtr_EvalStr("+Chr(34)+"strMsg"+Chr(34)+")")
WriteStringN(2," ScriptControl_End()")
WriteStringN(2,"")
WriteStringN(2," ProcedureReturn ReturnValue")
WriteStringN(2,"EndProcedure")
WriteStringN(2,"")
WriteStringN(2,"Debug DoTheScript()")
WriteStringN(2,"")
WriteStringN(2,"End")
MessageRequester("VBS conversion finished", "PureBasic program created: "+OutputFile$)
CloseFile(1)
CloseFile(2)
End
