AppStd/Skriptentwickung
8
0
Fork 0
Code

Module: Reorg / Cleanup

Browse Source
This commit is contained in:
KammM 2024-11-21 17:24:16 +01:00
parent dc2562f8e6
commit e232695796
27 changed files with 1753 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
archive/Modules/3rdParty/MailStore/MS.PS.Lib.psd1 vendored Normal file
View File

Binary file not shown.

735
archive/Modules/3rdParty/MailStore/MS.PS.Lib.psm1 vendored Normal file
View File

@ -0,0 +1,735 @@
<#------------------------------------------------------------------------
PowerShell Scripting Library
for MailStore Server and MailStore Service Provider Edition
Requires Microsoft PowerShell 3.0 or higher
Copyright (c) 2014 - 2019 MailStore Software GmbH
Permission is hereby granted, free of charge, to any person obtaining
a copy of this software and associated documentation files (the
"Software"), to deal in the Software without restriction, including
without limitation the rights to use, copy, modify, merge, publish,
distribute, sublicense, and/or sell copies of the Software, and to
permit persons to whom the Software is furnished to do so, subject to
the following conditions:
The above copyright notice and this permission notice shall be
included in all copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
------------------------------------------------------------------------#>
if ($PSVersionTable.PSVersion.Major -lt 3) {
throw New-Object System.NotSupportedException "PowerShell V3 or higher required."
}
[System.Net.SecurityProtocolType]$DefaultSecurityProtocol = [System.Net.SecurityProtocolType]::Tls12 -bor [System.Net.SecurityProtocolType]::Tls11 -bor [System.Net.SecurityProtocolType]::Tls
<#
.SYNOPSIS
Scriptblock called by "InternalMSApiCall" to handle long running API processes.
.DESCRIPTION
Scriptblock called by "InternalMSApiCall" to handle long running API processes.
Optionally fires events to notify the parent session of Status changes.
Returns the final HTTP response as JSON object.
.PARAMETER MSApiClient
MS API client object created by "New-MSApiClient".
.PARAMETER StatusObject
Initial HTTP answer returned by the API as JSON object.
.PARAMETER StatusTimeout
Time in milliseconds until the the server stops waiting for a new Status updates to send.
.PARAMETER UseStatusEvents
If set to true, an event is fired for each status change.
.FUNCTIONALITY
start-job -ArgumentList <MS API client>, <Initial HTTP response object>, <Timeout>, <UseStatusEvents> -ScriptBlock $sbPullStatus
.LINK
http://en.help.mailstore.com/MailStore_Server_Administration_API#Long_Running_Processes
.LINK
http://en.help.mailstore.com/spe/Management_API_-_Using_the_API#Long_Running_Processes
.LINK
http://en.help.mailstore.com/MailStore_Server_Administration_API#Initial_HTTP_Response
.LINK
http://en.help.mailstore.com/spe/Management_API_-_Using_the_API#Initial_HTTP_Response
.LINK
http://en.help.mailstore.com/MailStore_Server_Administration_API#HTTP_Response_to_Periodic_Progress_Requests
.LINK
http://en.help.mailstore.com/spe/Management_API_-_Using_the_API#HTTP_Response_to_Periodic_Progress_Requests
.LINK
http://en.help.mailstore.com/MailStore_Server_Administration_API#Final_HTTP_Response
.LINK
http://en.help.mailstore.com/spe/Management_API_-_Using_the_API#Final_HTTP_Response
.OUTPUTS
<PSCustomObject>
JSON object that contains the final HTTP response.
<PSEngineEvent>
A custom PowerShell Engine Event that is fired in case of a Status version change. with the following properties:
-SourceIdentifier <string>
The initial Status token.
-MessageData <PSCustomObject>
JSON object with the current Status returned by the server.
#>
$sbPullStatus = [scriptblock]::Create({
Param(
[Parameter(Mandatory = $True, Position = 1)]
[ValidateNotNull()]
[PSCustomObject]$MSApiClient,
[Parameter(Mandatory = $True, Position = 2)]
[ValidateNotNullOrEmpty()]
[PSCustomObject]$StatusObject,
[Parameter(Position = 3)]
[ValidateNotNull()]
[int]$StatusTimeout = 5000,
[Parameter(Position = 4)]
[bool]$UseStatusEvents = $True
)
[System.Uri]$StatusUri = New-Object System.Uri ("HTTPS://{0}:{1}/{2}{3}" -f $MSApiClient.Server, $MSApiClient.Port.ToString(), "api/", "get-status")
if ($UseStatusEvents) {
# The Status token returned by the initial API request identifies the server process. We use it to as event source so the parent PS session knows to which API call the Status relates.
Register-EngineEvent -SourceIdentifier ($StatusObject.token) -Forward
}
# We need to set ServerCertificateValidationCallback and SecurityProtocol again as this is most likely a new PS session inside a job
[System.Net.ServicePointManager]::ServerCertificateValidationCallback = { $MSApiClient.IgnoreInvalidSSLCerts }
[System.Net.ServicePointManager]::SecurityProtocol = $MSApiClient.SecurityProtocol
[Microsoft.PowerShell.Commands.WebRequestSession]$Session = New-Object Microsoft.PowerShell.Commands.WebRequestSession
$session.Credentials = $MSApiClient.Credentials
do {
$StatusCode = ""
# We provide the status' token, last known version and a timeout value. The server will wait for that time at most for a new status, therefore it is not necessary for our client process to wait itself.
$Post = @{token = $StatusObject.token; lastKnownStatusVersion = $StatusObject.statusVersion; millisecondsTimeout = $StatusTimeout}
try {
[Microsoft.PowerShell.Commands.BasicHtmlWebResponseObject]$Response = Invoke-WebRequest -Uri $StatusUri.AbsoluteUri -Method Post -Body $Post -WebSession $Session -UseBasicParsing -MaximumRedirection 0 -ErrorAction SilentlyContinue
}
catch {
$Response = $global:Error[0].Exception.Response
if ($Response -eq $null) {
throw $global:Error[0].Exception
}
}
switch([System.Net.HttpStatusCode]$Response.StatusCode) {
([System.Net.HttpStatusCode]::OK) {
if ($Response.Content -eq $null) {
$StatusObject = $null
$StatusCode = ""
} else {
# The PS commandlets do not respect the response's encoding, putting the BOM from the server's response into the content field >:-[
# We need to remove the BOM so that ConvertFrom-Json succeeds.
$null = $Response.RawContentStream.Seek(0, [System.IO.SeekOrigin]::Begin) # Reset the stream
$StatusObject = (New-Object System.IO.StreamReader $Response.RawContentStream, $Response.BaseResponse.CharacterSet).ReadToEnd() | ConvertFrom-Json
$StatusCode = $StatusObject.StatusCode
# Fire a new PS Engine Event with the status token as SourceIdentifier.
# The calling session knows the token and can thus identify to which API call the event relates, especially if there are multiple jobs in the queue.
# MessageData contains a return object that has the current status as JSON object in its Data property.
if ($UseStatusEvents) {
$null = New-Event -SourceIdentifier $StatusObject.token -MessageData $StatusObject
}
}
}
([System.Net.HttpStatusCode]::Unauthorized) {
throw New-Object System.Net.WebException "Authentication failed. Check username and password."
}
([System.Net.HttpStatusCode]::NotFound) {
throw New-Object System.Net.WebException "Session expired or wrong token."
}
default {
throw New-Object System.Net.WebException ("({0}) {1}: {2}" -f [int]$Response.StatusCode, $Response.StatusDescription , $global:Error[0])
}
}
} while ($StatusCode -eq "running")
return $StatusObject
})
<#
Sends an API call to the MailStore or SPE Management Server.
.DESCRIPTION
Sends an API call to the MailStore or SPE Management Server.
Optionally runs a call asynchronously through background jobs.
Returns a JSON <PSCustomObject>.
.PARAMETER MSApiClient
MS API client object created by "New-MSApiClient".
.PARAMETER ApiFunction
A valid MS API function.
.PARAMETER ApiFunctionParameters
The parameters for the API function.
Provide as a hashtable, e.g. @{parameter1 = value1; parameter2 = value2; ...},
or PSCustomObject with parameters mapped to properties.
.PARAMETER StatusTimeout
Time in milliseconds until the the server stops waiting for a new status update to send.
.PARAMETER RunAsynchronously
If provided, an API function that the server decides to run asynchronously is run as a background job.
.LINK
http://en.help.mailstore.com/MailStore_Server_Administration_API
.LINK
http://en.help.mailstore.com/spe/Management_API_-_Using_the_API
.LINK
http://en.help.mailstore.com/MailStore_Server_Administration_API_Commands
.LINK
http://en.help.mailstore.com/spe/Management_API_-_Function_Reference
.OUTPUTS
A JSON <PSCustomObject> that encapsulates the HTTP response of the MS server.
#>
function InternalMSApiCall {
Param(
[Parameter(Mandatory = $True, Position = 1)]
[ValidateNotNullOrEmpty()]
[PSCustomObject]$MSApiClient,
[Parameter(Mandatory = $True, Position = 2)]
[ValidateScript({$MSApiClient.SupportedApiFunctions.name.Contains($_)})]
[string]$ApiFunction,
[Parameter(Position = 3)]
[System.Object]$ApiFunctionParameters = @{},
[Parameter(Position = 4)]
[ValidateNotNull()]
[int]$StatusTimeout = 5000,
[Parameter(Position = 5)]
[switch]$RunAsynchronously
)
# If $ApiFunctionParameters is passed as null, use an empty hashtable
if (!$ApiFunctionParameters) {
[Hashtable]$ApiFunctionParametersHT = @{}
} else {
# If necessary, convert PSCustomObject to Hashtable for further processing
switch ($ApiFunctionParameters.GetType().Name) {
"Hashtable" {
[Hashtable]$ApiFunctionParametersHT = $ApiFunctionParameters
}
"PSCustomObject" {
[Hashtable]$ApiFunctionParametersHT = @{}
$ApiFunctionParameters.psobject.properties | Foreach { $ApiFunctionParametersHT[$_.Name] = $_.Value }
}
default {
throw New-Object System.ArgumentException ('API function parameters must be passed either as Hashtable or as PSCustomObject.')
}
}
}
# Get the parameters for the API function supplied. The function itself has been checked in the Param block.
$MSApiFunctionWithParameters = $MSApiClient.SupportedApiFunctions | Where-Object {$_.name -eq $ApiFunction}
# Check whether the API function requires any parameters at all
if ($MSApiFunctionWithParameters.args.name) {
[Array]$ParameterNames = $MSApiFunctionWithParameters.args.name
} else {
[Array]$ParameterNames = @()
}
# Check whether parameters have been supplied that the API function does not support
[Array]$IllegalParams = Compare-Object -ReferenceObject $ParameterNames -DifferenceObject ([Array]$ApiFunctionParametersHT.Keys) -PassThru | Where-Object {$_.SideIndicator -EQ "=>"}
if ($IllegalParams.Count -gt 0) {
throw New-Object System.ArgumentException ('Illegal Arguments: {0}' -f ($IllegalParams -join ", "))
} else {
# Parameters which have their NULLABLE property set to false are mandatory
$MSApiFunctionMandatoryParameters = [Array]($MSApiFunctionWithParameters.args | Where-Object {$_.nullable -EQ $false})
# Check whether any parameters are mandatory at all
if ($MSApiFunctionMandatoryParameters.name) {
[Array]$ParameterNames = $MSApiFunctionMandatoryParameters.name
} else {
[Array]$ParameterNames = @()
}
# Check whether mandatory parameters are missing
[Array]$MissingParams = Compare-Object -ReferenceObject $ParameterNames -DifferenceObject ([Array]$ApiFunctionParametersHT.Keys) -PassThru | Where-Object {$_.SideIndicator -EQ "<="}
if ($MissingParams.Count -gt 0) {
throw New-Object System.ArgumentException ('Missing Arguments: {0}' -f ($MissingParams -join ", "))
} else {
#Place Argument Type Check Here. We let the server sort out most of it ;-)
#Except for Booleans where the server supports only lower case values in compliance with JSON specs
[Array]$BoolParams = $MSApiFunctionWithParameters.args | Where-Object {$_.type.ToLowerInvariant() -eq "bool"}
if ($BoolParams.Count -gt 0) {
[Array]$SuppliedBoolParams = Compare-Object -ReferenceObject $BoolParams.Name -DifferenceObject ([Array]$ApiFunctionParametersHT.Keys) -IncludeEqual -ExcludeDifferent -PassThru
foreach ($SuppliedBoolParam in $SuppliedBoolParams) {
$ApiFunctionParametersHT[$SuppliedBoolParam] = $ApiFunctionParametersHT[$SuppliedBoolParam].ToString().ToLowerInvariant()
}
}
#JSON parameters need to be converted to string if they are supplied as any other type
[Array]$JSONParams = $MSApiFunctionWithParameters.args | Where-Object {$_.type.ToLowerInvariant() -eq "json"}
if ($JSONParams.Count -gt 0) {
[Array]$SuppliedJSONParams = Compare-Object -ReferenceObject $JSONParams.Name -DifferenceObject ([Array]$ApiFunctionParametersHT.Keys) -IncludeEqual -ExcludeDifferent -PassThru
foreach ($SuppliedJSONParam in $SuppliedJSONParams) {
if ($ApiFunctionParametersHT[$SuppliedJSONParam].GetType().Name.ToLowerInvariant() -ne "string") {
$ApiFunctionParametersHT[$SuppliedJSONParam] = $ApiFunctionParametersHT[$SuppliedJSONParam] | ConvertTo-Json -Depth 10
}
}
}
}
}
# If a URI path is defined for the API function, use it, otherwise use the default path
$functionPath = if ($MSApiFunctionWithParameters | Get-Member "path") { $MSApiFunctionWithParameters.path } else { "api/invoke/" }
[System.Uri]$Uri = New-Object System.Uri ("HTTPS://{0}:{1}/{2}{3}" -f $MSApiClient.Server, $MSApiClient.Port.ToString(), $functionPath, $ApiFunction)
[System.Net.ServicePointManager]::ServerCertificateValidationCallback = { $MSApiClient.IgnoreInvalidSSLCerts }
[System.Net.ServicePointManager]::SecurityProtocol = $MSApiClient.SecurityProtocol
[Microsoft.PowerShell.Commands.WebRequestSession]$Session = New-Object Microsoft.PowerShell.Commands.WebRequestSession
$Session.Credentials = $MSApiClient.Credentials
# MS includes a BOM in most of its answers (especially the serialized JSON) which the PS commandlets cannot handle.
# Therefore we have to use Invoke-WebRequest instead of Invoke-RestMethod and do the parsing ourselves.
# Redirection and non terminating exceptions are suppressed.
try {
[Microsoft.PowerShell.Commands.BasicHtmlWebResponseObject]$Response = Invoke-WebRequest -Uri $Uri.AbsoluteUri -Method Post -Body $ApiFunctionParametersHT -WebSession $Session -UseBasicParsing -MaximumRedirection 0 -ErrorAction SilentlyContinue
}
catch {
$Response = $global:Error[0].Exception.Response
if ($Response -eq $null) {
throw $global:Error[0].Exception
}
}
# If the web request itself has been successful, we get a StatusCode.
switch([System.Net.HttpStatusCode]$Response.StatusCode) {
([System.Net.HttpStatusCode]::OK) {
# Respect the response's encoding and thus get rid of the BOM if necessary (see above) so that ConvertFrom-Json succeeds.
$null = $Response.RawContentStream.Seek(0, [System.IO.SeekOrigin]::Begin) # Reset the stream
$ResponseObject = (New-Object System.IO.StreamReader $Response.RawContentStream, $Response.BaseResponse.CharacterSet).ReadToEnd() | ConvertFrom-Json
if ($ResponseObject.StatusCode -eq "running") {
if ($RunAsynchronously.IsPresent) {
# For a long running server process, create a background job encapsuled in $sbPullStatus that does the Status handling.
$null = Start-Job -ArgumentList $MSApiClient, $ResponseObject, $StatusTimeout, $True -ScriptBlock $sbPullStatus
} else {
$ResponseObject = Invoke-Command -ArgumentList $MSApiClient, $ResponseObject, $StatusTimeout, $False -ScriptBlock $sbPullStatus -NoNewScope
}
}
# Return the JSON response object.
return $ResponseObject
}
([System.Net.HttpStatusCode]::Unauthorized) {
throw New-Object System.Net.WebException "Authentication failed. Check username and password."
}
default {
throw New-Object System.Net.WebException ("({0}) {1}: {2}" -f [int]$Response.StatusCode, $Response.StatusDescription , $global:Error[0])
}
}
}
<#
.SYNOPSIS
Creates a new MS API client object.
.DESCRIPTION
Creates a new MS API client object.
Returns an MS API client object.
.PARAMETER Username
Username of a MailStore Server or SPE administrator.
.PARAMETER Password
Password of that MailStore Server or SPE administrator.
.PARAMETER Credentials
Credentials of a MailStore Server or SPE administrator.
Alternative to providing <Username> and <Password>.
.PARAMETER MailStoreServer
DNS name or IP address of the MailStore Server.
.PARAMETER ManagementServer
DNS name or IP address of the SPE Management Server.
.PARAMETER Port
Port that the MailStore or SPE Management Server listens to for API calls.
.PARAMETER IgnoreInvalidSSLCerts
If included, errors due to invalid SSL certificates are ignored.
If omitted, only certificates that can be validated can be used.
.LINK
http://en.help.mailstore.com/MailStore_Server_Administration_API_Commands
.LINK
http://en.help.mailstore.com/spe/Management_API_-_Function_Reference
.OUTPUTS
<PSCustomObject>
Object that encapsulates an MS API client instance with the following properties:
-Server <string>
Same as MailStoreServer or ManagementServer parameter, see above.
-Port <string>
Same as input parameter, see above.
-IgnoreInvalidSSLCerts <bool>
Same as input parameter, see above.
-SupportedApiFunctions <PSCustomObject>
A JSON object that contains all functions the MS Management Server supports.
Data fields are:
-Name <string[]>
Name of the API function.
-Args <string[]>
List of arguments that the API function expects.
-Path [<string[]>]
The URI path that a request should use for this function.
If empty the default path "/invoke/<function>" is used.
Please refer to http://en.help.mailstore.com/MailStore_Server_Administration_API_Commands
or http://en.help.mailstore.com/spe/Management_API_-_Function_Reference for futher details.
#>
function New-MSApiClient {
[CmdletBinding(DefaultParameterSetName="MSSCredentialsAsStringsParameterSet")]
Param(
[Parameter(ParameterSetName = "MSSCredentialsAsStringsParameterSet", Position = 1, Mandatory = $true)]
[Parameter(ParameterSetName = "SPECredentialsAsStringsParameterSet", Position = 1, Mandatory = $true)]
[ValidateNotNullOrEmpty()]
[string]$Username = "admin",
[Parameter(ParameterSetName = "MSSCredentialsAsPSCredentialObjectParameterSet", Position = 1, Mandatory = $true)]
[Parameter(ParameterSetName = "SPECredentialsAsPSCredentialObjectParameterSet", Position = 1, Mandatory = $true)]
[ValidateNotNull()]
[pscredential]$Credentials,
[Parameter(ParameterSetName = "MSSCredentialsAsStringsParameterSet", Position = 2, Mandatory = $true)]
[Parameter(ParameterSetName = "SPECredentialsAsStringsParameterSet", Position = 2, Mandatory = $true)]
[ValidateNotNullOrEmpty()]
[string]$Password,
[Parameter(ParameterSetName = "MSSCredentialsAsStringsParameterSet", Position = 3, Mandatory = $true)]
[Parameter(ParameterSetName = "MSSCredentialsAsPSCredentialObjectParameterSet", Position = 2, Mandatory = $true)]
[ValidateNotNullOrEmpty()]
[Alias("Server")]
[string]$MailStoreServer = "localhost",
[Parameter(ParameterSetName = "SPECredentialsAsStringsParameterSet", Position = 3, Mandatory = $true)]
[Parameter(ParameterSetName = "SPECredentialsAsPSCredentialObjectParameterSet", Position = 2, Mandatory = $true)]
[ValidateNotNullOrEmpty()]
[string]$ManagementServer = "localhost",
[Parameter(ParameterSetName = "MSSCredentialsAsStringsParameterSet", Position = 4)]
[Parameter(ParameterSetName = "SPECredentialsAsStringsParameterSet", Position = 4)]
[Parameter(ParameterSetName = "MSSCredentialsAsPSCredentialObjectParameterSet", Position = 3)]
[Parameter(ParameterSetName = "SPECredentialsAsPSCredentialObjectParameterSet", Position = 3)]
[ValidateRange(1024,65535)]
[int]$Port,
[Net.SecurityProtocolType]$SecurityProtocol = $DefaultSecurityProtocol,
[switch]$IgnoreInvalidSSLCerts
)
# If username and password have been provided, store them in a PSCredential object.
if ($PSBoundParameters.ContainsKey("Password")) {
$Credentials = New-Object System.Management.Automation.PSCredential($Username,(ConvertTo-SecureString $Password -AsPlainText -Force))
}
# Get the server name based on the parameter set used.
switch -wildcard ($PSCmdlet.ParameterSetName) {
"MSS*" {
$Server = $MailStoreServer
}
"SPE*" {
$Server = $ManagementServer
}
}
# If no port has been provided, make a best guess based on the server parameter name.
if (!($PSBoundParameters.ContainsKey("Port"))) {
switch -wildcard ($PSCmdlet.ParameterSetName) {
"MSS*" {
$Port = 8463
}
"SPE*" {
$Port = 8474
}
}
}
# We provide a basic set of supported API functions to be able to login and initialize the MS API client object. The full set of functions will be retrieved later through "get-metadata" (see below).
$API_SUPPORTEDFUNCTIONS = '[{"name": "get-status","args": [{"name": "token","type": "string","nullable": false},{"name": "lastKnownStatusVersion","type": "number","nullable": false},{"name": "millisecondsTimeout","type": "number","nullable": false}],"path": "api/"},{"name": "get-metadata","args": [],"path": "api/"},{"name": "cancel-async","args": [{"name": "token","type": "string","nullable": false}],"path": "api/"}]'
[PSCustomObject]$MSApiClient = @{Credentials = $Credentials; Server = $Server; Port = $Port; SecurityProtocol = $SecurityProtocol; IgnoreInvalidSSLCerts = $IgnoreInvalidSSLCerts.IsPresent; SupportedApiFunctions = $API_SUPPORTEDFUNCTIONS | ConvertFrom-Json}
# Retrieve a list of all API functions that this installation of MS supports and convert it into a JSON object. Use a parsing depth of 10 levels just be sure and the default of 2 (!) is a bit ... insufficient.
$SupportedApiFunctions = InternalMSApiCall -MSApiClient $MSApiClient -ApiFunction "get-metadata" | ConvertTo-Json -Depth 10
# Join our basic set with the retrieved set because "get-metadata" omits some base API functions.
$MSApiClient.SupportedApiFunctions = ($API_SUPPORTEDFUNCTIONS.Substring(0,$API_SUPPORTEDFUNCTIONS.Length-1) + "," + $SupportedApiFunctions.Substring(1) ) | ConvertFrom-Json
return $MSApiClient
}
<#
.SYNOPSIS
Sends an API call to the MailStore or SPE Management Server.
.DESCRIPTION
Sends an API call to the MailStore or SPE Management Server.
If the server decides to run the called function asynchronously, this commandlet waits for the final result.
Use <Start-MSApiCall> for asynchronous function handling.
Returns a JSON <PSCustomObject>.
.PARAMETER MSApiClient
MS API client object created by "New-MSApiClient".
.PARAMETER ApiFunction
A valid MS API function.
.PARAMETER ApiFunctionParameters
The parameters for the API function.
Provide as a hashtable, e.g. @{parameter1 = value1; parameter2 = value2; ...},
or PSCustomObject with parameters mapped to properties.
.PARAMETER StatusTimeout
Time in milliseconds until the the server stops waiting for a new status update to send.
.LINK
http://en.help.mailstore.com/MailStore_Server_Administration_API
.LINK
http://en.help.mailstore.com/spe/Management_API_-_Using_the_API
.LINK
http://en.help.mailstore.com/MailStore_Server_Administration_API_Commands
.LINK
http://en.help.mailstore.com/spe/Management_API_-_Function_Reference
.OUTPUTS
A JSON <PSCustomObject> that encapsulates the HTTP response of the MS server.
#>
function Invoke-MSApiCall {
Param(
[Parameter(Mandatory = $True, Position = 1)]
[ValidateNotNullOrEmpty()]
[PSCustomObject]$MSApiClient,
[Parameter(Mandatory = $True, Position = 2)]
[ValidateScript({$MSApiClient.SupportedApiFunctions.name.Contains($_)})]
[string]$ApiFunction,
[Parameter(Position = 3)]
[System.Object]$ApiFunctionParameters = @{},
[Parameter(Position = 4)]
[ValidateNotNull()]
[int]$StatusTimeout = 5000
)
return InternalMSApiCall -MSApiClient $MSApiClient -ApiFunction $ApiFunction -ApiFunctionParameters $ApiFunctionParameters -StatusTimeout $StatusTimeout
}
<#
.SYNOPSIS
Sends an API call to the MailStore or SPE Management Server.
.DESCRIPTION
Sends an API call to the MailStore or SPE Management Server.
If the server decides to run the called function asynchronously, this commandlet runs the call as a background job.
Use <Invoke-MSApiCall> for synchronous function handling.
Returns an object that contains information about the result (see Output).
.PARAMETER MSApiClient
MS API client object created by "New-MSApiClient".
.PARAMETER ApiFunction
A valid MS API function.
.PARAMETER ApiFunctionParameters
The parameters for the API function.
Provide as a hashtable, e.g. @{parameter1 = value1; parameter2 = value2; ...},
or PSCustomObject with parameters mapped to properties.
.PARAMETER StatusTimeout
Time in milliseconds until the the server stops waiting for a new status update to send.
.LINK
http://en.help.mailstore.com/MailStore_Server_Administration_API
.LINK
http://en.help.mailstore.com/spe/Management_API_-_Using_the_API
.LINK
http://en.help.mailstore.com/MailStore_Server_Administration_API_Commands
.LINK
http://en.help.mailstore.com/spe/Management_API_-_Function_Reference
.OUTPUTS
A JSON <PSCustomObject> that encapsulates the HTTP response of the MS server.
If that object's <statusCode> property is "running", a Windows PowerShell background job handles the Status of the server process.
The job fires PSEngineEvents with the status token as SourceIdentifier and the current status in MessageData as a JSON <PSCustomObject>.
Once the job is finished, it returns the final Status as a JSON <PSCustomObject>.
#>
function Start-MSApiCall {
Param(
[Parameter(Mandatory = $True, Position = 1)]
[ValidateNotNullOrEmpty()]
[PSCustomObject]$MSApiClient,
[Parameter(Mandatory = $True, Position = 2)]
[ValidateScript({$MSApiClient.SupportedApiFunctions.name.Contains($_)})]
[string]$ApiFunction,
[Parameter(Position = 3)]
[System.Object]$ApiFunctionParameters = @{},
[Parameter(Position = 4)]
[ValidateNotNull()]
[int]$StatusTimeout = 5000
)
return InternalMSApiCall -MSApiClient $MSApiClient -ApiFunction $ApiFunction -ApiFunctionParameters $ApiFunctionParameters -StatusTimeout $StatusTimeout -RunAsynchronously
}
<#
.SYNOPSIS
Cancels a long running MS server process.
.DESCRIPTION
Cancels a long running MS server process.
Returns an object that contains the Status.
.PARAMETER MSApiClient
MS API client object created by "New-MSApiClient".
.PARAMETER AsyncReturnObject
JSON <PSCustomObject> that encapsulates the initial Status returned by the server in answer to the original API request.
.PARAMETER Token
The Status token returned by the initial API request.
Alternative to AsyncReturnObject.
.LINK
http://en.help.mailstore.com/MailStore_Server_Administration_API#Long_Running_Processes
.LINK
http://en.help.mailstore.com/spe/Management_API_-_Using_the_API#Long_Running_Processes
.LINK
http://en.help.mailstore.com/MailStore_Server_Administration_API#Initial_HTTP_Response
.LINK
http://en.help.mailstore.com/spe/Management_API_-_Using_the_API#Initial_HTTP_Response
.OUTPUTS
JSON <PSCustomObject> that encapsulates the Status returned by the server.
.NOTES
This function sends an API call to the MailStore or SPE Management Server to request a specific long running process to be cancelled.
The server decides if and when the cancellation occurs; it does not necessarily cancel the process immediately.
The background job that does the Status handling continues to run until it receives the server's cancellation signal.
#>
function Stop-MSApiCall {
Param(
[Parameter(Mandatory = $True, Position = 1)]
[ValidateNotNullorEmpty()]
[PSCustomObject]$MSApiClient,
[Parameter(ParameterSetName = "JobByObject", Mandatory = $True, Position = 2)]
[ValidateNotNullorEmpty()]
[PSCustomObject]$AsyncReturnObject,
[Parameter(ParameterSetName = "JobByToken", Mandatory = $True, Position = 2)]
[ValidateNotNullOrEmpty()]
[string]$Token
)
if ($PSCmdlet.ParameterSetName -eq "JobByObject") {
$Token = $AsyncReturnObject.token
}
if ($Token -ne "") {
return Invoke-MSApiCall $MSApiClient "cancel-async" @{token = $Token}
}
}
# Aliases to support MailStore SPE 8.5 scripts
# Start-MSSPEApiCall is mapped to Invoke-MSApiCall to assure the correct behavior
Set-Alias -Name New-MSSPEApiClient -Value New-MSApiClient
Set-Alias -Name Invoke-MSSPEApiCall -Value Invoke-MSApiCall
Set-Alias -Name Start-MSSPEApiCall -Value Invoke-MSApiCall
Set-Alias -Name Stop-MSSPEApiCall -Value Stop-MSApiCall
# Aliases to support MailStore Server 7/8 scripts
# Start-MSSApiCall is mapped to Invoke-MSApiCall to assure the correct behavior
Set-Alias -Name New-MSSApiClient -Value New-MSApiClient
Set-Alias -Name Invoke-MSSApiCall -Value Invoke-MSApiCall
Set-Alias -Name Start-MSSApiCall -Value Invoke-MSApiCall
# Public members that should be visible through Import-Module
Export-ModuleMember -Function New-MSApiClient, Invoke-MSApiCall, Start-MSApiCall, Stop-MSApiCall -Alias New-MSSPEApiClient, Invoke-MSSPEApiCall, Start-MSSPEApiCall, Stop-MSSPEApiCall, New-MSSApiClient, Invoke-MSSApiCall, Start-MSSApiCall

