292 lines
8.7 KiB
Plaintext
292 lines
8.7 KiB
Plaintext
'Function to load VBS modules
|
|
Public Function LoadVBSModule(VBSModuleParams)
|
|
|
|
'SYNOPSIS
|
|
'Function will load external - additional - VBS Modules (VBME, VBM or VBS File(s)) into current Script.
|
|
|
|
'DESCRIPTION
|
|
'By working With Modules, this Function Is necessary To load external Modul Functions into the current VB-Script.
|
|
'Call parameter must be an array, because VB-Script functions cannot handle optional Parameters.
|
|
'In develepment and Test Enviroment it is possible, to work with distributed Folders with different Modules. Therefor the Parameter
|
|
'"VBSModuleParams(1)" (which is the ModuleOverrideSourcePath) and the preset Variable "ModuleDefaultSourcePath" are made for.
|
|
'After a successful Import of a Module, Function will Return True, otherwise a False.
|
|
|
|
'REQUIREMENT General
|
|
'VBS must be enabled
|
|
|
|
'REQUIREMENT Assembly
|
|
'<NONE>
|
|
|
|
'REQUIREMENT Variables
|
|
'FSOModule, Module, ModuleName, ModuleCode, ModulePath, WshShell, ModuleAutoSourcePath
|
|
|
|
'REQUIREMENT Variables preSet
|
|
'ModuleDefaultSourcePath (optional)
|
|
|
|
'REQUIREMENT Functions
|
|
'<NONE>
|
|
|
|
'VERSION
|
|
'Number: 1.6.0.0 / Date: 06.07.2023
|
|
|
|
'PARAMETER VBSModuleParams(0) = ModuleName
|
|
'Give the Module Name, you want to load into the current VB-Script.
|
|
|
|
'PARAMETER VBSModuleParams(1) = ModuleOverrideSourcePath
|
|
'Optional Parameter. By giving the ModuleOverrideSourcePath, Function will not check other Paths for the Function you want to load.
|
|
|
|
'EXAMPLE
|
|
'Dim VBSModuleParams
|
|
'Redim VBSModuleParams(0)
|
|
'VBSModuleParams(0) = Module
|
|
'LoadVBSModule(VBSModuleParams)
|
|
|
|
'EXAMPLE
|
|
'Dim VBSModuleParams
|
|
'Redim VBSModuleParams(1)
|
|
'VBSModuleParams(0) = Module
|
|
'VBSModuleParams(1) = "D:\ScriptFiles\Modules"
|
|
'LoadVBSModule(VBSModuleParams)
|
|
|
|
On Error Resume Next
|
|
|
|
'Clear Error Variable
|
|
Err.Clear
|
|
|
|
Dim FSOModule, Module, ModuleName, ModuleCode, ModulePath, WshShell, ModuleAutoSourcePath
|
|
Set FSOModule = CreateObject("Scripting.FileSystemObject")
|
|
|
|
'How many parameters are given in the array
|
|
If (UBound(VBSModuleParams) = 0) Then
|
|
|
|
ModuleName = VBSModuleParams(0)
|
|
|
|
If FSOModule.FolderExists(ModuleDefaultSourcePath) Then
|
|
|
|
'If global var is set, take it!
|
|
ModulePath = ModuleDefaultSourcePath
|
|
|
|
ELSE
|
|
|
|
'Getting the current dir, when ModuleDefaultSourcePath does not exist
|
|
Set WshShell = CreateObject("WScript.Shell")
|
|
ModuleAutoSourcePath = WshShell.CurrentDirectory
|
|
|
|
'By this parameter way the path is more variable
|
|
ModulePath = ModuleAutoSourcePath & "\" & "Modules"
|
|
|
|
If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then
|
|
MSGBOX "Parameter1 = " & VBSModuleParams(0) & vbCrlf & _
|
|
"ModuleDefaultSourcePath = " & ModuleDefaultSourcePath,,"DEBUG Info: Parameter Values in Array - VBSModuleParams"
|
|
End If
|
|
|
|
End if
|
|
|
|
ElseIf (UBound(VBSModuleParams) = 1) Then
|
|
|
|
ModuleName = VBSModuleParams(0)
|
|
ModulePath = VBSModuleParams(1)
|
|
|
|
If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then
|
|
MSGBOX "Parameter1 = " & VBSModuleParams(0) & vbCrlf & _
|
|
"Parameter2 = " & VBSModuleParams(1),,"DEBUG Info: Parameter Values in Array - VBSModuleParams"
|
|
End If
|
|
|
|
Else
|
|
|
|
msgbox "Invalid function call!" & vbCrlf & _
|
|
"Please check the parameters!" & vbCrlf & _
|
|
"...then restart this Script!",vbExclamation ,"LoadVBSModule: Parameter Error!"
|
|
|
|
End if
|
|
|
|
'Checking folder paths 'Check if given path is valid, if not create it
|
|
If Not FSOModule.FolderExists(ModulePath) Then
|
|
|
|
FSOModule.CreateFolder(ModulePath)
|
|
msgbox "The ModulePath doesnt exist, trying to create!" & vbCrlf & _
|
|
"Please place your Modules there: " & vbCrlf & _
|
|
ModulePath & vbCrlf & vbCrlf & _
|
|
"...then restart this Script!",vbExclamation ,"LoadVBSModule: Modules / ModulePath is missing!"
|
|
Else
|
|
|
|
'Clear Error Variable
|
|
Err.Clear
|
|
|
|
'does the file exist? vbm is preferred!
|
|
If FSOModule.FileExists((ModulePath & "\" & Modulename & ".vbme")) Then
|
|
ModuleFullName = ModulePath & "\" & Modulename & ".vbme"
|
|
|
|
'does the file exist? vbm is preferred!
|
|
ElseIf FSOModule.FileExists((ModulePath & "\" & Modulename & ".vbm")) Then
|
|
ModuleFullName = ModulePath & "\" & Modulename & ".vbm"
|
|
|
|
'does the file exist?
|
|
Elseif FSOModule.FileExists((ModulePath & "\" & Modulename & ".vbs")) Then
|
|
ModuleFullName = ModulePath & "\" & Modulename & ".vbs"
|
|
|
|
Else 'Otherwise set empty string to var
|
|
ModuleFullName = Empty
|
|
|
|
End if
|
|
|
|
If (ModuleFullName = Empty) Then
|
|
|
|
MSGBOX "ModulePath cannot be determined! " & vbCrlf & _
|
|
"Path: " & ModulePath & "\" & Modulename & vbCrlf & _
|
|
"",vbOkayonly+vbCritical,"ERROR: Module does NOT exist! "
|
|
Err.Clear
|
|
LoadVBSModule = False
|
|
|
|
Else
|
|
|
|
Set Module = CreateObject("ADODB.Stream")
|
|
|
|
'IF ADODB object could not be created, fallback
|
|
If (Err.Number = 0) Then
|
|
|
|
Module.CharSet = "utf-8"
|
|
Module.Open
|
|
Module.LoadFromFile(ModuleFullName)
|
|
ModuleCode = Module.ReadText()
|
|
Module.Close
|
|
|
|
Else
|
|
|
|
Set Module = FSOModule.OpenTextFile(ModuleFullName, 1)
|
|
ModuleCode = Module.ReadAll
|
|
Module.Close
|
|
|
|
End If
|
|
|
|
Set Module = Nothing
|
|
|
|
'Code block for decrypting - need function decode
|
|
Const TagInit = "#@~^" '#@~^awQAAA==
|
|
Const TagFin = "==^#~@" '& chr(0)
|
|
|
|
If (Instr(ModuleCode,TagInit) > 0) and (Instr(ModuleCode,TagFin) > 0) Then
|
|
|
|
Do
|
|
|
|
FCode=0
|
|
DebCode = Instr(ModuleCode,TagInit)
|
|
If DebCode>0 Then
|
|
|
|
If (Instr(DebCode,ModuleCode,"==")-DebCode)=10 Then 'If "==" follows the tag
|
|
|
|
FCode=Instr(DebCode,ModuleCode,TagFin)
|
|
|
|
If FCode>0 Then
|
|
ModuleCode=Left(ModuleCode,DebCode-1) & _
|
|
Decode(Mid(ModuleCode,DebCode+12,FCode-DebCode-12-6)) & _
|
|
Mid(ModuleCode,FCode+6)
|
|
|
|
End If
|
|
|
|
End If
|
|
|
|
End If
|
|
Loop Until FCode=0
|
|
|
|
End If
|
|
|
|
'Execute the file content
|
|
ExecuteGlobal ModuleCode
|
|
|
|
If Err.Number <> 0 Then
|
|
MSGBOX "Error Code: " & Err.Number & vbCrlf & _
|
|
"Error Description: " & Err.Description & vbCrlf & _
|
|
"Path: " & ModuleFullName & vbCrlf & _
|
|
"",vbOkayonly+vbCritical,"ERROR: Module cannot be loaded!"
|
|
Err.Clear
|
|
LoadVBSModule = False
|
|
Else
|
|
LoadVBSModule = True
|
|
End If
|
|
|
|
End If
|
|
|
|
End If
|
|
|
|
End Function 'LoadVBSModule
|
|
|
|
Private Function Decode(Csrc)
|
|
Dim se,i,c,j,index,CsrcTemp
|
|
Dim tDecode(127)
|
|
Const Comb ="1231232332321323132311233213233211323231311231321323112331123132"
|
|
|
|
Set se= CreateObject("Scripting.Encoder")
|
|
For i=9 To 127
|
|
tDecode(i)="JLA"
|
|
Next
|
|
For i=9 To 127
|
|
CsrcTemp=Mid(se.EncodeScriptFile(".vbs",String(3,i),0,""),13,3)
|
|
For j=1 To 3
|
|
c=Asc(Mid(CsrcTemp,j,1))
|
|
tDecode(c)=Left(tDecode(c),j-1) & chr(i) & Mid(tDecode(c),j+1)
|
|
Next
|
|
Next
|
|
tDecode(42)=Left(tDecode(42),1) & ")" & Right(tDecode(42),1)
|
|
Set se=Nothing
|
|
|
|
Csrc=Replace(Replace(Csrc,"@&",chr(10)),"@#",chr(13))
|
|
Csrc=Replace(Replace(Csrc,"@*",">"),"@!","<")
|
|
Csrc=Replace(Csrc,"@$","@")
|
|
index=-1
|
|
For i=1 To Len(Csrc)
|
|
c=asc(Mid(Csrc,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
|
|
Csrc=Left(Csrc,i-1) & Mid(tDecode(c),Mid(Comb,(index Mod 64)+1,1),1) & Mid(Csrc,i+1)
|
|
End If
|
|
End If
|
|
Next
|
|
Decode=Csrc
|
|
End Function 'Decode
|
|
|
|
'======================================================================================================
|
|
'---------------------------------- EXAMPLE TO CALL THE FUNCTION(s) -----------------------------------
|
|
'======================================================================================================
|
|
'
|
|
''Prepare Array (Arrays are zero based!)
|
|
'Modules = Array("TestModule1","TestModule2","TestModule3")
|
|
'
|
|
' Dim Module
|
|
'
|
|
' 'Load external Modules.
|
|
' For Each Module In Modules
|
|
'
|
|
' If (Module <> "") Then
|
|
'
|
|
' 'Create the array to pass in to our function
|
|
' Dim VBSModuleParams
|
|
'
|
|
' 'Call the subroutine with two arguments
|
|
' Redim VBSModuleParams(0) 'Change to 1, for 2 values
|
|
' VBSModuleParams(0) = Module
|
|
' 'VBSModuleParams(1) = ""
|
|
'
|
|
' LoadVBSModuleResult = LoadVBSModule(VBSModuleParams)
|
|
'
|
|
' If (LoadVBSModuleResult <> True) Then
|
|
'
|
|
' 'Set WScript = CreateObject("WScript.Shell")
|
|
' MSGBOX "Module: " & Module & " was Not succesful been loaded!" & vbCrlf & _
|
|
' "Please load the Module and try again, running this Function/Module!" & vbCrlf & _
|
|
' "Exiting, because of this Issue." & vbCrlf & _
|
|
' Err.Description, vbCritical, "DEBUG Info: Cannot load Module!"
|
|
' 'WScript.Quit = not possible in Winline enviroment
|
|
'
|
|
' End If 'LoadVBSModuleResult
|
|
'
|
|
' End If 'Module <> ""
|
|
'
|
|
' Next 'end for each
|
|
'
|
|
'TestModule1
|
|
'TestModule2
|
|
'TestModule3
|
|
|
|
'------------------------------------------------------------------------------------------------------ |