Module: Reorg / Cleanup
This commit is contained in:
292
archive/Modules/LoadVBSModule.vbs
Normal file
292
archive/Modules/LoadVBSModule.vbs
Normal file
@@ -0,0 +1,292 @@
|
||||
'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
|
||||
|
||||
'------------------------------------------------------------------------------------------------------
|
||||
Reference in New Issue
Block a user