3
archive/Modules/Archiv/AddDebugLine.vbs Normal file
View File

@ -0,0 +1,3 @@
Sub AddDebugLine(Message)
DEBUG_MESSAGE = DEBUG_MESSAGE & Message & vbNewLine
End Sub

23
archive/Modules/Archiv/ArchiveFolder.vbs Normal file
View File

@ -0,0 +1,23 @@
ArchiveFolder "foo.zip", "Testordner"
Sub ArchiveFolder (zipFile, sFolder)
With CreateObject("Scripting.FileSystemObject")
zipFile = .GetAbsolutePathName(zipFile)
sFolder = .GetAbsolutePathName(sFolder)
With .CreateTextFile(zipFile, True)
.Write Chr(80) & Chr(75) & Chr(5) & Chr(6) & String(18, chr(0))
End With
End With
With CreateObject("Shell.Application")
.NameSpace(zipFile).CopyHere .NameSpace(sFolder).Items
Do Until .NameSpace(zipFile).Items.Count = _
.NameSpace(sFolder).Items.Count
WScript.Sleep 1000
Loop
End With
End Sub

37
archive/Modules/Archiv/ConvertFromSecureString.vbs Normal file
View File

@ -0,0 +1,37 @@
Public Function ConvertFromSecureString(Ciphertext)
'Stand: 26.08.2020
'Source: https://gist.github.com/albert1205/c8430b5bfa505f9308e4fa789b9b1d7f
Const offset = 10
Const minAsc = 33
Const maxAsc = 126
If Len(Ciphertext) < 5 Then
Decrypt = ""
Exit Function
End If
Dim Plaintext
Ciphertext = Mid(Ciphertext,3,Len(Ciphertext)-4)
For i=2 To Len(Ciphertext) Step 2
oldAsc = Asc(Mid(Ciphertext,i,1)) + offset
If oldAsc > maxAsc Then
oldAsc = oldAsc - maxAsc + minAsc - 1
End If
Plaintext = Plaintext & Chr(oldAsc)
' MsgBox Asc(Mid(Ciphertext,i,1)) & " -> " & oldAsc
Next
ConvertFromSecureString = Plaintext
End Function
Private Sub DecryptTool()
Ciphertext = InputBox("Bitte den zu entschluesselnden String eingeben:","Eingabe erfolderlich","")
Plaintext = ConvertFromSecureString(Ciphertext)
InputBox "Ihre Eingabe lautete: " & Ciphertext & vbNewLine & vbNewLine & "Entschluesselt, sieht der String wie folgt aus:","Erledigt!",Plaintext
End Sub
'Call DecryptTool

41
archive/Modules/Archiv/ConvertToSecureString.vbs Normal file
View File

@ -0,0 +1,41 @@
Public Function ConvertToSecureString(Plaintext)
'Stand: 26.08.2020
'Source: https://gist.github.com/albert1205/c8430b5bfa505f9308e4fa789b9b1d7f
Const offset = 10
Const minAsc = 33
Const maxAsc = 126
Dim Ciphertext
Randomize
Ciphertext = Ciphertext & Chr(Int((maxAsc-minAsc+1)*Rnd+minAsc))
Ciphertext = Ciphertext & Chr(Int((maxAsc-minAsc+1)*Rnd+minAsc))
For i=1 To Len(Plaintext)*2
If i mod 2 = 0 Then
newAsc = Asc(Mid(Plaintext,i/2,1)) - offset
If newAsc < minAsc Then
newAsc = newAsc + maxAsc - minAsc + 1
End If
Ciphertext = Ciphertext & Chr(newAsc)
' MsgBox Asc(Mid(Plaintext,i/2,1)) & " -> " & newAsc
Else
Ciphertext = Ciphertext & Chr(Int((maxAsc-minAsc+1)*Rnd+minAsc))
' MsgBox "Rnd:" & Chr(Int((maxAsc-minAsc+1)*Rnd+minAsc))
End If
Next
Ciphertext = Ciphertext & Chr(Int((maxAsc-minAsc+1)*Rnd+minAsc))
Ciphertext = Ciphertext & Chr(Int((maxAsc-minAsc+1)*Rnd+minAsc))
ConvertToSecureString = Ciphertext
End Function
Private Sub EncryptTool()
Plaintext = InputBox("Bitte den zu verschluesselnden String eingeben:","Eingabe erfolderlich","")
Ciphertext = ConvertToSecureString(Plaintext)
InputBox "Ihre Eingabe lautete: " & Plaintext & vbNewLine & vbNewLine & "Verschluesselt, sieht der String wie folgt aus:","Erledigt!",Ciphertext
End Sub
Call EncryptTool

143
archive/Modules/Archiv/GetDateByWeekdayname.vbm Normal file
View File

@ -0,0 +1,143 @@
' GetDateByWeekdayname
' ----------------------------------------------------------------------------
' Diese Funktion errechnet das Datum eines übergebenen Wochentages
' Parameter 1 (pWeekdayname) = Übergabe des zu ermittelnden Wochentags (Bsp.: "Montag","Dienstag","Mittwoch","Donnerstag","Freitag","Samstag","Sonntag")
' Parameter 2 (pFromDate) = Übergabe des Datums, ab wann gerechnet werden soll (Bsp.: "01.01.2022")
' Parameter 3 (pIncludeToday) = Übergabe "True" oder "False" um den aktuellen Tag in die Ermittlung einzubeziehen.
' Parameter 4 (pSkipTodayByTime) = Übergabe einer Uhrzeit (Bsp.: "12:00"), bis wann der aktuelle Tag miteinbezogen werden soll.
' Sofern nicht mit "99:99" oder "NULL" abgeschaltet, übersteuert Parameter 4 immer Parameter 3.
'
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow@digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 05.10.2021 / MK
' Version Date / Editor: 12.10.2021 / MK
' Version Number: 1.3.0.0
Function GetDateByWeekdayname(pWeekdayname,pFromDate,pIncludeToday,pSkipTodayByTime)
'Set vars. Set current date and day and nr
IF (GetLocale() = 1031) then
Weekdaynames = Array("Sonntag","Montag","Dienstag","Mittwoch","Donnerstag","Freitag","Samstag")
Else 'Tag 1 2 3 4 5 6 7
Weekdaynames = Array("Sunday","Monday","Tuesday","Wednesday","Thursday","Friday","Saturday")
End if
'Evaluate parameter pFromDate
IF (pFromDate = "today") Then
FromDate = Date()
Else
FromDate = cdate(pFromDate)
End if
IF (IsDate(FromDate) = True) Then
CurrentDayNumber = Weekday(FromDate)
CurrentDayOfWeek = Weekdayname(CurrentDayNumber,False,1)
CurrentTime = TimeValue(Now())
'Evaluate parameter pSkipTodayByTime
If (pSkipTodayByTime <> "99:99") and (pSkipTodayByTime <> "NULL") Then
On Error Resume Next
TimeValue(pSkipTodayByTime)
If (Err.number = 0) and (CLng(Replace(CurrentTime,":","")) > CLng(Replace(TimeValue(pSkipTodayByTime),":",""))) then
IncludeToday = False
Else
IncludeToday = True
End if
Else
'Fallback if parameter ist not bool
IF (VarType(pIncludeToday) = 11) Then
IncludeToday = pIncludeToday
Else
IncludeToday = False
End If
End if
If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then
MsgBox "Looking for next: " & vbCrlf & _
"pWeekdayname " & pWeekdayname & vbCrlf & _
"FromDate " & FromDate & vbCrlf & _
"pIncludeToday " & pIncludeToday & vbCrlf & _
"IncludeToday " & IncludeToday & vbCrlf & _
"pSkipTodayByTime " & pSkipTodayByTime & vbCrlf & vbCrlf & _
"CurrentDayOfWeek: " & CurrentDayOfWeek & vbCrlf & _
"CurrentDayNumber: " & CurrentDayNumber & vbCrlf & _
"",,"DEBUG - GetDateByWeekdayname - Parameter given:"
End If
CalcDate = FromDate
CalcDayNumber = CurrentDayNumber
Counter = 0
DO
'If pIncludeToday = False, skip the current FromDate and add one day
IF (IncludeToday = False) then
Counter = Counter + 1
CalcDayNumber = CalcDayNumber + 1
End If
'Reset day, but keep counter
IF (CalcDayNumber > 7) Then
CalcDayNumber = 1
end if
CalcDate = Dateadd("d", + counter, FromDate)
If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then
MsgBox "pWeekdayname: " & pWeekdayname & vbCrlf & _
"pFromDate: " & pFromDate & vbCrlf & _
"pIncludeToday: " & pIncludeToday & vbCrlf & _
"pSkipTodayByTime: " & pSkipTodayByTime & vbCrlf & vbCrlf & _
"Counter: " & Counter & vbCrlf & _
"CalcDayNumber: " & CalcDayNumber & vbCrlf & _
"CalcWeekdayname: " & Weekdayname(CalcDayNumber,False,1) & vbCrlf & _
"CalcWeekday: " & Weekday(CalcDayNumber) & vbCrlf & _
"CalcDate: " & CalcDate,, "DEBUG - GetDateByWeekdayname - Loop " & Counter
End If
CalcDayOfWeek = Weekdayname(CalcDayNumber,False,1)
'Failsafe to prevent endless loops
IF ((CalcDayOfWeek = pWeekdayname) or (Counter = 31)) THEN EXIT DO
'If pIncludeToday = True, dont skip the current FromDate
IF (IncludeToday = True) then
Counter = Counter + 1
CalcDayNumber = CalcDayNumber + 1
End If
LOOP
If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then
MsgBox "Errechnet: " & cdate(CalcDate),,"DEBUG - GetDateByWeekdayname - Ergebnis"
End if
Else
CalcDate = "01.01.1970"
If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then
MsgBox "Ungültiges Datum, failsafe auf: 01.01.1970",,"DEBUG - GetDateByWeekdayname - Ergebnis"
End if
End if
'Return calculated date
GetDateByWeekdayname = cdate(CalcDate)
end function 'GetDateByWeekdayname
'datetest = GetDateByWeekdayname ("Dienstag","12.10.2021",false,"12:00")
'msgbox datetest

3
archive/Modules/Archiv/GetLeftPad.vbs Normal file
View File

@ -0,0 +1,3 @@
Function GetLeftPad(Value)
GetLeftPad = Right("0" & Value, 2)
End Function

77
archive/Modules/Archiv/GetWinLineDocDeliveryNoteByUnsplittedProducts.vbs Normal file
View File

@ -0,0 +1,77 @@
Function GetWinLineDocDeliveryNoteByUnsplittedProducts(ProductNumber, WinLineMandatorNr, WinLineYear)
'Version date: 15.09.2020
Dim Conn, Result
Set Conn = CWLStart.CurrentCompany.Connection
If (ProductNumber <> "") and (WinLineMandatorNr <> "") and (WinLineYear <> "") Then
'c999 = cOrdnerNr
'c998 = cInvoiceNr
'c997 = KeyValue
'c996 = KeyValue
'MESOPRIM = MESOPRIM
'c995 = Amount / Pos
'c994 = Amount / overall
SQL = ""
SQL = SQL & "SELECT t025.c045 as [c999], t025.c055 as [c998], T026.C000 as [c997], T025.C000 as [c996], T024.MESOPRIM, t026.c006 as [c995], "
SQL = SQL & "( "
SQL = SQL & "SELECT sum(t026.c006) "
SQL = SQL & "FROM T026 WITH (NOLOCK), T025 WITH (NOLOCK), T024 WITH (NOLOCK) "
SQL = SQL & "WHERE T026.MESOCOMP = '"& WinLineMandatorNr &"' AND T025.MESOCOMP = '"& WinLineMandatorNr &"' AND T024.MESOYEAR = '"& WinLineCurrentYear &"' AND T024.MESOCOMP = '"& WinLineMandatorNr &"' "
SQL = SQL & "AND (T025.C021 = T026.C044 AND T025.C022 = T026.C045 AND T025.C137 = 3 AND T026.C042 = N'1' AND T026.C055 < 10 AND T026.C074 < 10 AND T025.C186 = 0 AND T026.C003 = T024.C002 "
SQL = SQL & "AND (T025.C025 = N'D' OR T025.C025 =N'*' OR T025.C026 = N'D' OR T025.C026 =N'*') "
SQL = SQL & "AND (T026.C039 = N'D' OR T026.C039 =N'*' OR T026.C040 = N'D' OR T026.C040 =N'*') "
SQL = SQL & "AND T026.C006 <> 0.0 AND T026.C109 <= 0 AND T026.C003 >= '"& ProductNumber &"' AND T026.C003 <= N'TT1111001') "
SQL = SQL & ") as [c994] "
SQL = SQL & "FROM T026 WITH (NOLOCK), T025 WITH (NOLOCK), T024 WITH (NOLOCK) "
SQL = SQL & "WHERE T026.MESOCOMP = '"& WinLineMandatorNr &"' AND T025.MESOCOMP = '"& WinLineMandatorNr &"' AND T024.MESOYEAR = '"& WinLineCurrentYear &"' AND T024.MESOCOMP = '"& WinLineMandatorNr &"' "
SQL = SQL & "AND (T025.C021 = T026.C044 AND T025.C022 = T026.C045 AND T025.C137 = 3 AND T026.C042 = N'1' AND T026.C055 < 10 AND T026.C074 < 10 AND T025.C186 = 0 AND T026.C003 = T024.C002 "
SQL = SQL & "AND (T025.C025 = N'D' OR T025.C025 =N'*' OR T025.C026 = N'D' OR T025.C026 =N'*') "
SQL = SQL & "AND (T026.C039 = N'D' OR T026.C039 =N'*' OR T026.C040 = N'D' OR T026.C040 =N'*') "
SQL = SQL & "AND T026.C006 <> 0.0 AND T026.C109 <= 0 AND T026.C003 >= '"& ProductNumber &"' AND T026.C003 <= '"& ProductNumber &"' ) "
SQL = SQL & "ORDER BY T026.C003 ASC, T026.C025, T026.C044, T026.C045 "
'MsgBox "SQL (Part 1): " & Mid(SQL, 1, 750)
'MsgBox "SQL (Part 2): " & Mid(SQL, 750)
Set Result = Conn.Select(SQL)
'msgbox "egal was"
'test = result.rowcount
'msgbox "type: " & TypeName(result)
'msgbox "result: " & result
'msgbox "Rowcount: " & test
'msgbox "result: " & result.value("c999")
If DEBUG_ON = True Then
AddDebugLine "Querying for unsplitted delivery notes.. " & vbNewline
AddDebugLine "Result Columns: " & Result
AddDebugLine "Result Rows: " & Result.RowCount
AddDebugLine "SQL (Part 1): " & Mid(SQL, 1, 750)
AddDebugLine "SQL (Part 2): " & Mid(SQL, 750)
ShowDebugBox "GetWinLineInternalProductNumber"
End If
'Use the set order, because we want to return an object!
Set GetWinLineDocDeliveryNoteByUnsplittedProducts = Result
Else
If DEBUG_ON = True Then
AddDebugLine "Invalid argument call!" & vbNewline
ShowDebugBox "GetWinLineInternalProductNumber"
End If
GetWinLineDocDeliveryNoteByUnsplittedProducts = 0
End If
End Function

8
archive/Modules/Archiv/GetWinLineDocInfoByAccountAndRunningNr.vbs
View File

@ -1,12 +1,12 @@
Function GetWinLineDocInfoByAccountAndRunningNr(DocAccountAndRunningNr, PostingType, WinLineDocType)
'Stand 25.08.2020
'Stand 08.01.2021
On Error Resume Next
'Set SQL Table and Query for DocHead. Default: "T025"
SQLTable_DocHead = "[T025]"
SQLQuery_DocHead = "c000 = '" & DocAccountAndRunningNr & "'" & SQLQuery_BasicWhere
SQLQuery_DocHead = "c000 = '" & DocAccountAndRunningNr & "'" & SQLQuery_OrderWhere
'Set SQL Table and Query for DocMid. Default: "T026"
SQLTable_DocMid = "[T026]"
@ -14,12 +14,12 @@ Function GetWinLineDocInfoByAccountAndRunningNr(DocAccountAndRunningNr, PostingT
SQLQuery_DocMid_MengeGeliefert = ""
SQLQuery_DocMid_MengeGeliefert = SQLQuery_DocMid_MengeGeliefert & "SELECT SUM(c006) as [MengeGeliefert] "
SQLQuery_DocMid_MengeGeliefert = SQLQuery_DocMid_MengeGeliefert & "FROM " & SQLTable_DocMid & "(NOLOCK) "
SQLQuery_DocMid_MengeGeliefert = SQLQuery_DocMid_MengeGeliefert & "WHERE [c000] LIKE '" & DocAccountAndRunningNr & "-%'" & SQLQuery_BasicWhere
SQLQuery_DocMid_MengeGeliefert = SQLQuery_DocMid_MengeGeliefert & "WHERE [c000] LIKE '" & DocAccountAndRunningNr & "-%'" & SQLQuery_OrderWhere
SQLQuery_DocMid_Rueckstandsmenge = ""
SQLQuery_DocMid_Rueckstandsmenge = SQLQuery_DocMid_Rueckstandsmenge & "SELECT SUM(c099) as [RueckstandsMenge] "
SQLQuery_DocMid_Rueckstandsmenge = SQLQuery_DocMid_Rueckstandsmenge & "FROM " & SQLTable_DocMid & "(NOLOCK) "
SQLQuery_DocMid_Rueckstandsmenge = SQLQuery_DocMid_Rueckstandsmenge & "WHERE [c000] LIKE '" & DocAccountAndRunningNr & "-%'" & SQLQuery_BasicWhere
SQLQuery_DocMid_Rueckstandsmenge = SQLQuery_DocMid_Rueckstandsmenge & "WHERE [c000] LIKE '" & DocAccountAndRunningNr & "-%'" & SQLQuery_OrderWhere
IF (SQLTable_DocHead <> "") and (SQLQuery_DocHead <> "") and (PostingType <> "") and (WinLineDocType <> "") Then

91
archive/Modules/Archiv/GetWinLineDocUniqueByNumber.vbs Normal file
View File

@ -0,0 +1,91 @@
Function GetWinLineDocUniqueIdentifier(GetWinLineDocUniqueIdentifierParams)
'SYNOPSIS
'Function will load external - additional - VBS Modules 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
'"GetWinLineDocUniqueIdentifierParams(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, ModuleCode
'REQUIREMENT Variables preSet
'<NONE>
'REQUIREMENT Functions
'<NONE>
'VERSION
'Number: 1.0.0.0 / Date: 01.12.2020
'PARAMETER GetWinLineDocUniqueIdentifierParams(0) = WorkingMode
'Give the
'PARAMETER GetWinLineDocUniqueIdentifierParams(1) = DocAccountAndRunningNr
'Optional Parameter.
'PARAMETER GetWinLineDocUniqueIdentifierParams(2) = DocAccountNr
'Optional Parameter.
'PARAMETER GetWinLineDocUniqueIdentifierParams(3) = DocRunningNr
'Optional Parameter.
'EXAMPLE
'Dim GetWinLineDocUniqueIdentifierParams
'Redim GetWinLineDocUniqueIdentifierParams(0)
'GetWinLineDocUniqueIdentifierParams(0) = Module
'LoadVBSModule(GetWinLineDocUniqueIdentifierParams)
'EXAMPLE
'Dim GetWinLineDocUniqueIdentifierParams
'Redim GetWinLineDocUniqueIdentifierParams(1)
'GetWinLineDocUniqueIdentifierParams(0) = Module
'GetWinLineDocUniqueIdentifierParams(1) = "D:\ScriptFiles\Modules"
'LoadVBSModule(GetWinLineDocUniqueIdentifierParams)
On Error Resume Next
If VarType(GetWinLineDocUniqueIdentifierParams) > 8000 Then
WorkingMode = GetWinLineDocUniqueIdentifierParams(0)
DocAccountAndRunningNr = GetWinLineDocUniqueIdentifierParams(1)
DocAccountNr = GetWinLineDocUniqueIdentifierParams(2)
DocRunningNr = GetWinLineDocUniqueIdentifierParams(3)
IF (WorkingMode = "interactive") or (WorkingMode = "interaktive") Then
GetWinLineDocUniqueIdentifier = DocAccountAndRunningNr
Else
GetWinLineDocUniqueIdentifier = DocAccountAndRunningNr
End If
'If no array was used by calling this function
Else
If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then
MSGBOX "The used Parameter is no Array!" & vbCrlf & _
"",,"DEBUG Info: Parameter is no Array - GetWinLineDocUniqueIdentifierParams"
End If
GetWinLineDocUniqueIdentifier = ""
End if
End Function 'GetWinLineDocUniqueIdentifier

32
archive/Modules/Archiv/GetWinLineInternalProductNumber.vbs Normal file
View File

@ -0,0 +1,32 @@
Function GetWinLineInternalProductNumber(ProductNumber, SerialNumber)
Set Conn = CWLStart.CurrentCompany.Connection
If SerialNumber = "" Then
GetWinLineInternalProductNumber = ProductNumber
Else
SQL = "SELECT [c002] FROM [v021] (NOLOCK) WHERE [c011] = '"& ProductNumber &"' AND [c068] = '"& SerialNumber &"' " & SQLQuery_BasicWhere
Set Result = Conn.Select(SQL)
If DEBUG_ON = True Then
AddDebugLine "Querying for Internal Article Number.. " & vbNewline
AddDebugLine "Result Columns: " & Result
AddDebugLine "Result Rows: " & Result.RowCount
AddDebugLine "SQL: " & SQL
ShowDebugBox "GetWinLineInternalProductNumber"
End If
If Result < 0 Then
If err <> 0 Then
Msgbox "Fehler bei Abfrage:" & vbNewline & err.description, vbExclamation, DEFAULT_TITLE & " - GetWinLineInternalProductNumber"
Exit Function
Else
Msgbox "Abfrage lieferte keine Ergebnisse.", vbExclamation, DEFAULT_TITLE & " - GetWinLineInternalProductNumber"
Exit Function
End If
End If
GetWinLineInternalProductNumber = Result.Value("c002")
End If
End Function

3
archive/Modules/Archiv/GetWinLineOriginalLineNumber.vbs
View File

@ -1,10 +1,11 @@
' Version Date: 05.01.2021
Function GetWinLineOriginalLineNumber(OrderNumber, ArticleNumber, IsSerialNumberArticle)
Set Conn = CWLStart.CurrentCompany.Connection
If IsSerialNumberArticle = 1 Then
SQL = "SELECT TOP 1 c078 FROM t026 (NOLOCK) "
SQL = SQL & "WHERE c067 = '"& OrderNumber &"' AND c003 = '"& ArticleNumber &"' "
SQL = SQL & SQLQuery_BasicWhere
SQL = SQL & SQLQuery_OrderWhere
Set Result = Conn.Select(SQL)

35
archive/Modules/Archiv/GetWinLineProductInfoByProductNumber.vbs Normal file
View File

@ -0,0 +1,35 @@
Function GetWinLineProductInfoByProductNumber(ProductNumber, WinLineMandatorNr, WinLineYear)
'Version Date 23.09.2020
On Error Resume Next
If (ProductNumber <> "") Then
SQLTable_WinLineProductInfo = "V021"
SQLQuery_WinLineProductInfo = "c011 = '"& ProductNumber &"' and c002 = c011 and MESOCOMP = '"& WinLineMandatorNr &"' AND MESOYEAR = '"& WinLineCurrentYear &"'"
Set SQLResult_WinLineProductInfo = CWLStart.CurrentCompany.SearchRecord (SQLTable_WinLineProductInfo, SQLQuery_WinLineProductInfo)
If (DEBUG_ON = True) or (DebugMode = "Enabled" ) Then
AddDebugLine "Querying for Article Number.. " & vbNewline
AddDebugLine "Result Columns: " & SQLResult_WinLineProductInfo
AddDebugLine "Result Rows: " & SQLResult_WinLineProductInfo.RowCount
AddDebugLine "SQL: " & SQLQuery_WinLineProductInfo
ShowDebugBox "GetWinLineInternalProductNumber"
End If
If (SQLResult_WinLineProductInfo.RowCount = -1) or (SQLResult_WinLineProductInfo.RowCount = 0) Then
GetWinLineProductInfoByProductNumber = 0
Elseif (SQLResult_WinLineProductInfo.RowCount >= 1) Then
Set GetWinLineProductInfoByProductNumber = SQLResult_WinLineProductInfo
End if
End if
End Function ' GetWinLineProductInfoByProductNumber

23
archive/Modules/Archiv/GetWinLineStockedAmount.vbs Normal file
View File

@ -0,0 +1,23 @@
' Version Date: 13.10.2020
Function GetWinLineStockedAmount(ProductNumber, IncludeSalesDocuments)
' Lagerstand des Artikels prüfen
SQL = ""
SQL = SQL & "SELECT "
SQL = SQL & "(SELECT C008 AS [MengeZugang] from [v021] (NOLOCK) where (c002 = '__ARTICLENUMBER__') "& SQLQuery_BasicWhere &") - "
SQL = SQL & "(SELECT C009 AS [MengeAbgang] from [v021] (NOLOCK) where (c002 = '__ARTICLENUMBER__') "& SQLQuery_BasicWhere &") - "
If IncludeSalesDocuments = True Or IncludeSalesDocuments = "True" Or IncludeSalesDocuments = 1 Then
' Include Products from sales documents
SQL = SQL & "ISNULL((SELECT SUM(C035) AS [MengeVerkauf] FROM [t014] (NOLOCK) where c000 = '__ARTICLENUMBER__' "& SQLQuery_BasicWhere &"), 0) "
Else
' Skip Products from sales documents
SQL = SQL & "(SELECT 0) "
End If
SQL = SQL & "AS c000"
SQL = Replace(SQL, "__ARTICLENUMBER__", ProductNumber)
Set Result = CWLStart.CurrentCompany.Connection.Select(SQL)
GetWinLineStockedAmount = Result.Value("c000")
End Function

61
archive/Modules/Archiv/GetWinLineStorageLocation.vbs
View File

@ -1,3 +1,4 @@
' Version Date: 07.01.2021
Function GetWinLineStorageLocation(ProductNumber, ProductSerialNumber, IsSerialNumberArticle)
Set Conn = CWLStart.CurrentCompany.Connection
@ -10,34 +11,26 @@ Function GetWinLineStorageLocation(ProductNumber, ProductSerialNumber, IsSerialN
GetWinLineStorageLocation = 0
Exit Function
End If
If IsSerialNumberArticle = 1 Then
SQL = ""
SQL = SQL & "SELECT TOP 1 T335.c000 "
SQL = SQL & "FROM [T024] (NOLOCK), [T335] (NOLOCK), [T299] (NOLOCK) "
SQL = SQL & "OUTER APPLY (SELECT C000, C001, C003, C031 FROM T335 (NOLOCK) WHERE C000 = T299.C001 AND T335.MESOCOMP = '" & MandatorNr & "' AND T335.MESOYEAR = " & WinLineCurrentYear & ") L1 "
SQL = SQL & "OUTER APPLY (SELECT C000, C001, C003, C031 FROM T335 (NOLOCK) WHERE C000 = T299.C002 AND T335.MESOCOMP = '" & MandatorNr & "' AND T335.MESOYEAR = " & WinLineCurrentYear & ") L2 "
SQL = SQL & "OUTER APPLY (SELECT C000, C001, C003, C031 FROM T335 (NOLOCK) WHERE C000 = T299.C003 AND T335.MESOCOMP = '" & MandatorNr & "' AND T335.MESOYEAR = " & WinLineCurrentYear & ") L3 "
SQL = SQL & "OUTER APPLY (SELECT C000, C001, C003, C031 FROM T335 (NOLOCK) WHERE C000 = T299.C004 AND T335.MESOCOMP = '" & MandatorNr & "' AND T335.MESOYEAR = " & WinLineCurrentYear & ") L4 "
SQL = SQL & "OUTER APPLY (SELECT C000, C001, C003, C031 FROM T335 (NOLOCK) WHERE C000 = T299.C005 AND T335.MESOCOMP = '" & MandatorNr & "' AND T335.MESOYEAR = " & WinLineCurrentYear & ") L5 "
SQL = SQL & "WHERE T299.C000 = '"& GetWinLineInternalProductNumber(ProductNumber, ProductSerialNumber) &"' AND T299.C000 = T024.C002 AND T299.MESOCOMP = '" & MandatorNr & "' AND T299.MESOYEAR = " & WinLineCurrentYear & " AND T024.MESOCOMP = '" & MandatorNr & "' "
SQL = SQL & "AND T024.MESOYEAR = " & WinLineCurrentYear & " AND T335.MESOCOMP = '" & MandatorNr & "' AND T335.MESOYEAR = " & WinLineCurrentYear & " AND (T299.C001 = T335.C020 AND T299.C002 = T335.C021 "
SQL = SQL & "AND T299.C003 = T335.C022 AND T299.C004 = T335.C023 AND T299.C005 = T335.C024 AND T299.C006 = T335.C025) "
SQL = SQL & "ORDER BY T335.c000 DESC, T299.C001,T299.C002,T299.C003,T299.C004,T299.C005,T299.C006"
Identifier = GetWinLineInternalProductNumber(ProductNumber, ProductSerialNumber)
Else
SQL = ""
SQL = SQL & "SELECT TOP 1 T335.c000 "
SQL = SQL & "FROM T024 (NOLOCK), T335 (NOLOCK), T299 (NOLOCK) "
SQL = SQL & "OUTER APPLY (SELECT C000, C001, C003, C031 FROM T335 (NOLOCK) WHERE C000 = T299.C001 AND T335.MESOCOMP = '" & MandatorNr & "' AND T335.MESOYEAR = " & WinLineCurrentYear & ") L1 "
SQL = SQL & "OUTER APPLY (SELECT C000, C001, C003, C031 FROM T335 (NOLOCK) WHERE C000 = T299.C002 AND T335.MESOCOMP = '" & MandatorNr & "' AND T335.MESOYEAR = " & WinLineCurrentYear & ") L2 "
SQL = SQL & "OUTER APPLY (SELECT C000, C001, C003, C031 FROM T335 (NOLOCK) WHERE C000 = T299.C003 AND T335.MESOCOMP = '" & MandatorNr & "' AND T335.MESOYEAR = " & WinLineCurrentYear & ") L3 "
SQL = SQL & "OUTER APPLY (SELECT C000, C001, C003, C031 FROM T335 (NOLOCK) WHERE C000 = T299.C004 AND T335.MESOCOMP = '" & MandatorNr & "' AND T335.MESOYEAR = " & WinLineCurrentYear & ") L4 "
SQL = SQL & "OUTER APPLY (SELECT C000, C001, C003, C031 FROM T335 (NOLOCK) WHERE C000 = T299.C005 AND T335.MESOCOMP = '" & MandatorNr & "' AND T335.MESOYEAR = " & WinLineCurrentYear & ") L5 "
SQL = SQL & "WHERE T299.C000 = '"& ProductNumber &"' AND T299.C000 = T024.C002 AND T299.MESOCOMP = '" & MandatorNr & "' AND T299.MESOYEAR = " & WinLineCurrentYear & " AND T024.MESOCOMP = '" & MandatorNr & "' "
SQL = SQL & "AND T024.MESOYEAR = " & WinLineCurrentYear & " AND T335.MESOCOMP = '" & MandatorNr & "' AND T335.MESOYEAR = " & WinLineCurrentYear & " AND (T299.C001 = T335.C020 AND T299.C002 = T335.C021 "
SQL = SQL & "AND T299.C003 = T335.C022 AND T299.C004 = T335.C023 AND T299.C005 = T335.C024 AND T299.C006 = T335.C025) "
SQL = SQL & "ORDER BY T335.c000 DESC, T299.C001,T299.C002,T299.C003,T299.C004,T299.C005,T299.C006"
Identifier = ProductNumber
End If
SQL = ""
SQL = SQL & "SELECT TOP 1 T335.c000 "
SQL = SQL & "FROM [T024] (NOLOCK), [T335] (NOLOCK), [T299] (NOLOCK) "
SQL = SQL & "OUTER APPLY (SELECT C000, C001, C003, C031 FROM T335 (NOLOCK) WHERE C000 = T299.C001 AND T335.MESOCOMP = '" & MandatorNr & "' AND (T335.MESOYEAR = " & WinLineCurrentYear & " OR T335.MESOYEAR = " & WinLineCurrentYear - 12 & ")) L1 "
SQL = SQL & "OUTER APPLY (SELECT C000, C001, C003, C031 FROM T335 (NOLOCK) WHERE C000 = T299.C002 AND T335.MESOCOMP = '" & MandatorNr & "' AND (T335.MESOYEAR = " & WinLineCurrentYear & " OR T335.MESOYEAR = " & WinLineCurrentYear - 12 & ")) L2 "
SQL = SQL & "OUTER APPLY (SELECT C000, C001, C003, C031 FROM T335 (NOLOCK) WHERE C000 = T299.C003 AND T335.MESOCOMP = '" & MandatorNr & "' AND (T335.MESOYEAR = " & WinLineCurrentYear & " OR T335.MESOYEAR = " & WinLineCurrentYear - 12 & ")) L3 "
SQL = SQL & "OUTER APPLY (SELECT C000, C001, C003, C031 FROM T335 (NOLOCK) WHERE C000 = T299.C004 AND T335.MESOCOMP = '" & MandatorNr & "' AND (T335.MESOYEAR = " & WinLineCurrentYear & " OR T335.MESOYEAR = " & WinLineCurrentYear - 12 & ")) L4 "
SQL = SQL & "OUTER APPLY (SELECT C000, C001, C003, C031 FROM T335 (NOLOCK) WHERE C000 = T299.C005 AND T335.MESOCOMP = '" & MandatorNr & "' AND (T335.MESOYEAR = " & WinLineCurrentYear & " OR T335.MESOYEAR = " & WinLineCurrentYear - 12 & ")) L5 "
SQL = SQL & "WHERE T299.C000 = '"& Identifier &"' AND T299.C000 = T024.C002 AND T299.MESOCOMP = '" & MandatorNr & "' AND (T299.MESOYEAR = " & WinLineCurrentYear & " OR T299.MESOYEAR = " & WinLineCurrentYear - 12 & ") AND T024.MESOCOMP = '" & MandatorNr & "' "
SQL = SQL & "AND (T024.MESOYEAR = " & WinLineCurrentYear & " OR T024.MESOYEAR = " & WinLineCurrentYear - 12 & ")AND T335.MESOCOMP = '" & MandatorNr & "' AND (T335.MESOYEAR = " & WinLineCurrentYear & " OR T335.MESOYEAR = " & WinLineCurrentYear - 12 & ") AND (T299.C001 = T335.C020 AND T299.C002 = T335.C021 "
SQL = SQL & "AND T299.C003 = T335.C022 AND T299.C004 = T335.C023 AND T299.C005 = T335.C024 AND T299.C006 = T335.C025) "
SQL = SQL & "ORDER BY T335.c000 DESC, T299.C001,T299.C002,T299.C003,T299.C004,T299.C005,T299.C006"
If DEBUG_ON = True Then
AddDebugLine "SQL Part 1: " & Mid(SQL, 1, 750)
@ -60,16 +53,10 @@ Function GetWinLineStorageLocation(ProductNumber, ProductSerialNumber, IsSerialN
ShowDebugBox "GetWinLineStorageLocation"
End If
' If Result < 0 Then
' If err <> 0 Then
' Msgbox "Fehler bei Abfrage:" & vbNewline & err.description, vbExclamation, DEFAULT_TITLE & " - GetWinLineStorageLocation"'
' Exit Function
' Else
' Msgbox "Abfrage lieferte keine Ergebnisse.", vbExclamation, DEFAULT_TITLE & " - GetWinLineStorageLocation"
' Exit Function
' End If
' End If
GetWinLineStorageLocation = Result.Value("c000")
If Result = -1 Then
GetWinLineStorageLocation = 0
Else
GetWinLineStorageLocation = Result.Value("c000")
End If
End Function

292
archive/Modules/Archiv/LoadVBSModule.vbs Normal file
View 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
'------------------------------------------------------------------------------------------------------

19
archive/Modules/Archiv/PrettyPrintXmlString.vbs Normal file
View File

@ -0,0 +1,19 @@
' Version Date: 30.09.2020
' Source: https://stackoverflow.com/questions/25067839/format-xml-string-in-vbscript
Function prettyXml(ByVal sDirty)
' Put whitespace between tags. (Required for XSL transformation.)
sDirty = Replace(sDirty, "><", ">" & vbCrLf & "<")
' Create an XSL stylesheet for transformation.
Dim objXSL : Set objXSL = WScript.CreateObject("Msxml2.DOMDocument")
objXSL.loadXML "<xsl:stylesheet version=""1.0"" xmlns:xsl=""http://www.w3.org/1999/XSL/Transform"">" & _
"<xsl:output method=""xml"" indent=""yes""/>" & _
"<xsl:template match=""/"">" & _
"<xsl:copy-of select="".""/>" & _
"</xsl:template>" & _
"</xsl:stylesheet>"
' Transform the XML.
Dim objXML : Set objXML = WScript.CreateObject("Msxml2.DOMDocument")
objXML.loadXml sDirty
objXML.transformNode objXSL
prettyXml = objXML.xml
End Function

41
archive/Modules/Archiv/RemoveDuplicatesFromArray.vbs Normal file
View File

@ -0,0 +1,41 @@
Function RemoveDuplicatesFromArray(arrItems)
'Source: https://devblogs.microsoft.com/scripting/how-can-i-delete-duplicate-items-from-an-array/
If (Ubound(arrItems) >= 0) Then
If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then
MSGBOX "Array count: " & (Ubound(arrItems)+1),,"DEBUG - Info: BEFORE deduplication!"
End If
Set objDictionary = CreateObject("Scripting.Dictionary")
For Each strItem in arrItems
If Not objDictionary.Exists(strItem) Then
objDictionary.Add strItem, strItem
End If
Next
intItems = objDictionary.Count - 1
ReDim arrItems(intItems)
i = 0
For Each strKey in objDictionary.Keys
arrItems(i) = strKey
i = i + 1
Next
'For Each strItem in arrItems
' msgbox strItem
'Next
If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then
MSGBOX "Array count: " & (Ubound(arrItems)+1),,"DEBUG - Info: AFTER deduplication!"
End If
End If
RemoveDuplicatesFromArray = arrItems
End Function

20
archive/Modules/Archiv/SendHTTPRequest.vbs Normal file
View File

@ -0,0 +1,20 @@
Function SendHTTPRequest(URL)
'Create the array for the return values of this function
Dim HTTPRequest(1)
Set Request = CreateObject("MSXML2.XMLHTTP")
Request.Open "POST", URL, False
Request.Send
HTTPRequest(0) = Request.ResponseText
HTTPRequest(1) = Request.Status
If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then
AddDebugLine "Response from WebServices!"
AddDebugLine "Status: " & HTTPRequest(1)
AddDebugLine "Body: " & HTTPRequest(0)
ShowDebugBox "WebServices"
End If
SendHTTPRequest = HTTPRequest
End Function

9
archive/Modules/Archiv/SetWinLineDocProductStorage.vbs Normal file
View File

@ -0,0 +1,9 @@
Sub ShowWinLineDocForEditing
'Version Date 22.09.2020
'Call "Beleg" Window
End Sub

4
archive/Modules/Archiv/ShowDebugBox.vbs Normal file
View File

@ -0,0 +1,4 @@
Sub ShowDebugBox(Title)
MsgBox DEBUG_MESSAGE, vbOkonly, DEBUG_TITLE & " - " & Title
DEBUG_MESSAGE = ""
End Sub

16
archive/Modules/Archiv/ShowWinLineDocForEditing.vbs Normal file
View File

@ -0,0 +1,16 @@
Sub ShowWinLineDocForEditing
'Version Date 22.09.2020
'Call "Beleg" Window
MChangeGridCell 774, 125, 458753
MGridLeftClick 774, 125, 1, 7
MChangeGridCell 774, 125, 458753
MChangeGridCell 774, 125, 327682
MGridLeftClick 774, 125, 2, 5
MChangeGridCell 774, 125, 458753
MGridLeftClick 774, 125, 1, 7
MPushButton 774, 134, 0
End Sub

34
archive/Modules/Archiv/ShowWinLineDocOverview.vbs Normal file
View File

@ -0,0 +1,34 @@
Sub ShowWinLineDocOverview(DocNumber, AccountNumber, RunningNumber)
'Version Date 22.09.2020
'Call "Beleg" Window
MApplication 2
MWindow 774, false
MTreeExpand 774, 102, 321566992, 100
MTreeSelChange 774, 102, 321566992, 1001
MActivateWindow 774
IF (DocNumber <> "") and (AccountNumber <> "") and (RunningNumber <> "") Then
'Set time periode (12 = alle Jahre)
MSetFieldValue 774, 105, "12"
'Set area (1 = Verkauf/Einkauf)
MSetFieldValue 774, 107, "1"
'Set Account number (Kundennummern)
MSetFieldValue 774, 115, AccountNumber
'Set doc number (Belegnummer)
MSetFieldValue 774, 117, DocNumber
'Set Running Nr (Laufnummer)
MSetFieldValue 774, 191, RunningNumber
'Click the ok Button
MPushButton 774, 98, 0
End If
End Sub

21
archive/Modules/Archiv/ShowWinLineMandatorAndWinLineYear.vbs Normal file
View File

@ -0,0 +1,21 @@
Sub ShowWinLineMandatorAndWinLineYear(WinLineMandatorNr, WinLineYear)
'Version Date 22.09.2020
'Close all Windows
MPushButton 774, 99, 0
IF (WinLineMandatorNr <> "") and (WinLineYear <> "") Then
Dim Year
Year = (WinLineYear / 12) + 1900
'Close all Windows
'MActivateWindow 85
'MPushButton 85, 99, 0
MActivateWindow 774
MPushButton 774, 99, 0
End If
End Sub

12
archive/Modules/Archiv/ShowWinLineProgramMacros.vbs Normal file
View File

@ -0,0 +1,12 @@
Sub ShowWinLineProgramMacros
If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then
'Return to Macro Window
MApplication 2
MApplication 0
MWindow 45, False
MSetFieldFocus 45, 100
MSetFieldFocus 45, -1
MActivateWindow 45
MSetFieldValue 45, 121, CWLMacro.MName
End If
End Sub

12
archive/Modules/Archiv/SwitchWinLineGoToMacros.vbs Normal file
View File

@ -0,0 +1,12 @@
Sub SwitchWinLineGoToMacros
If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then
'Return to Macro Window
MApplication 2
MApplication 0
MWindow 45, False
MSetFieldFocus 45, 100
MSetFieldFocus 45, -1
MActivateWindow 45
MSetFieldValue 45, 121, CWLMacro.MName
End If
End Sub