AppStd/Skriptentwickung
8
0
Fork 0
Code Activity

Anlage des Repos

Browse Source
This commit is contained in:
KammM
2024-01-24 16:42:38 +01:00
commit 38d6a271c4
1785 changed files with 3051496 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

Binary file not shown.

735
current/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
current/Modules/AddDebugLine.vbs Normal file
View File

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

268
current/Modules/Archiv/GetWinLineDocInfoByAccountAndRunningNr.vbs Normal file
View File

@@ -0,0 +1,268 @@
Function GetWinLineDocInfoByAccountAndRunningNr(DocAccountAndRunningNr, PostingType, WinLineDocType)
'Stand 25.08.2020
On Error Resume Next
'Set SQL Table and Query for DocHead. Default: "T025"
SQLTable_DocHead = "[T025]"
SQLQuery_DocHead = "c000 = '" & DocAccountAndRunningNr & "'" & SQLQuery_BasicWhere
'Set SQL Table and Query for DocMid. Default: "T026"
SQLTable_DocMid = "[T026]"
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_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
IF (SQLTable_DocHead <> "") and (SQLQuery_DocHead <> "") and (PostingType <> "") and (WinLineDocType <> "") Then
Set SQLResult_DocHead = CWLStart.CurrentCompany.SearchRecord (SQLTable_DocHead, SQLQuery_DocHead)
If Err.Number <> 0 Then
MSGBOX "Error Code: "& Err.Number & vbCrlf & _
"Error Description: "& Err.Description,,"ERROR: Function GetWinLineDocInfoByAccountAndRunningNr Getting DocHead from DB Table "& SQLTable_DocHead
Err.Clear
Else
'If no line results
If SQLResult_DocHead.RowCount = -1 Then
If DebugMode = "Enabled" Then
MSGBOX "No Rows found, SQL: "& SQLQuery_DocHead,,"DEBUG - Info: Function GetWinLineDocInfoByAccountAndRunningNrDocHead from Database table "& SQLTable_DocHead
End If
Elseif SQLResult_DocHead.RowCount = 1 Then
If DebugMode = "Enabled" Then
MSGBOX "One Row found, SQL: "& SQLQuery_DocHead,,"DEBUG - Info: Function GetWinLineDocInfoByAccountAndRunningNrDocHead from Database table "& SQLTable_DocHead
End If
'Unique Key
DocAccountAndRunningNr = SQLResult_DocHead.value(0)
'Laufnumemr
DocRunningNr = SQLResult_DocHead.value(21)
'Druckstatus Angebot / Anfrage
DocPrintState1 = SQLResult_DocHead.value(22)
'Druckstatus Auftrag / Bestellung
DocPrintState2 = SQLResult_DocHead.value(23)
'Druckstatus Lieferschein
DocPrintState3 = SQLResult_DocHead.value(24)
'Druckstatus Rechnung
DocPrintState4 = SQLResult_DocHead.value(25)
'Number of the Offer ("Angebot")
DocOfferNr = SQLResult_DocHead.value(41)
'Number of the Order ("Angebot")
DocOrderNr = SQLResult_DocHead.value(42)
'Number of delivery note ("Lieferschein")
DocDeliveryNoteNr = SQLResult_DocHead.value(43)
'Number of the Invoice ("Rechung")
DocInvoiceNr = SQLResult_DocHead.value(52)
'When the doc ("Beleg") was created
DocCreated = SQLResult_DocHead.value(56)
'When the doc ("Beleg") was last changed
DocLastChange = SQLResult_DocHead.value(57)
'The ten "Belegkopfnotizen"
DocHeadText1 = SQLResult_DocHead.value(59)
DocHeadText2 = SQLResult_DocHead.value(60)
DocHeadText3 = SQLResult_DocHead.value(61)
DocHeadText4 = SQLResult_DocHead.value(62)
DocHeadText5 = SQLResult_DocHead.value(63)
DocHeadText6 = SQLResult_DocHead.value(64)
DocHeadText7 = SQLResult_DocHead.value(65)
DocHeadText8 = SQLResult_DocHead.value(66)
DocHeadText9 = SQLResult_DocHead.value(67)
DocHeadText10 = SQLResult_DocHead.value(68)
'The current type (1= Anfrage/Angebot; 2= Auftrag/Bestellung; 3= Lieferschein; 4=Rechnung)
DocType = SQLResult_DocHead.value(134)
DocComment = SQLResult_DocHead.value(163)
'msgbox SQLQuery_DocMid_MengeGeliefert
'msgbox SQLQuery_DocMid_RueckstandsMenge
Set SQLResult_DocMid_MengeGeliefert = CWLStart.CurrentCompany.Connection.Select(SQLQuery_DocMid_MengeGeliefert)
'msgbox SQLResult_DocMid_MengeGeliefert.value("MengeGeliefert")
Set SQLResult_DocMid_RueckstandsMenge = CWLStart.CurrentCompany.Connection.Select(SQLQuery_DocMid_RueckstandsMenge)
'msgbox SQLResult_DocMid_RueckstandsMenge.value("RueckstandsMenge")
IF DebugMode = "Enabled" THEN
End if
DocBackOrder = SQLResult_DocMid_RueckstandsMenge.value("RueckstandsMenge")
'msgbox SQLResult_DocMid_Rueckstandsmenge.value("RueckstandsMenge")
IF (PostingType = 1) Then
'If doc = "Angebot" or "Angebots-storno"
IF (WinLineDocType = 1) or (WinLineDocType = 11) then
DocNr = DocOfferNr
IF (WinLineDocType = 1) then
WinLineDocType = "Angebot (debitorisch)"
ElseIF (WinLineDocType = 11) then
WinLineDocType = "Angebot-Storno (debitorisch)"
End If
'If doc = "Auftrag" or "Auftrag-storno"
ElseIf (WinLineDocType = 2) or (WinLineDocType = 12) then
DocNr = DocOrderNr
IF (WinLineDocType = 2) then
WinLineDocType = "Auftrag (debitorisch)"
ElseIF (WinLineDocType = 12) then
WinLineDocType = "Auftrag-Storno (debitorisch)"
End If
'If doc = "Lieferschein" or "Lieferschein-storno" or "Teillieferschein"
ElseIf (WinLineDocType = 3) or (WinLineDocType = 13) or (WinLineDocType = -3) then
DocNr = DocDeliveryNoteNr
IF (DocBackOrder = 0) and (DocPrintState3 <> "L") then
WinLineDocType = "Lieferschein (debitorisch)"
ElseIF (DocBackOrder = 0) and (DocPrintState3 = "L") then
WinLineDocType = "Lieferschein-Storno (debitorisch)"
ElseIF (DocBackOrder <> 0) and (DocPrintState3 <> "L") then
WinLineDocType = "Teillieferschein (debitorisch)"
ElseIF (DocBackOrder <> 0) and (DocPrintState3 = "L") then
'Über die DB Werte ist eine Unterscheidung zwischen Lieferschein und Teillieferschein Storno nicht möglich!
WinLineDocType = "Teillieferschein-Storno (debitorisch)"
End If
'If doc = "Rechnung" or "Rechnungs-storno"
ElseIf (WinLineDocType = 4) or (WinLineDocType = 14) then
DocNr = DocInvoiceNr
IF (WinLineDocType = 4) and (DocPrintState4 <> "L") then
WinLineDocType = "Rechnung (debitorisch)"
ElseIF (WinLineDocType = 4) and (DocPrintState4 = "L") then
WinLineDocType = "Rechnung-Storno (debitorisch)"
ElseIF (WinLineDocType = 14) and (DocPrintState4 = "L") then
WinLineDocType = "Rechnung-Storno (debitorisch)"
End If
Else
IF DebugMode = "Enabled" THEN
MSGBOX "WinLineDocType is not configured!" & vbCrLf & _
"WinLineDocType: " & WinLineDocType, , "DEBUG - Info: Export Metadata"
END IF
End if
ElseIf (PostingType = 2) Then
'not implement
End if
'Array for the function to return
DIM DocInfo(250)
'Items like T25 c000 to c188
DocInfo(59) = DocCreated
DocInfo(60) = DocLastChange
DocInfo(63) = DocHeadText1
DocInfo(64) = DocHeadText2
DocInfo(65) = DocHeadText3
DocInfo(66) = DocHeadText4
DocInfo(67) = DocHeadText5
DocInfo(68) = DocHeadText6
DocInfo(69) = DocHeadText7
DocInfo(70) = DocHeadText8
DocInfo(71) = DocHeadText9
DocInfo(72) = DocHeadText10
DocInfo(139) = DocType
DocInfo(165) = DocComment
'Items beyond T25
DocInfo(200) = WinLineDocType
DocInfo(201) = DocNr
IF DebugMode = "Enabled" THEN
CRLF = chr(13)&chr(10)
msg = "Parameter:" & CRLF
For i = 0 To Ubound(DocInfo)
If (DocInfo(i) <> "") then
msg = msg & i & ".: " & DocInfo(i) & CRLF
end if
Next
msgbox msg ,, "Macro Name: " & CWLMacro.MName
End if
GetWinLineDocInfoByAccountAndRunningNr = DocInfo
Else
If DebugMode = "Enabled" Then
MSGBOX "To many Rows found, SQL: "& SQLQuery_DocHead,,"DEBUG - Info: Function GetWinLineDocInfoByAccountAndRunningNr DocHead from Database table "& SQLTable_DocHead
End If
GetWinLineDocInfoByAccountAndRunningNr = ""
End If
End If
Else
If DebugMode = "Enabled" Then
MSGBOX "Missing Parameter values, SQL: "& SQLQuery_DocHead,,"DEBUG - Info: Function GetWinLineDocInfoByAccountAndRunningNrDocHead from Database table " & SQLTable_DocHead
End If
GetWinLineDocInfoByAccountAndRunningNr = ""
End If
End Function

41
current/Modules/Archiv/GetWinLineOriginalLineNumber.vbs Normal file
View File

@@ -0,0 +1,41 @@
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
Set Result = Conn.Select(SQL)
If DEBUG_ON = True Then
AddDebugLine "Querying for Original Line Number.. " & vbNewline
AddDebugLine "Result Columns: " & Result
AddDebugLine "Result Rows: " & Result.RowCount
AddDebugLine "SQL: " & SQL
ShowDebugBox "GetWinLineOriginalLineNumber"
End If
If Result < 0 Then
If err <> 0 Then
Msgbox "Fehler bei Abfrage:" & vbNewline & err.description, vbExclamation, DEFAULT_TITLE & " - GetWinLineOriginalLineNumber"
Exit Function
Else
Msgbox "Abfrage lieferte keine Ergebnisse.", vbExclamation, DEFAULT_TITLE & " - GetWinLineOriginalLineNumber"
Exit Function
End If
End If
GetWinLineOriginalLineNumber = Result.Value("c078")
Else
If DEBUG_ON = True Then
AddDebugLine "Setting Original Line Number to 0.."
ShowDebugBox "GetWinLineOriginalLineNumber"
End If
GetWinLineOriginalLineNumber = "0"
End If
End Function

75
current/Modules/Archiv/GetWinLineStorageLocation.vbs Normal file
View File

@@ -0,0 +1,75 @@
Function GetWinLineStorageLocation(ProductNumber, ProductSerialNumber, IsSerialNumberArticle)
Set Conn = CWLStart.CurrentCompany.Connection
' Get 'Lagerortstruktur' for Product
SQL = "SELECT c178 FROM [V021] (NOLOCK) WHERE c010 = '"& ProductNumber &"'"
Set Result = Conn.Select(SQL)
If Result.Value("c178") = 0 Then
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"
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"
End If
If DEBUG_ON = True Then
AddDebugLine "SQL Part 1: " & Mid(SQL, 1, 750)
ShowDebugBox "GetWinLineStorageLocation"
AddDebugLine "SQL Part 2: " & Mid(SQL, 750)
ShowDebugBox "GetWinLineStorageLocation"
End If
Set Result = Conn.Select(SQL)
If DEBUG_ON = True Then
AddDebugLine "Querying storage location... " & vbNewline
AddDebugLine "ArticleNumber: " & ProductNumber
AddDebugLine "SerialNumber: " & ProductSerialNumber
AddDebugLine "IsSerialNumber Article: " & IsSerialNumberArticle
AddDebugLine "Result Columns: " & Result
AddDebugLine "Result Rows: " & Result.RowCount
AddDebugLine "SQL: " & SQL
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")
End Function

BIN
current/Modules/Archiv/Load-PowerShellModule.ps1 Normal file
View File

Binary file not shown.

194
current/Modules/Archiv/LoadVBSModule/1.3.0.1/LoadVBSModule.vbs Normal file
View File

@@ -0,0 +1,194 @@
'Function to load VBS modules
Public Function LoadVBSModule(VBSModuleParams)
'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
'"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.3.0.1 / Date: 29.08.2020
'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
'Building full module path and name
ModuleFullName = ModulePath & "\" & Modulename & ".vbs"
'does the file exist?
If Not FSOModule.FileExists(ModuleFullName) Then
If Err.Number <> 0 Then
MSGBOX "Error Code: "& Err.Number & vbCrlf & _
"Error Description: "& Err.Description,,"ERROR: Module does not exist! "
Err.Clear
LoadVBSModule = "False"
End If
Else
'Open file
Set Module = FSOModule.OpenTextFile(ModuleFullName, 1)
'Get file content
ModuleCode = Module.ReadAll
'Close file handle
Module.Close
'Execute the file content
ExecuteGlobal ModuleCode
If Err.Number <> 0 Then
MSGBOX "Error Code: "& Err.Number & vbCrlf & _
"Error Description: "& Err.Description,,"ERROR: Module cannot be loaded!"
Err.Clear
LoadVBSModule = "False"
Else
LoadVBSModule = "True"
End If
End If
End If
End Function 'LoadVBSModule
'------------------------------------ EXAMPLE TO CALL THE FUNCTION ------------------------------------
'Prepare Array (Arrays are zero based!)
Modules = Array("TestModule1","TestModule2","TestModule3")
Dim Module
'Load external Modules.
For Each Module In Modules
'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
Next 'end for each
TestModule1
TestModule2
TestModule3
'------------------------------------------------------------------------------------------------------

227
current/Modules/Archiv/LoadVBSModule/1.5.0.2/LoadVBSModule.vbs Normal file
View File

@@ -0,0 +1,227 @@
'Function to load VBS modules
Public Function LoadVBSModule(VBSModuleParams)
'SYNOPSIS
'Function will load external - additional - VBS Modules (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.5.0.2 / Date: 17.06.2021
'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 & ".vbm")) Then
'Building full module path and name
ModuleFullName = ModulePath & "\" & Modulename & ".vbm"
'does the file exist?
Elseif FSOModule.FileExists((ModulePath & "\" & Modulename & ".vbs")) Then
'Building full module path and name
ModuleFullName = ModulePath & "\" & Modulename & ".vbs"
Else
'Otherwise set empty string 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
Set Module = FSOModule.OpenTextFile(ModuleFullName, 1)
ModuleCode = Module.ReadAll
Module.Close
Else
Module.CharSet = "utf-8"
Module.Open
Module.LoadFromFile(ModuleFullName)
ModuleCode = Module.ReadText()
Module.Close
End If
Set Module = Nothing
'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
'------------------------------------ EXAMPLE TO CALL THE FUNCTION ------------------------------------
''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
'------------------------------------------------------------------------------------------------------

135
current/Modules/Archiv/Packtisch/ArticleExists.vbs Normal file
View File

@@ -0,0 +1,135 @@
' ArticleExists(Identifier: String)
' ---------------------------------------------------------
' Findet Artikelnummer anhand von versch. Kriterien
' - Artikel-Nummer, Alternative Artikel-Nummer, EAN-Code, Seriennummer
' - Gibt die Zeile im Grid zurück in der Artikel das erste Mal gefunden wurde
'
' Rückgabewert: ArticleRow: Int
' ---------------------------------------------------------
Const ARTICLE_EXISTS_NO_STOCK = -99
Const ARTICLE_EXISTS_NO_SERIALNUMBER = -98
Const ARTICLE_EXISTS_NO_ARTICLE_EAN = -97
Function ArticleExists(Identifier)
ArticleExists = 0
CURRENT_SERIALNUMBER = ""
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
' ===================== ARTIKEL NUMMER / EAN-CODE =====================
SQL = ""
' Artikelnummer / EAN-Code / Alternative Artikelnummer
SQL = SQL & "((C002 = '" & Identifier & "') Or (C075 = '" & Identifier & "') Or (C114 = '" & Identifier & "')) AND "
' Artikel darf nicht inaktiv sein
SQL = SQL & "(c038 IS NULL) "
' Nach Mandant und Wirtschaftsjahr filtern
SQL = SQL & SQLQuery_BasicWhere
Set ResultArtikel = CWLStart.CurrentCompany.SearchRecord(TABLE_21, SQL)
If DEBUG_ON = True Then
AddDebugLine "Searching for Article by ArticleNo/EAN-Code.. " & vbNewline & vbNewline
AddDebugLine "Result Columns: " & ResultArtikel & vbNewline
AddDebugLine "Result Rows: " & ResultArtikel.RowCount & vbNewline
AddDebugLine "SQL: " & SQL
ShowDebugBox "ArticleExists"
End If
' ===================== SERIENNUMMER =====================
SQL = ""
' Artikelnummer
SQL = SQL & "(C068 = '" & Identifier & "') AND "
' Artikel darf nicht inaktiv sein
SQL = SQL & "(c038 IS NULL) "
' Nach Mandant und Wirtschaftsjahr filtern
SQL = SQL & SQLQuery_BasicWhere
Set ResultSeriennummer = CWLStart.CurrentCompany.SearchRecord(TABLE_21, SQL)
If DEBUG_ON = True Then
AddDebugLine "Searching for Article by Article serial number " & vbNewline & vbNewline
AddDebugLine "Result Columns: " & ResultSeriennummer & vbNewline
AddDebugLine "Result Rows: " & ResultSeriennummer.RowCount & vbNewline
AddDebugLine "SQL: " & SQL
ShowDebugBox "ArticleExists"
End If
If ResultSeriennummer.RowCount > 0 Then
CURRENT_SERIALNUMBER = Identifier
Set Result = ResultSeriennummer
Else
Set Result = ResultArtikel
End If
'==========================================================
If Result.RowCount > 0 Then
' Wir brauchen die Hauptartikelnummer, weil die Prüfung sonst bei SN-Artikeln fehlschlägt
MainArticleNumber = Result.Value("C011")
RealArticleNumber = Result.Value("C002")
' Lagerstand des Artikels prüfen
SQL = ""
SQL = SQL & "SELECT "
SQL = SQL & "(SELECT C008 AS [MengeZugang] from [v021] (NOLOCK) where (c011 = '__ARTICLENUMBER__' OR c002 = '__ARTICLENUMBER__') "& SQLQuery_BasicWhere &") - "
SQL = SQL & "(SELECT C009 AS [MengeAbgang] from [v021] (NOLOCK) where (c011 = '__ARTICLENUMBER__' OR c002 = '__ARTICLENUMBER__') "& SQLQuery_BasicWhere &") - "
SQL = SQL & "ISNULL((SELECT SUM(C035) AS [MengeVerkauf] FROM [t014] (NOLOCK) where c000 = '__ARTICLENUMBER__' "& SQLQuery_BasicWhere &"), 0) AS c000"
SQL = Replace(SQL, "__ARTICLENUMBER__", RealArticleNumber)
Set Result = CWLStart.CurrentCompany.Connection.Select(SQL)
AmountStocked = Result.Value("c000")
If DEBUG_ON = True Then
AddDebugLine "Checking stock of product: " & RealArticleNumber & " (" & MainArticleNumber & ")" & vbNewline & vbNewline
AddDebugLine "Result Columns: " & Result & vbNewline
AddDebugLine "Result Rows: " & Result.RowCount & vbNewline
AddDebugLine "Stock: " & AmountStocked & vbNewLine
AddDebugLine "SQL: " & SQL
ShowDebugBox "ArticleExists"
End If
If AmountStocked > 0 Then
If DEBUG_ON = True Then
AddDebugLine "Amount stocked: " & AmountStocked
ShowDebugBox "ArticleExists"
End If
' Vorkommen in Tabelle prüfen
For Row = 1 To Grid.LineCount
CurrentArticleNumber = Grid.GetCellValue(Row, COLUMN_ARTICLENUMBER)
Total = Cint(Grid.GetCellValue(Row, COLUMN_TOTAL))
Scanned = Cint(Grid.GetCellValue(Row, COLUMN_SCANNED))
If CurrentArticleNumber = MainArticleNumber Then
If DEBUG_ON = True Then
AddDebugLine "CurrentArticleNumber matches MainArticleNumber! (" & CurrentArticleNumber & ")"
ShowDebugBox "ArticleExists"
End If
If Total > Scanned Then
If DEBUG_ON = True Then
AddDebugLine "Product is not yet scanned completetly and exists in Row " & Row & "!"
ShowDebugBox "ArticleExists"
End If
ArticleExists = Row
Exit For
End If
End If
Next
Else
ArticleExists = ARTICLE_EXISTS_NO_STOCK
End If
Else
If CURRENT_SERIALNUMBER = "" Then
ArticleExists = ARTICLE_EXISTS_NO_ARTICLE_EAN
Else
ArticleExists = ARTICLE_EXISTS_NO_SERIALNUMBER
End If
End If
End Function

199
current/Modules/Archiv/Packtisch/CompleteOrder.vbs Normal file
View File

@@ -0,0 +1,199 @@
' CompleteOrder()
' ---------------------------------------------------------
' Schließt die Prüfung ab und erstellt einen Lieferschein
'
' Rückgabewert: Keiner
' ---------------------------------------------------------
Sub CompleteOrder()
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Conn = CWLStart.CurrentCompany.Connection
Set Grid = mywin.Controls.Item(GRID_ID).Grid
Dim OrderId, AccountSQL, MandatorId, RunningNumber
OrderId = mywin.Controls.Item(ORDER_INPUT).ScreenContents
AccountSQL = "SELECT DISTINCT c021 FROM t025 (NOLOCK) WHERE c044 = '" & OrderId & "' " & SQLQuery_BasicWhere
Set AccountResult = Connection.Select(AccountSQL)
If DEBUG_ON = True Then
AddDebugLine "Querying for CustomerAccountId.. " & vbNewline
AddDebugLine "Result Columns: " & AccountResult
AddDebugLine "Result Rows: " & AccountResult.RowCount
AddDebugLine "SQL: " & AccountSQL
ShowDebugBox "CompleteOrder"
End If
MandatorId = AccountResult.Value("c021")
RunningNumber = RUNNING_NUMBER_PREFIX & OrderId
BelegKey = Cstr(DateDiff("s", "01/01/1970 00:00:00", Now))
' ===================== KOPFDATEN =====================
HeadSQL = "INSERT INTO " & SQLDB_for_EXIM & "." & SQLHeadTB_for_EXIM & " "
HeadSQL = HeadSQL & "(BELEGKEY, Kontonummer, Laufnummer, Auftragsnummer, Datum_Lieferschein) "
HeadSQL = HeadSQL & "VALUES("& BelegKey &", '"& MandatorId &"', '"& RunningNumber &"', '"& OrderId &"', GETDATE())"
HeadResult = Conn.ExecuteSQL(HeadSQL)
If DEBUG_ON = True Then
AddDebugLine "Inserting Head Data" & vbNewline
AddDebugLine "Result: " & HeadResult
AddDebugLine "SQL: " & HeadSQL
ShowDebugBox "CompleteOrder"
End If
' ===================== ENDE KOPFDATEN =====================
' ===================== MITTEDATEN =====================
Dim ArticleNumber, AmountDelivered, SerialNumber, StorageLocation, LineNumber
For Row = 1 To Grid.LineCount
IsSerialNumberArticle = Grid.GetCellValue(Row, COLUMN_TYPE)
ArticleNumber = Grid.GetCellValue(Row, COLUMN_ARTICLENUMBER)
SerialNumber = Grid.GetCellValue(Row, COLUMN_SERIALNUMBER)
LineNumber = GetWinLineOriginalLineNumber(OrderId, ArticleNumber, IsSerialNumberArticle)
StorageLocation = GetWinLineStorageLocation(ArticleNumber, SerialNumber, IsSerialNumberArticle)
AmountDelivered = Grid.GetCellValue(Row, COLUMN_SCANNED)
If IsSerialNumberArticle = 1 Then
MidSQL = "INSERT INTO " & SQLDB_for_EXIM & "." & SQLMiddleTB_for_EXIM & " "
MidSQL = MidSQL & "(BELEGKEY, Artikelnummer, Hauptartikelnummer, Zeilennummer, Datentyp, Mengegeliefert, ChargeIdentnummer, Lagerort) "
MidSQL = MidSQL & "VALUES("& BelegKey &", '"& ArticleNumber &"', '"& ArticleNumber &"', "& LineNumber &", '1', "& AmountDelivered &", '"& SerialNumber &"', "& StorageLocation &")"
Else
MidSQL = "INSERT INTO " & SQLDB_for_EXIM & "." & SQLMiddleTB_for_EXIM & " "
MidSQL = MidSQL & "(BELEGKEY, Artikelnummer, Hauptartikelnummer, Zeilennummer, Datentyp, Mengegeliefert, ChargeIdentnummer, Lagerort) "
MidSQL = MidSQL & "VALUES("& BelegKey &", '"& ArticleNumber &"', '"& ArticleNumber &"', NULL, '1', "& AmountDelivered &", '"& SerialNumber &"', "& StorageLocation &")"
End If
MidResult = Conn.ExecuteSQL(MidSQL)
If DEBUG_ON = True Then
AddDebugLine "Inserting Middle Data" & vbNewline
AddDebugLine "Result: " & MidResult
AddDebugLine "SQL: " & MidSQL
ShowDebugBox "CompleteOrder"
End If
Next
' ===================== ENDE MITTEDATEN =====================
' ============================ XML ============================
Dim Request, URL, XML
Dim DObj : DObj = Now
Dim DateString : DateString = Year(DObj) & "-" & GetLeftPad(Month(DObj)) & "-" & GetLeftPad(Day(DObj))
XML = ""
XML = XML & "<?xml version=""1.0"" encoding=""UTF-8""?>"
XML = XML & "<MESOWebService TemplateType=""__TYPE__"" Template=""__VORLAGE__"" option=""__OPTION__"" printVoucher=""__PRINT__"">"
' Kopf
XML = XML & "<__VORLAGE__T025>"
XML = XML & "<BELEGKEY>" & BelegKey & "</BELEGKEY>"
XML = XML & "<Kontonummer>" & MandatorId & "</Kontonummer>"
XML = XML & "<Laufnummer>" & RunningNumber & "</Laufnummer>"
XML = XML & "<Auftragsnummer>" & OrderId & "</Auftragsnummer>"
XML = XML & "<Datum_Lieferschein>" & DateString & "</Datum_Lieferschein>"
XML = XML & "</__VORLAGE__T025>"
For Row = 1 To Grid.LineCount
ArticleNumber = Grid.GetCellValue(Row, COLUMN_ARTICLENUMBER)
SerialNumber = Grid.GetCellValue(Row, COLUMN_SERIALNUMBER)
LineNumber = GetWinLineOriginalLineNumber(OrderId, ArticleNumber, IsSerialNumberArticle)
StorageLocation = GetWinLineStorageLocation(ArticleNumber, SerialNumber, IsSerialNumberArticle)
AmountDelivered = Grid.GetCellValue(Row, COLUMN_SCANNED)
InternalArticleNumber = GetWinLineInternalProductNumber(ArticleNumber, SerialNumber)
' Mitte
MidXML = ""
MidXML = MidXML & "<__VORLAGE__T026>"
MidXML = MidXML & "<BELEGKEY>" & BelegKey & "</BELEGKEY>"
MidXML = MidXML & "<Artikelnummer>" & InternalArticleNumber & "</Artikelnummer>"
MidXML = MidXML & "<Hauptartikelnummer>" & ArticleNumber & "</Hauptartikelnummer>"
MidXML = MidXML & "<Zeilennummer>" & LineNumber & "</Zeilennummer>"
MidXML = MidXML & "<Datentyp>" & "1" & "</Datentyp>"
MidXML = MidXML & "<Mengegeliefert>" & AmountDelivered & "</Mengegeliefert>"
MidXML = MidXML & "<ChargeIdentnummer>" & SerialNumber & "</ChargeIdentnummer>"
MidXML = MidXML & "<Lagerort>" & StorageLocation & "</Lagerort>"
MidXML = MidXML & "</__VORLAGE__T026>"
If DEBUG_ON = True Then
AddDebugLine "Adding Product Row to XML:" & vbNewLine
AddDebugLine MidXML
ShowDebugBox "CompleteOrder"
End If
XML = XML & MidXML
Next
XML = XML & "</MESOWebService>"
XML = Replace(XML, "__VORLAGE__", WEB_VORLAGE)
XML = Replace(XML, "__TYPE__", WEB_TYPE)
XML = Replace(XML, "__OPTION__", WEB_OPTION)
XML = Replace(XML, "__PRINT__", WEB_PRINT)
URL = "http://__SERVER__/ewlservice/import?User=__USER__&Password=__PASSWORD__&Company=__COMPANY__&Type=30&Vorlage=__VORLAGE__&Actioncode=__ACTIONCODE__&byref=0&Data=__DATA__"
URL = Replace(URL, "__SERVER__", WEB_SERVER)
URL = Replace(URL, "__USER__", WEB_USER)
URL = Replace(URL, "__PASSWORD__", WEB_PASS)
URL = Replace(URL, "__COMPANY__", WEB_COMPANY)
URL = Replace(URL, "__VORLAGE__", WEB_VORLAGE)
URL = Replace(URL, "__ACTIONCODE__", WEB_ACTIONCODE)
URL = Replace(URL, "__DATA__", XML)
If DEBUG_ON = True Then
AddDebugLine "Sending Request to WebServices.."
AddDebugLine "URL: " & URL
ShowDebugBox "CompleteOrder"
End If
' ======================= ENDE XML =======================
' ===================== HTTP REQUEST =====================
Set Request = CreateObject("MSXML2.XMLHTTP")
Request.Open "POST", URL, False
Request.Send
Response = Request.ResponseText
Status = Request.Status
If DEBUG_ON = True Then
AddDebugLine "Response from WebServices!"
AddDebugLine "Status: " & Status
AddDebugLine "Body: " & Response
ShowDebugBox "CompleteOrder"
End If
' =================== ENDE HTTP REQUEST ==================
Error = False
Message = ""
If Status = 200 Then
If InStr(Response, "<OverallSuccess>true</OverallSuccess>") > 0 Then
Message = "Lieferschein wurde übertragen!"
Else
Error = True
Message = "Lieferschein wurde nicht übertragen! Fehlerdetails: " & vbNewline & vbNewline & Response
End If
Else
Error = True
Message = "Fehler beim Zugriff auf Webservices aufgetreten" & vbNewline & "Status: " & Status
End If
If Error = False Then
MsgBox Message, vbInformation, DEFAULT_TITLE & " - Abschluss erfolgreich"
MacroCommands.MSetFieldFocus WINDOW_ID, ORDER_INPUT
Else
MsgBox Message, vbExclamation, DEFAULT_TITLE & " - Fehler bei Abschluss"
End If
End Sub

47
current/Modules/Archiv/Packtisch/IsOrderAvailable.vbs Normal file
View File

@@ -0,0 +1,47 @@
' IsOrderAvailable()
' ---------------------------------------------------------
' Überprüft, ob Auftrag noch (teilweise) offen ist
'
' Rückgabewert: OrderAvailable: Boolean
' ---------------------------------------------------------
Function IsOrderAvailable(OrderNumber)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
IsOrderAvailable = False
SQL = ""
SQL = SQL & "(c044 = '"& OrderNumber &"')"
SQL = SQL & "AND (c025 IN ('M', 'A', 'S'))"
SQL = SQL & SQLQuery_BasicWhere
Set Result = CWLStart.CurrentCompany.SearchRecord(TABLE_25, SQL)
If DEBUG_ON = True Then
MsgBox "SQL: ... FROM "& TABLE_25 & " WHERE " & SQL, vbOkonly, DEBUG_TITLE
AddDebugLine "Checking For Order by OrderId.." & vbNewline & vbNewline
AddDebugLine "Result Columns: " & Result & vbNewline
AddDebugLine "Result Rows: " & Result.RowCount & vbNewline
AddDebugLine "SQL: " & SQL
ShowDebugBox "IsOrderAvailable"
End If
If Result < 0 Then
If err <> 0 Then
Msgbox "Fehler bei Abfrage:" & vbNewline & err.description, vbExclamation, DEFAULT_TITLE & " - IsOrderAvailable"
Exit Function
Else
Msgbox "Der Auftrag " & _
OrderNumber & _
" wurde bereits vollständig erledigt oder als abgeschlossen markiert!", _
vbExclamation, DEFAULT_TITLE & " - IsOrderAvailable"
Exit Function
End If
End If
If Result.RowCount > 0 Then
IsOrderAvailable = True
End If
End Function

22
current/Modules/Archiv/Packtisch/IsOrderComplete.vbs Normal file
View File

@@ -0,0 +1,22 @@
' IsOrderComplete()
' ---------------------------------------------------------
' Überprüft, ob alle Zeilen vollständig gescannt wurden
'
' Rückgabewert: OrderComplete: Boolean
' ---------------------------------------------------------
Function IsOrderComplete()
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
IsOrderComplete = True
For Row = 1 To Grid.LineCount
Total = Cint(Grid.GetCellValue(Row, COLUMN_TOTAL))
Scanned = Cint(Grid.GetCellValue(Row, COLUMN_SCANNED))
If Scanned < Total Then
IsOrderComplete = False
Exit For
End If
Next
End Function

111
current/Modules/Archiv/Packtisch/LoadOrder.vbs Normal file
View File

@@ -0,0 +1,111 @@
' LoadOrder(OrderNumber: String)
' ---------------------------------------------------------
' Sucht Belegzeilen zur angegebenen Belegnummer
' - Filtert Artikel der Gruppe 100 aus
' - Lädt Ergebnisse in eine Tabelle auf dem Formular
' - Erzeugt N Zeilen für Seriennummer-Artikel der Menge N
'
' Rückgabewert: LoadSuccessful: Boolean
' ---------------------------------------------------------
Function LoadOrder(OrderNumber)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
' ARTIKEL FILTERN
SQL = ""
' Nach eingescannter Auftragsnummer/Belegnummer filtern
SQL = SQL & "(c067 = '"& OrderNumber &"') "
' Versandkosten (Art.Gruppe 100) rausfiltern
SQL = SQL & "and c012 NOT IN (100) "
' Nur Artikel aus offenen Belegen anzeigen
SQL = SQL & "and c031 = c112"
' Nach Mandant und Wirtschaftsjahr filtern
SQL = SQL & SQLQuery_BasicWhere
Set Result = CWLStart.CurrentCompany.SearchRecord (TABLE_26, SQL)
If DEBUG_ON = True Then
MsgBox "SQL: ... FROM "& TABLE_26 & " WHERE " & SQL, vbOkonly, DEBUG_TITLE
AddDebugLine "Searching For Order by OrderId.." & vbNewline & vbNewline
AddDebugLine "Result Columns: " & Result & vbNewline
AddDebugLine "Result Rows: " & Result.RowCount & vbNewline
AddDebugLine "SQL: " & SQL
ShowDebugBox "LoadOrder"
End If
If Result < 0 Then
If err <> 0 Then
Msgbox "Fehler bei Abfrage:" & vbNewline & err.description, vbExclamation, DEFAULT_TITLE & " - LoadOrder"
Exit Function
Else
Msgbox "Abfrage lieferte keine Ergebnisse.", vbExclamation, DEFAULT_TITLE & " - LoadOrder"
Exit Function
End If
End If
Grid.InitUserGrid
Grid.Header
Grid.Clear(1002)
Grid.IsRedraw = False
If Result.RowCount > 0 Then
LineCounter = 1
' Speicher für benutzerdefinierte Felder
' (495,0) - Menge Gescannt
' (495,1) - Menge Gesamt
' (495,2) - Seriennummer
' (495,3) - Artikelnummer
' (495,4) - Bezeichnung
Do
' Zeilen hochzählen
Amount = Cint(Result.Value("c005"))
ChargeFlag = Cint(Result.Value("c055"))
If ChargeFlag = 2 Then
For index = 1 To Amount
CWLCurrentWindow.ActiveWindow.Vars.Value(495,0) = 1
CWLCurrentWindow.ActiveWindow.Vars.Value(495,1) = 0
CWLCurrentWindow.ActiveWindow.Vars.Value(495,2) = ""
CWLCurrentWindow.ActiveWindow.Vars.Value(495,3) = Result.Value("c003")
CWLCurrentWindow.ActiveWindow.Vars.Value(495,4) = Result.Value("c004")
CWLCurrentWindow.ActiveWindow.Vars.Value(495,5) = 1
Grid.AddLine
' Zeilenfarbe mit ROT vorbelegen
Grid.SetLineColor LineCounter, COLOR_RED
LineCounter = LineCounter + 1
Next
Else
CWLCurrentWindow.ActiveWindow.Vars.Value(495,0) = Cint(Result.Value("c005"))
CWLCurrentWindow.ActiveWindow.Vars.Value(495,1) = 0
CWLCurrentWindow.ActiveWindow.Vars.Value(495,2) = ""
CWLCurrentWindow.ActiveWindow.Vars.Value(495,3) = Result.Value("c003")
CWLCurrentWindow.ActiveWindow.Vars.Value(495,4) = Result.Value("c004")
CWLCurrentWindow.ActiveWindow.Vars.Value(495,5) = 0
' Ergebnisse aus SQL in Zeile schreiben
Grid.AddLine
' Zeilenfarbe mit ROT vorbelegen
Grid.SetLineColor LineCounter, COLOR_RED
LineCounter = LineCounter + 1
End If
If Result.NextRecord = False Then
Exit Do
End If
Loop
LoadOrder = True
Else
MsgBox "Auftrag wurde bereits bearbeitet oder existiert nicht", vbExclamation, DEFAULT_TITLE
LoadOrder = False
End If
Grid.IsRedraw = True
End Function

20
current/Modules/Archiv/Packtisch/SerialNumberExists.vbs Normal file
View File

@@ -0,0 +1,20 @@
Function SerialNumberExists(SerialNumber)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
SerialNumberExists = False
If DEBUG_ON = True Then
AddDebugLine "Checking existence of SerialNumber: " & SerialNumber
ShowDebugBox "SerialNumberExists"
End If
For Row = 1 To Grid.LineCount
CurrentSerialNumber = Grid.GetCellValue(Row, COLUMN_SERIALNUMBER)
If SerialNumber = CurrentSerialNumber Then
SerialNumberExists = True
Exit For
End If
Next
End Function

18
current/Modules/Archiv/Packtisch/SetAmount.vbs Normal file
View File

@@ -0,0 +1,18 @@
' SetAmount(Amount: Integer)
' ---------------------------------------------------------
' Setzt eigegeben Menge in das Mengenfeld
' - Überschreibt Menge beim ersten Eintrag, danach
' wird die Zahl angehängt
'
' Rückgabewert: Keiner
' ---------------------------------------------------------
Sub SetAmount(Amount)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set amountBox = mywin.Controls.Item(AMOUNT_INPUT)
If amountBox.Contents = AMOUNT_PLACEHOLDER Then
amountBox.Contents = Cstr(Amount)
Else
amountBox.Contents = amountBox.Contents & Cstr(Amount)
End If
End Sub

39
current/Modules/Archiv/Packtisch/SetupWindow.vbs Normal file
View File

@@ -0,0 +1,39 @@
Sub SetupWindow()
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
' Speicher für benutzerdefinierte Felder
' (495,0) - Menge Gescannt
' (495,1) - Menge Gesamt
' (495,2) - Seriennummer
' (495,3) - Artikelnummer
' (495,4) - Bezeichnung
' (495,5) - Chargen-/Identflag
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 0, "2", 10
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 1, "2", 10
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 2, "1", 20
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 3, "1", 20
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 4, "1", 60
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 5, "2", 3
Grid.InitUserGrid
Grid.IsRedraw = False
Grid.Header
If COLUMNS_CREATED = False Then
COLUMN_ARTICLENUMBER = Grid.AddColumn("Artikelnummer", "T21,Artikelnummer", "1","V",0,495,3,20,scrtflag+sizeflag+hideflag)
COLUMN_DESCRIPTION = Grid.AddColumn("Bezeichnung", "T21,Bezeichnung", "1","V",0,495,4,30,scrtflag+sizeflag+hideflag)
COLUMN_TOTAL = Grid.AddColumn("Gesamt", "T22,Gesamt", "1","V",0,495,0,10,scrtflag+sizeflag+hideflag)
COLUMN_SCANNED = Grid.AddColumn("Gescannt", "T22,Gescannt", "1","V",0,495,1,10,scrtflag+sizeflag+hideflag)
COLUMN_SERIALNUMBER = Grid.AddColumn("Seriennummer", "T21,Seriennummer", "l","V",0,495,2,20,scrtflag+sizeflag+hideflag)
COLUMN_TYPE = Grid.AddColumn("SN-Artikel", "T17,Artikeltyp", "l","V",0,495,5,5,scrtflag+sizeflag+hideflag)
COLUMNS_CREATED = True
End If
Grid.IsRedraw = True
Set amountBox = mywin.Controls.Item(AMOUNT_INPUT)
amountBox.Contents = AMOUNT_PLACEHOLDER
MacroCommands.MSetFieldFocus WINDOW_ID, ORDER_INPUT
End Sub

45
current/Modules/Archiv/Packtisch/UpdateArticleRow.vbs Normal file
View File

@@ -0,0 +1,45 @@
' UpdateArticleRow(RowNumber: Integer)
' ---------------------------------------------------------
' Trägt die gescannte Menge eines Artikel in das Grid ein
' - Ändert die Farbe, abhängig von Gesamtmenge und Gescannte Menge
'
' Rückgabewert: Keiner
' ---------------------------------------------------------
Sub UpdateArticleRow(RowNumber)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
Set amountBox = mywin.Controls.Item(AMOUNT_INPUT)
DebugMessage = ""
' Bereits gescannte, Gesamt und Anzahl zu Scannen auslesen
Total = Cint(Grid.GetCellValue(RowNumber, COLUMN_TOTAL))
Scanned = Cint(Grid.GetCellValue(RowNumber, COLUMN_SCANNED))
ScannedAmount = Cint(amountBox.Contents)
' Neue bereits gescannte berechnen
NewScanned = Scanned + ScannedAmount
If DEBUG_ON = True Then
AddDebugLine "Total " & Total & vbNewline
AddDebugLine "Scanned: " & Scanned & vbNewline
AddDebugLine "NewScanned: " & NewScanned & vbNewline
ShowDebugBox "UpdateArticleRow"
End If
' Zeilenfarbe anpassen:
' GRÜN: Komplett gescannt
' GELB: Teilweise gescannt
If NewScanned = Total Then
Grid.SetLineColor RowNumber, COLOR_GREEN
Grid.SetCellValue RowNumber, COLUMN_SCANNED, NewScanned
Elseif NewScanned < Total Then
Grid.SetLineColor RowNumber, COLOR_YELLOW
Grid.SetCellValue RowNumber, COLUMN_SCANNED, NewScanned
Else
Message = ""
Message = Message & "Eingegebene Menge überschreitet die Gesamt-Anzahl oder" & vbNewline
Message = Message & "Artikel wurde bereits vollständig gescannt!"
Msgbox Message, vbExclamation, DEFAULT_TITLE
End If
End Sub

451
current/Modules/Archiv/Read-ConfigFile.psm1 Normal file
View File

@@ -0,0 +1,451 @@
Function Read-ConfigFile {
<#
.SYNOPSIS
Function will read the given ConfigFile, and returns Values or creates Profiles.
.DESCRIPTION
This Function will get Script configurations from a ASCII/ANSI based ConfigFile (INI).
The important criterion is, that every Value the should be read, has to look like this: ConfigLabel = ConfigValue
The ConfigFile should be formated within UTF8 and every Line in a ConfigFile which is beginning with a "#", will be ignored!
By calling this Function the first time, it will read the ConfigFile and save its content into the Variable ConfigFileValues.
In the same call or later calls you can instruct this Function to Return a value for a searched pattern (ConfigLabel).
If nothing was found, Function will try to get a FailSafe Setting (predefined global Variable in Script), if even this fails it will Return $NULL.
Depending on the way your calling this Function, it can return a single Value for a searched ConfigLabel like: $LogPath = E:\Logs,
or it can return multiple Values like; $Domains = .*@my-domain.com;'.*@my-second-domain.com',
or it can create multiple Profiles with single or multiple Values and only returning the Count of the created Profiles.
.REQUIREMENT General
PowerShell V2
.REQUIREMENT Assembly
<NONE>
.REQUIREMENT Variables
ConfigFile, ConfigLabel, ConfigValue, ConfigValues, ConfigLinesValue, ConfigLinesValueSeparator, FileTest, Item, Items, ItemValue, ItemValues, ItemValuesTEMP
.REQUIREMENT Variables preSet
ConfigFile
.REQUIREMENT Functions
<NONE>
.VERSION
Number: 2.0.0.0 / Date: 16.02.2017
.PARAMETER ConfigFile
Give the full path to the ConfigFile (eg. <ScriptName>_Settings.ini). (Default: If you dont give it, Function will try the retrieve ConfigFile (Path and Name) from the Global Variables, set by the calling Script.)
.PARAMETER ConfigLabel
Give the ConfigLabel, you are looking for a Value.
.PARAMETER ConfigLinesValue
Optional Parameter. Select "MultiValue", if in one Line are multiple Values (eg. Array List) separated by "$ConfigLinesValueSeparator". (Default: "SingleValue").
.PARAMETER ConfigLinesValueSeparator
Optional Parameter. Which declares the symbol or character for Value separation (Default: ';').
.PARAMETER ConfigLines
Optional Parameter. Select how many Lines from ConfigFile you expect to get returned. Use Values higher than 1, to work with Profiles. If you do, Function will set Variables and just returns how many are created! (Default: 1).
.PARAMETER Force
Optional Parameter. By using the Force Parameter, ConfigFile will be reloaded.
.EXAMPLE
Set-Variable -Scope Global -Name LogPaths -Value (Read-ConfigFile -ConfigFile "<Path>\<ScriptName>_Settings.ini" -ConfigLabel LogPath) -Force
.EXAMPLE
Set-Variable -Scope Global -Name ListofValues -Value (Read-ConfigFile -ConfigLabel ListofValues -ConfigLinesValue MultiValue) -Force
.EXAMPLE
Set-Variable -Scope Global -Name ProfileCount -Value (Read-ConfigFile -ConfigLabel Profile -ConfigLines 999) -Force
.EXAMPLE
Set-Variable -Scope Global -Name ProfileCount -Value (Read-ConfigFile -ConfigLabel Profile -ConfigLines 999 -ConfigLinesValue MultiValue) -Force
.EXAMPLE
Set-Variable -Scope Global -Name ProfileCount -Value (Read-ConfigFile -ConfigLabel Profile -ConfigLines 999 -ConfigLinesValue MultiValue -ConfigLinesValueSeparator |) -Force
#>
Param (
[Parameter(Position=0,Mandatory=$False,HelpMessage='Give the full path to the ConfigFile (eg. <ScriptName>_Settings.ini). (Default: If you dont give it, Function will try the retrieve ConfigFile (Path and Name) from the Global Variables, set by the calling Script.)')]
[ValidateNotNullOrEmpty()]
[String]$ConfigFile=(Get-Variable -Name ConfigFile -Scope Global -ValueOnly),
[Parameter(Position=1,Mandatory=$True,HelpMessage='Give the ConfigLabel, you are looking for a Value.')]
[ValidateNotNullOrEmpty()]
[String]$ConfigLabel=$NULL,
[Parameter(Position=2,Mandatory=$False,HelpMessage='Optional Parameter. Select "MultiValue", if in one Line are multiple Values (eg. Array List) separated by "$ConfigLinesValueSeparator". (Default: "SingleValue").')]
[ValidateSet("SingleValue","MultiValue")]
[String]$ConfigLinesValue="SingleValue",
[Parameter(Position=3,Mandatory=$False,HelpMessage='Optional Parameter. Which declares the symbol or character for Value separation (Default: ";").')]
[ValidateNotNullOrEmpty()]
[String]$ConfigLinesValueSeparator=';',
[Parameter(Position=4,Mandatory=$False,HelpMessage='Optional Parameter. Select how many Lines from ConfigFile you expect to get returned. Use Values higher than 1, to work with Profiles. If you do, Function will set Variables and just returns how many are created! (Default: 1).')]
[ValidateRange(0,1000)]
[Int]$ConfigLines=1,
[Parameter(Position=5,Mandatory=$False,HelpMessage='Optional Parameter. By using the Force Parameter, ConfigFile will be reloaded.')]
[Switch]$Force
) #end param
#Clear Error Variable
$error.clear()
#If ConfigFile wasnt read, do this at first
IF ((($ConfigFile) -and (!$ConfigValues)) -or ($Force -eq $True)) {
Write-Host ""
Write-Host "DEBUG Info - Read-ConfigFile: ConfigFile has not been evaluated jet..."
Write-Host "DEBUG Info - Read-ConfigFile: Checking for ConfigFile: $ConfigFile"
$FileTest = Test-Path -PathType Leaf $ConfigFile
IF ($FileTest -eq $True) {
Write-Host "DEBUG Info - Read-ConfigFile: ConfigFile does exists!"
Try {
Write-Host "DEBUG Info - Read-ConfigFile: Getting Values from ConfigFile."
Set-Variable -Name ConfigValues -Value (Select-String -Path $ConfigFile -pattern "=" | where {-not($_-match ":[0-9]{1,}:#")}) -Scope Global
} #end try
Catch {
Write-Host "DEBUG Info - Read-ConfigFile: Cannot get Values from ConfigFile."
Write-Host "DEBUG Info - Read-ConfigFile: Unexpected Error!"
Write-Host $Error
EXIT
} #end catch
Finally {
IF (!$ConfigValues) {
Write-Host "DEBUG Info - Read-ConfigFile: Found no valid Values in ConfigFile!"
Write-Host "DEBUG Info - Read-ConfigFile: Unexpected Error!"
Write-Host $Error
EXIT
} #end if
ELSE {
Write-Host "DEBUG Info - Read-ConfigFile: Found"$ConfigValues.count"Lines in ConfigFile!."
Write-Host "DEBUG Info - Read-ConfigFile: These are:"
FOREACH ($ConfigValue in $ConfigValues) {
Write-Host "DEBUG Info - Read-ConfigFile: $($ConfigValue)"
}# end foreach
} #end else
} #end finally
} #end if
ELSE {
Write-Host "DEBUG Info - Read-ConfigFile: ConfigFile does not exists!"
Write-Host "DEBUG Info - Read-ConfigFile: Unexpected Error!"
Write-Host $Error
EXIT
} #end else
} #end if
#If ConfigFile was read
IF (($ConfigFile) -and ($ConfigValues)) {
Write-Host ""
Write-Host "DEBUG Info - Read-ConfigFile: ConfigFile has been evaluated."
Write-Host "DEBUG Info - Read-ConfigFile: You are looking for: $ConfigLabel."
[Array]$Items = $NULL
[Array]$Items = ($ConfigValues.line | select-string -pattern "$ConfigLabel" | Select-Object -First $ConfigLines)
Write-Host "DEBUG Info - Read-ConfigFile: Line(s) in ConfigFile -> $Items"
#If no Line was found
IF ($($Items.count) -lt 1) {
Write-Host "DEBUG Info - Read-ConfigFile: ($ConfigLabel) seems not to exist in ConfigFile."
Write-Host "DEBUG Info - Read-ConfigFile: FailSafe Setting will be used, if there was one..."
Try {
$Items = (Get-Variable -Name $ConfigLabel -ValueOnly -Scope Global -ErrorAction Stop)
IF ($Items) {
Write-Host "DEBUG Info - Read-ConfigFile: FailSafe returning: $Items"
Return $Items
} #end if
ELSE {
Write-Host "DEBUG Info - Read-ConfigFile: FailSafe returning nothing."
Return $NULL
} #end else
} #end try
Catch {
Write-Host "DEBUG Info - Read-ConfigFile: Error reading ConfigValue!"
Write-Host "DEBUG Info - Read-ConfigFile: FailSafe returning nothing."
Return $NULL
} #end catch
} #end if
#If exactly one Line was found
ELSEIF ($($Items.count) -eq 1) {
Write-Host "DEBUG Info - Read-ConfigFile: Found exactly one Line!"
[Array]$Item = $Items
[Array]$Item = ($Item -split "=",2)
[String]$ItemName = $Item[0]
[String]$ItemName = ($ItemName.TrimStart())
[String]$ItemName = ($ItemName.TrimEnd())
[String]$ItemValues = $Item[1]
[String]$ItemValues = ($ItemValues.TrimStart())
[String]$ItemValues = ($ItemValues.TrimEnd())
#If exactly one Line was found, but has no Value inside!
IF (!$ItemValues) {
Write-Host "DEBUG Info - Read-ConfigFile: ($ConfigLabel) seems to exist, but is not configured jet."
Write-Host "DEBUG Info - Read-ConfigFile: FailSafe Setting will be used, if was configured!"
Try {
$ItemValues = (Get-Variable -Name $ConfigLabel -ValueOnly -Scope Global -ErrorAction Stop)
Write-Host "DEBUG Info - Read-ConfigFile: FailSafe returning: $ItemValues"
} #end try
Catch {
Write-Host "DEBUG Info - Read-ConfigFile: Error reading ConfigValue!"
} #end catch
} #end if
#Check again after looking for FailSafe Settings...
IF (!$ItemValues) {
Write-Host "DEBUG Info - Read-ConfigFile: Returning NULL, because nothing was found!"
Return $NULL
} #end if
ELSE {
IF ($ConfigLinesValue -eq "SingleValue") {
Write-Host "DEBUG Info - Read-ConfigFile: ------------------------------"
Write-Host "DEBUG Info - Read-ConfigFile: Looking for SingleValue Lines."
Write-Host "DEBUG Info - Read-ConfigFile: Value -> $ItemValues"
Write-Host "DEBUG Info - Read-ConfigFile: Returning Datatyp: String"
Write-Host "DEBUG Info - Read-ConfigFile: ------------------------------"
Return [String]$ItemValues
} #end if
ELSEIF ($ConfigLinesValue -eq "MultiValue") {
Write-Host "DEBUG Info - Read-ConfigFile: ------------------------------"
Write-Host "DEBUG Info - Read-ConfigFile: Looking for MultiValue Lines,"
Write-Host "DEBUG Info - Read-ConfigFile: which are separated by a: $ConfigLinesValueSeparator"
#Prepare Arrays
[Array]$ItemValues = $ItemValues -split "$ConfigLinesValueSeparator"
[System.Collections.ArrayList]$ItemValuesTEMP = @()
#Rebuild the Array, to remove possible Blanks
FOREACH ($ItemValue in $ItemValues) {
IF ($ItemValue) {
#The "| Out-Null" is VERY important, otherwise the Array will be f**ked!
$ItemValue = ($ItemValue.TrimStart())
$ItemValue = ($ItemValue.TrimEnd())
$ItemValuesTEMP.Add("$ItemValue") | Out-null
} #end if
} #end foreach
[Array]$ItemValues = $NULL
[Array]$ItemValues = $ItemValuesTEMP
IF ($($ItemValues.count) -eq 1) {
Write-Host "DEBUG Info - Read-ConfigFile: Found $($ItemValues.count) Array Item!"
Write-Host "DEBUG Info - Read-ConfigFile: Value -> $ItemValues"
Write-Host "DEBUG Info - Read-ConfigFile: Returning Datatyp: String"
Write-Host "DEBUG Info - Read-ConfigFile: ------------------------------"
Return [String]$ItemValues
} #end if
ELSEIF ($($ItemValues.count) -gt 1) {
Write-Host "DEBUG Info - Read-ConfigFile: Found $($ItemValues.count) Array Items!"
Write-Host "DEBUG Info - Read-ConfigFile: Values -> $ItemValues"
Write-Host "DEBUG Info - Read-ConfigFile: Returning Datatyp: Array"
Write-Host "DEBUG Info - Read-ConfigFile: ------------------------------"
Return [Array]$ItemValues
} #end elseif
ELSE {
Write-Host "DEBUG Info - Read-ConfigFile: Found $($ItemValues.count) Array Item(s)!"
Write-Host "DEBUG Info - Read-ConfigFile: Value(s) -> $ItemValues"
Write-Host "DEBUG Info - Read-ConfigFile: Returning Datatyp: $($ItemValues.gettype())"
Write-Host "DEBUG Info - Read-ConfigFile: ------------------------------"
Return $ItemValues
} #end else
} #end elseif
} #end else
} #end elseif
#If multiple Lines are found
ELSEIF ($($Items.count) -gt 1) {
Write-Host "DEBUG Info - Read-ConfigFile: Found multiple ($($Items.count)) Lines!"
[Int]$Counter1 = 0
FOREACH ($Item in $Items) {
[Array]$Item = ($Item -split "=",2)
[String]$ItemName = $Item[0]
[String]$ItemName = ($ItemName.TrimStart())
[String]$ItemName = ($ItemName.TrimEnd())
[String]$ItemValues = $Item[1]
[String]$ItemValues = ($ItemValues.TrimStart())
[String]$ItemValues = ($ItemValues.TrimEnd())
IF (($ItemName) -and ($ItemValues)) {
[Int]$Counter1++ | Out-Null
IF ($ConfigLinesValue -eq "SingleValue") {
Write-Host "DEBUG Info - Read-ConfigFile: ------------------------------"
Write-Host "DEBUG Info - Read-ConfigFile: Looking for SingleValue Lines."
Write-Host "DEBUG Info - Read-ConfigFile: -> $ItemValues"
} #end if
ELSEIF ($ConfigLinesValue -eq "MultiValue") {
Write-Host "DEBUG Info - Read-ConfigFile: ------------------------------"
Write-Host "DEBUG Info - Read-ConfigFile: Looking for MultiValue Lines,"
Write-Host "DEBUG Info - Read-ConfigFile: which are separated by a: $ConfigLinesValueSeparator"
#Rebuild the Array, to remove possible Blanks
[Array]$ItemValues = $ItemValues -split "$ConfigLinesValueSeparator"
[System.Collections.ArrayList]$ItemValuesTEMP = @()
FOREACH ($ItemValue in $ItemValues) {
IF ($ItemValue) {
#The "| Out-Null" is VERY important, otherwise the Array will be f**ked!
$ItemValue = ($ItemValue.TrimStart())
$ItemValue = ($ItemValue.TrimEnd())
$ItemValuesTEMP.Add("$ItemValue") | Out-null
} #end if
} #end foreach
[Array]$ItemValues = $NULL
[Array]$ItemValues = $ItemValuesTEMP
} #end elseif
IF ($($ItemValues.count) -eq 1) {
Write-Host "DEBUG Info - Read-ConfigFile: Found $($ItemValues.count) Array Item!"
Write-Host "DEBUG Info - Read-ConfigFile: Setting Variable: $($ItemName+$Counter1)"
Write-Host "DEBUG Info - Read-ConfigFile: with Value -> $ItemValues"
Write-Host "DEBUG Info - Read-ConfigFile: in Datatyp: String"
Set-Variable -Name ($ItemName+$Counter1) -Value ([String]$ItemValues) -Scope Global
Write-Host "DEBUG Info - Read-ConfigFile: ------------------------------"
} #end if
ELSEIF ($($ItemValues.count) -gt 1) {
Write-Host "DEBUG Info - Read-ConfigFile: Found $($ItemValues.count) Array Item(s)!"
Write-Host "DEBUG Info - Read-ConfigFile: Setting Variable: $($ItemName+$Counter1)"
Write-Host "DEBUG Info - Read-ConfigFile: with Value(s) -> $ItemValues"
Write-Host "DEBUG Info - Read-ConfigFile: in Datatyp: Array"
Set-Variable -Name ($ItemName+$Counter1) -Value @([Array]$ItemValues) -Scope Global
Write-Host "DEBUG Info - Read-ConfigFile: ------------------------------"
} #end elseif
ELSE {
Write-Host "DEBUG Info - Read-ConfigFile: Found $($ItemValues.count) Array Item(s)!"
Write-Host "DEBUG Info - Read-ConfigFile: Setting Variable: $($ItemName+$Counter1)"
Write-Host "DEBUG Info - Read-ConfigFile: with Value(s) -> $ItemValues"
Write-Host "DEBUG Info - Read-ConfigFile: in Datatyp: $($ItemValues.gettype() | Select BaseType)"
Set-Variable -Name ($ItemName+$Counter1) -Value $ItemValues -Scope Global
Write-Host "DEBUG Info - Read-ConfigFile: ------------------------------"
} #end else
} #end if
} #end foreach
#Return how many Profiles were are created!
Return [Int]$Counter1
} #end elseif
#That shouldnt be happen...
ELSE {
Write-Host "DEBUG Info - Read-ConfigFile: Error reading ConfigValues!"
Write-Host "DEBUG Info - Read-ConfigFile: Exiting, because of this Issue."
Write-Host $Error
EXIT
} #end else
} #end elseif
ELSE {
Write-Host "DEBUG Info - Read-ConfigFile: Invalid ConfigValues from ConfigFile!"
Write-Host "DEBUG Info - Read-ConfigFile: Please check the Description of this Function"
Write-Host "DEBUG Info - Read-ConfigFile: and the ConfigFile!"
} #end else
} #end function

452
current/Modules/Archiv/Read-ConfigFile/2.0.0.0/Read-ConfigFile.psm1 Normal file
View File

@@ -0,0 +1,452 @@
Function Read-ConfigFile {
<#
.SYNOPSIS
Function will read the given ConfigFile, and returns Values or creates Profiles.
.DESCRIPTION
This Function will get Script configurations from a ASCII/ANSI based ConfigFile (INI).
The important criterion is, that every Value the should be read, has to look like this: ConfigLabel = ConfigValue
The ConfigFile should be formated within UTF8 and every Line in a ConfigFile which is beginning with a "#", will be ignored!
By calling this Function the first time, it will read the ConfigFile and save its content into the Variable ConfigFileValues.
In the same call or later calls you can instruct this Function to Return a value for a searched pattern (ConfigLabel).
If nothing was found, Function will try to get a FailSafe Setting (predefined global Variable in Script), if even this fails it will Return $NULL.
Depending on the way your calling this Function, it can return a single Value for a searched ConfigLabel like: $LogPath = E:\Logs,
or it can return multiple Values like; $Domains = .*@my-domain.com;'.*@my-second-domain.com',
or it can create multiple Profiles with single or multiple Values and only returning the Count of the created Profiles.
.REQUIREMENT General
PowerShell V2
.REQUIREMENT Assembly
<NONE>
.REQUIREMENT Variables
ConfigFile, ConfigLabel, ConfigValue, ConfigValues, ConfigLinesValue, ConfigLinesValueSeparator, FileTest, Item, Items, ItemValue, ItemValues, ItemValuesTEMP
.REQUIREMENT Variables preSet
ConfigFile
.REQUIREMENT Functions
<NONE>
.VERSION
Number: 2.0.0.0 / Date: 16.02.2017
.PARAMETER ConfigFile
Give the full path to the ConfigFile (eg. <ScriptName>_Settings.ini). (Default: If you dont give it, Function will try the retrieve ConfigFile (Path and Name) from the Global Variables, set by the calling Script.)
.PARAMETER ConfigLabel
Give the ConfigLabel, you are looking for a Value.
.PARAMETER ConfigLinesValue
Optional Parameter. Select "MultiValue", if in one Line are multiple Values (eg. Array List) separated by "$ConfigLinesValueSeparator". (Default: "SingleValue").
.PARAMETER ConfigLinesValueSeparator
Optional Parameter. Which declares the symbol or character for Value separation (Default: ';').
.PARAMETER ConfigLines
Optional Parameter. Select how many Lines from ConfigFile you expect to get returned. Use Values higher than 1, to work with Profiles. If you do, Function will set Variables and just returns how many are created! (Default: 1).
.PARAMETER Force
Optional Parameter. By using the Force Parameter, ConfigFile will be reloaded.
.EXAMPLE
Set-Variable -Scope Global -Name LogPaths -Value (Read-ConfigFile -ConfigFile "<Path>\<ScriptName>_Settings.ini" -ConfigLabel LogPath) -Force
.EXAMPLE
Set-Variable -Scope Global -Name ListofValues -Value (Read-ConfigFile -ConfigLabel ListofValues -ConfigLinesValue MultiValue) -Force
.EXAMPLE
Set-Variable -Scope Global -Name ProfileCount -Value (Read-ConfigFile -ConfigLabel Profile -ConfigLines 999) -Force
.EXAMPLE
Set-Variable -Scope Global -Name ProfileCount -Value (Read-ConfigFile -ConfigLabel Profile -ConfigLines 999 -ConfigLinesValue MultiValue) -Force
.EXAMPLE
Set-Variable -Scope Global -Name ProfileCount -Value (Read-ConfigFile -ConfigLabel Profile -ConfigLines 999 -ConfigLinesValue MultiValue -ConfigLinesValueSeparator |) -Force
#>
Param (
[Parameter(Position=0,Mandatory=$False,HelpMessage='Give the full path to the ConfigFile (eg. <ScriptName>_Settings.ini). (Default: If you dont give it, Function will try the retrieve ConfigFile (Path and Name) from the Global Variables, set by the calling Script.)')]
[ValidateNotNullOrEmpty()]
[String]$ConfigFile=(Get-Variable -Name ConfigFile -Scope Global -ValueOnly),
[Parameter(Position=1,Mandatory=$True,HelpMessage='Give the ConfigLabel, you are looking for a Value.')]
[ValidateNotNullOrEmpty()]
[String]$ConfigLabel=$NULL,
[Parameter(Position=2,Mandatory=$False,HelpMessage='Optional Parameter. Select "MultiValue", if in one Line are multiple Values (eg. Array List) separated by "$ConfigLinesValueSeparator". (Default: "SingleValue").')]
[ValidateSet("SingleValue","MultiValue")]
[String]$ConfigLinesValue="SingleValue",
[Parameter(Position=3,Mandatory=$False,HelpMessage='Optional Parameter. Which declares the symbol or character for Value separation (Default: ";").')]
[ValidateNotNullOrEmpty()]
[String]$ConfigLinesValueSeparator=';',
[Parameter(Position=4,Mandatory=$False,HelpMessage='Optional Parameter. Select how many Lines from ConfigFile you expect to get returned. Use Values higher than 1, to work with Profiles. If you do, Function will set Variables and just returns how many are created! (Default: 1).')]
[ValidateRange(0,1000)]
[Int]$ConfigLines=1,
[Parameter(Position=5,Mandatory=$False,HelpMessage='Optional Parameter. By using the Force Parameter, ConfigFile will be reloaded.')]
[Switch]$Force
) #end param
#Clear Error Variable
$error.clear()
#If ConfigFile wasnt read, do this at first
IF ((($ConfigFile) -and (!$ConfigValues)) -or ($Force -eq $True)) {
Write-Host ""
Write-Host "DEBUG Info - Read-ConfigFile: ConfigFile has not been evaluated jet..."
Write-Host "DEBUG Info - Read-ConfigFile: Checking for ConfigFile: $ConfigFile"
$FileTest = Test-Path -PathType Leaf $ConfigFile
IF ($FileTest -eq $True) {
Write-Host "DEBUG Info - Read-ConfigFile: ConfigFile does exists!"
Try {
Write-Host "DEBUG Info - Read-ConfigFile: Getting Values from ConfigFile."
Set-Variable -Name ConfigValues -Value (Select-String -Path $ConfigFile -pattern "=" | where {-not($_-match ":[0-9]{1,}:#")}) -Scope Global
} #end try
Catch {
Write-Host "DEBUG Info - Read-ConfigFile: Cannot get Values from ConfigFile."
Write-Host "DEBUG Info - Read-ConfigFile: Unexpected Error!"
Write-Host $Error
EXIT
} #end catch
Finally {
IF (!$ConfigValues) {
Write-Host "DEBUG Info - Read-ConfigFile: Found no valid Values in ConfigFile!"
Write-Host "DEBUG Info - Read-ConfigFile: Unexpected Error!"
Write-Host $Error
EXIT
} #end if
ELSE {
Write-Host "DEBUG Info - Read-ConfigFile: Found"$ConfigValues.count"Lines in ConfigFile!."
Write-Host "DEBUG Info - Read-ConfigFile: These are:"
FOREACH ($ConfigValue in $ConfigValues) {
Write-Host "DEBUG Info - Read-ConfigFile: $($ConfigValue)"
}# end foreach
} #end else
} #end finally
} #end if
ELSE {
Write-Host "DEBUG Info - Read-ConfigFile: ConfigFile does not exists!"
Write-Host "DEBUG Info - Read-ConfigFile: Unexpected Error!"
Write-Host $Error
EXIT
} #end else
} #end if
#If ConfigFile was read
IF (($ConfigFile) -and ($ConfigValues)) {
Write-Host ""
Write-Host "DEBUG Info - Read-ConfigFile: ConfigFile has been evaluated."
Write-Host "DEBUG Info - Read-ConfigFile: You are looking for: $ConfigLabel."
[Array]$Items = $NULL
[Array]$Items = ($ConfigValues.line | select-string -pattern "$ConfigLabel" | Select-Object -First $ConfigLines)
Write-Host "DEBUG Info - Read-ConfigFile: Line(s) in ConfigFile -> $Items"
#If no Line was found
IF ($($Items.count) -lt 1) {
Write-Host "DEBUG Info - Read-ConfigFile: ($ConfigLabel) seems not to exist in ConfigFile."
Write-Host "DEBUG Info - Read-ConfigFile: FailSafe Setting will be used, if there was one..."
Try {
$Items = (Get-Variable -Name $ConfigLabel -ValueOnly -Scope Global -ErrorAction Stop)
IF ($Items) {
Write-Host "DEBUG Info - Read-ConfigFile: FailSafe returning: $Items"
Return $Items
} #end if
ELSE {
Write-Host "DEBUG Info - Read-ConfigFile: FailSafe returning nothing."
Return $NULL
} #end else
} #end try
Catch {
Write-Host "DEBUG Info - Read-ConfigFile: Error reading ConfigValue!"
Write-Host "DEBUG Info - Read-ConfigFile: FailSafe returning nothing."
Return $NULL
} #end catch
} #end if
#If exactly one Line was found
ELSEIF ($($Items.count) -eq 1) {
Write-Host "DEBUG Info - Read-ConfigFile: Found exactly one Line!"
[Array]$Item = $Items
[Array]$Item = ($Item -split "=",2)
[String]$ItemName = $Item[0]
[String]$ItemName = ($ItemName.TrimStart())
[String]$ItemName = ($ItemName.TrimEnd())
[String]$ItemValues = $Item[1]
[String]$ItemValues = ($ItemValues.TrimStart())
[String]$ItemValues = ($ItemValues.TrimEnd())
#If exactly one Line was found, but has no Value inside!
IF (!$ItemValues) {
Write-Host "DEBUG Info - Read-ConfigFile: ($ConfigLabel) seems to exist, but is not configured jet."
Write-Host "DEBUG Info - Read-ConfigFile: FailSafe Setting will be used, if was configured!"
Try {
$ItemValues = (Get-Variable -Name $ConfigLabel -ValueOnly -Scope Global -ErrorAction Stop)
Write-Host "DEBUG Info - Read-ConfigFile: FailSafe returning: $ItemValues"
} #end try
Catch {
Write-Host "DEBUG Info - Read-ConfigFile: Error reading ConfigValue!"
} #end catch
} #end if
#Check again after looking for FailSafe Settings...
IF (!$ItemValues) {
Write-Host "DEBUG Info - Read-ConfigFile: Returning NULL, because nothing was found!"
Return $NULL
} #end if
ELSE {
IF ($ConfigLinesValue -eq "SingleValue") {
Write-Host "DEBUG Info - Read-ConfigFile: ------------------------------"
Write-Host "DEBUG Info - Read-ConfigFile: Looking for SingleValue Lines."
Write-Host "DEBUG Info - Read-ConfigFile: Value -> $ItemValues"
Write-Host "DEBUG Info - Read-ConfigFile: Returning Datatyp: String"
Write-Host "DEBUG Info - Read-ConfigFile: ------------------------------"
Return [String]$ItemValues
} #end if
ELSEIF ($ConfigLinesValue -eq "MultiValue") {
Write-Host "DEBUG Info - Read-ConfigFile: ------------------------------"
Write-Host "DEBUG Info - Read-ConfigFile: Looking for MultiValue Lines,"
Write-Host "DEBUG Info - Read-ConfigFile: which are separated by a: $ConfigLinesValueSeparator"
#Prepare Arrays
[Array]$ItemValues = $ItemValues -split "$ConfigLinesValueSeparator"
[System.Collections.ArrayList]$ItemValuesTEMP = @()
#Rebuild the Array, to remove possible Blanks
FOREACH ($ItemValue in $ItemValues) {
IF ($ItemValue) {
#The "| Out-Null" is VERY important, otherwise the Array will be f**ked!
$ItemValue = ($ItemValue.TrimStart())
$ItemValue = ($ItemValue.TrimEnd())
$ItemValuesTEMP.Add("$ItemValue") | Out-null
} #end if
} #end foreach
[Array]$ItemValues = $NULL
[Array]$ItemValues = $ItemValuesTEMP
IF ($($ItemValues.count) -eq 1) {
Write-Host "DEBUG Info - Read-ConfigFile: Found $($ItemValues.count) Array Item!"
Write-Host "DEBUG Info - Read-ConfigFile: Value -> $ItemValues"
Write-Host "DEBUG Info - Read-ConfigFile: Returning Datatyp: String"
Write-Host "DEBUG Info - Read-ConfigFile: ------------------------------"
Return [String]$ItemValues
} #end if
ELSEIF ($($ItemValues.count) -gt 1) {
Write-Host "DEBUG Info - Read-ConfigFile: Found $($ItemValues.count) Array Items!"
Write-Host "DEBUG Info - Read-ConfigFile: Values -> $ItemValues"
Write-Host "DEBUG Info - Read-ConfigFile: Returning Datatyp: Array"
Write-Host "DEBUG Info - Read-ConfigFile: ------------------------------"
Return [Array]$ItemValues
} #end elseif
ELSE {
Write-Host "DEBUG Info - Read-ConfigFile: Found $($ItemValues.count) Array Item(s)!"
Write-Host "DEBUG Info - Read-ConfigFile: Value(s) -> $ItemValues"
Write-Host "DEBUG Info - Read-ConfigFile: Returning Datatyp: $($ItemValues.gettype())"
Write-Host "DEBUG Info - Read-ConfigFile: ------------------------------"
Return $ItemValues
} #end else
} #end elseif
} #end else
} #end elseif
#If multiple Lines are found
ELSEIF ($($Items.count) -gt 1) {
Write-Host "DEBUG Info - Read-ConfigFile: Found multiple ($($Items.count)) Lines!"
[Int]$Counter1 = 0
FOREACH ($Item in $Items) {
[Array]$Item = ($Item -split "=",2)
[String]$ItemName = $Item[0]
[String]$ItemName = ($ItemName.TrimStart())
[String]$ItemName = ($ItemName.TrimEnd())
[String]$ItemValues = $Item[1]
[String]$ItemValues = ($ItemValues.TrimStart())
[String]$ItemValues = ($ItemValues.TrimEnd())
IF (($ItemName) -and ($ItemValues)) {
[Int]$Counter1++ | Out-Null
IF ($ConfigLinesValue -eq "SingleValue") {
Write-Host "DEBUG Info - Read-ConfigFile: ------------------------------"
Write-Host "DEBUG Info - Read-ConfigFile: Looking for SingleValue Lines."
Write-Host "DEBUG Info - Read-ConfigFile: -> $ItemValues"
} #end if
ELSEIF ($ConfigLinesValue -eq "MultiValue") {
Write-Host "DEBUG Info - Read-ConfigFile: ------------------------------"
Write-Host "DEBUG Info - Read-ConfigFile: Looking for MultiValue Lines,"
Write-Host "DEBUG Info - Read-ConfigFile: which are separated by a: $ConfigLinesValueSeparator"
#Rebuild the Array, to remove possible Blanks
[Array]$ItemValues = $ItemValues -split "$ConfigLinesValueSeparator"
[System.Collections.ArrayList]$ItemValuesTEMP = @()
FOREACH ($ItemValue in $ItemValues) {
IF ($ItemValue) {
#The "| Out-Null" is VERY important, otherwise the Array will be f**ked!
$ItemValue = ($ItemValue.TrimStart())
$ItemValue = ($ItemValue.TrimEnd())
$ItemValuesTEMP.Add("$ItemValue") | Out-null
} #end if
} #end foreach
[Array]$ItemValues = $NULL
[Array]$ItemValues = $ItemValuesTEMP
} #end elseif
IF ($($ItemValues.count) -eq 1) {
#IF (($($ItemValues.count) -eq 1) -ne ($ConfigLinesValue -eq "MultiValue")) {
Write-Host "DEBUG Info - Read-ConfigFile: Found $($ItemValues.count) Array Item!"
Write-Host "DEBUG Info - Read-ConfigFile: Setting Variable: $($ItemName+$Counter1)"
Write-Host "DEBUG Info - Read-ConfigFile: with Value -> $ItemValues"
Write-Host "DEBUG Info - Read-ConfigFile: in Datatyp: String"
Set-Variable -Name ($ItemName+$Counter1) -Value ([String]$ItemValues) -Scope Global
Write-Host "DEBUG Info - Read-ConfigFile: ------------------------------"
} #end if
ELSEIF (($($ItemValues.count) -gt 1) -or ($ConfigLinesValue -eq "MultiValue")) {
Write-Host "DEBUG Info - Read-ConfigFile: Found $($ItemValues.count) Array Item(s)!"
Write-Host "DEBUG Info - Read-ConfigFile: Setting Variable: $($ItemName+$Counter1)"
Write-Host "DEBUG Info - Read-ConfigFile: with Value(s) -> $ItemValues"
Write-Host "DEBUG Info - Read-ConfigFile: in Datatyp: Array"
Set-Variable -Name ($ItemName+$Counter1) -Value @([Array]$ItemValues) -Scope Global
Write-Host "DEBUG Info - Read-ConfigFile: ------------------------------"
} #end elseif
ELSE {
Write-Host "DEBUG Info - Read-ConfigFile: Found $($ItemValues.count) Array Item(s)!"
Write-Host "DEBUG Info - Read-ConfigFile: Setting Variable: $($ItemName+$Counter1)"
Write-Host "DEBUG Info - Read-ConfigFile: with Value(s) -> $ItemValues"
Write-Host "DEBUG Info - Read-ConfigFile: in Datatyp: $($ItemValues.gettype() | Select BaseType)"
Set-Variable -Name ($ItemName+$Counter1) -Value $ItemValues -Scope Global
Write-Host "DEBUG Info - Read-ConfigFile: ------------------------------"
} #end else
} #end if
} #end foreach
#Return how many Profiles were are created!
Return [Int]$Counter1
} #end elseif
#That shouldnt be happen...
ELSE {
Write-Host "DEBUG Info - Read-ConfigFile: Error reading ConfigValues!"
Write-Host "DEBUG Info - Read-ConfigFile: Exiting, because of this Issue."
Write-Host $Error
EXIT
} #end else
} #end elseif
ELSE {
Write-Host "DEBUG Info - Read-ConfigFile: Invalid ConfigValues from ConfigFile!"
Write-Host "DEBUG Info - Read-ConfigFile: Please check the Description of this Function"
Write-Host "DEBUG Info - Read-ConfigFile: and the ConfigFile!"
} #end else
} #end function

117
current/Modules/Archiv/Remove-Item-withLogging.psm1 Normal file
View File

@@ -0,0 +1,117 @@
Function Remove-Item-withLogging {
<#
.SYNOPSIS
Function will delete Items selected by Path, Name and Age.
.DESCRIPTION
Function will delete Items selected by Path, Name and Age, with logging this.
For a successful performed deletion, Function will Return $True, for unccessful $False.
.REQUIREMENT General
PowerShell V2
.REQUIREMENT Variables
Path, FileKeepTime, FileBaseName, Item, Items
.REQUIREMENT Assembly
<NONE>
.REQUIREMENT Functions
Write-LogFile
.VERSION
Number: 1.1.0.0 / Date: 21.11.2016
.PARAMETER Path
Give the Full Path, where the Item(s) located, which should be deleted.
.PARAMETER FileKeepTime
Give the time in Days, which Items should be deleted, which are older than...
.PARAMETER FileBaseName
Give the <Filename> an which will be selected, the Item(s) to delete. Given <Filename> will be set with Wildcards: *<Filename>*.
.EXAMPLE
Remove-Item-withLogging -Path "E:\LogFiles" -FileKeepTime 5 -FileBaseName Filename
#>
[cmdletbinding()]
Param (
[Parameter(Mandatory=$True,HelpMessage='Give the Full Path, where the Item(s) located, which should be deleted.')]
[ValidateNotNullOrEmpty()]
[String]$Path=$NULL,
[Parameter(Mandatory=$True,HelpMessage='Give the time in Days, which Item(s) should be deleted, which are older than...')]
[ValidateRange(0,1000)]
[Int]$FileKeepTime=$NULL,
[Parameter(Mandatory=$True,HelpMessage='Give the Filename an which will be selected, the Item(s) to delete. Given <Filename> will be set with Wildcards: *<Filename>*.')]
[ValidateNotNullOrEmpty()]
[String]$FileBaseName=$NULL
) #end param
#Checking if "Write-LogFile" Module was loaded
IF (Get-Module -Name "Write-LogFile") {
IF ($FileKeepTime -gt 0) {
Write-Logfile -LogLine "Files should be removed which are older than $FileKeepTime Day(s)."
$Items = (Get-ChildItem -Path "$Path\*" -Filter *.log | where {$_.Name -like "*$FileBaseName*" -and $_.lastwritetime -lt $((Get-Date).AddDays(-$FileKeepTime)) -and -not $_.psiscontainer})
IF ($Items -eq $null) {
Write-Logfile -LogLine "Found no old Files."
Return $False
} #end if
ELSE {
Write-Logfile -LogLine "Deleting old Files (Found: $($Items.count)) :"
FOREACH ($Item in $Items) {
Try {
Remove-Item -Path $Item -Force -Verbose -ErrorVariable Error -ErrorAction Continue
Write-Logfile -LogLine "LogFile: $Item was removed."
Return $True
} #end try
Catch {
Write-Logfile -LogLine "File: $Item cannot been removed."
Write-Logfile -LogLine "Please check your privileges!"
} #end catch
} #end foreach
} #end else
} #end if
ELSE {
Write-Logfile -LogLine "You disabled File deleting, they all will be kept."
Return $False
} #end else
} #end if
ELSE {
Write-Host ""
Write-Host "DEBUG Info: Write-LogFile - Module does not exist!"
Write-Host "DEBUG Info: Please load the Module and try again, running this Function/Module!"
Write-Host "DEBUG Info: Exiting, because of this Issue."
EXIT
} #end else
} #end function

363
current/Modules/Archiv/Restart-windreamClient-withLogging.psm1 Normal file
View File

@@ -0,0 +1,363 @@
Function Restart-windreamClient-withLogging {
<#
.SYNOPSIS
Restart windream Client Components via COM Interface
.DESCRIPTION
If Connection to the windream Server gets interrupted (network loss, eg.), it is neccessery to restart the Client Components.
Otherwise you can Stop or Start Client Components with this Function.
For a successful performed Action, Function will Return $True, for unccessful $False.
.REQUIREMENT General
PowerShell V3, windream Client Connectivity (>=V3.6)
.REQUIREMENT Assembly
<NONE>
.REQUIREMENT Variables
windreamControlCenter, windreamIndexService, ServiceTest, Action
.REQUIREMENT Variables preSet
<NONE>
.REQUIREMENT Functions
Write-LogFile
.VERSION
1.1.0.0 / 21.11.2016
.PARAMETER Action
Determine which Action you want to perform <Stop|Restart|Start>. Default Value is <Restart>.
.PARAMETER ServiceTest
Set on $True, if Function should check for a running windream vfs Client Service. If it is and Service is stopped, Function will try to start Service. Default Value is $True.
.EXAMPLE
Restart-windreamClient
.EXAMPLE
Restart-windreamClient -Action Start
.EXAMPLE
Restart-windreamClient -Action Start -ServiceTest $False
#>
[cmdletbinding()]
Param (
[Parameter(mandatory=$False,HelpMessage='Determine which Action you want to perform <Stop|Restart|Start>. Default Value is "Restart".')]
[ValidateSet("Stop","Restart","Start")]
[String]$Action="Restart",
[Parameter(mandatory=$False,HelpMessage='Set on $True, if Function should check for a running windream vfs Client Service. If it is and Service is stopped, Function will try to start Service. Default Value is $True.')]
[ValidateSet($True,$False)]
[Switch]$ServiceTest=$True
) #end param
#Clear Error Variable
$error.clear()
#Checking if "Write-LogFile" Module was loaded
IF (Get-Module -Name "Write-LogFile") {
Write-Host "DEBUG Info: Write-LogFile - Module exists."
#If Servie Test was enabled (by default true) check if windream vfs Service is running
IF ($ServiceTest -eq $True) {
Write-LogFile -LogLine " "
Write-LogFile -LogLine "Service Test is enabled!"
#Check if windream vfs Service is installed
Try {
[Object]$ServiceTest = $NULL
[Object]$ServiceTest = Get-Service -Name vfssvc -ErrorAction Stop
Write-LogFile -LogLine "Found Service: vfssvc"
Write-LogFile -LogLine "Service is currently: $((Get-Service -Name vfssvc).Status)"
} #end try
Catch {
Write-LogFile -LogLine "WARNING: windream Client seems not to be installed completely."
Write-LogFile -LogLine "Missing Service: vfssvc"
} #end catch
} #end if
#If Servie Test is disabled
ELSE {
Write-LogFile -LogLine " "
Write-LogFile -LogLine "Service Test is disabled!"
} #end else
#Try to create windream Objects
Try {
[Object]$windreamControlCenter = New-Object -ComObject "Wmcc.ControlCenter" -ErrorAction Stop
[Object]$windreamIndexService = New-Object -ComObject "WMIndexServer.WMIdxSvControl" -ErrorAction Stop
} #end try
Catch {
Write-Logfile -LogLine "Cannot create Object from windream Class Wmcc.ControlCenter or WMIndexServer.WMIdxSvControl!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
#If Function was called to Stop windream Client Components
IF ($Action -like "Stop") {
Write-LogFile -LogLine "Stop windream Client Components."
#Try to stop windream Client Components
Try {
Write-Logfile -LogLine "Stopping windream Client Components!"
$windreamControlCenter.StartVFSService(0) | Out-Null
$windreamIndexService.Shutdown() | Out-Null
$windreamControlCenter.ExitCC(0) | Out-Null
} #end try
Catch {
Write-Logfile -LogLine "Cannot stop windream Client Components!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
Return $True
} #end if
#If Function was called to Restart windream Client Components and Service Test was enabled
ELSEIF (($Action -like "Restart") -and ($ServiceTest -is [Object])) {
#Checking if windream vfs Service is running
IF ((Get-Service -Name vfssvc).Status -ne 'running') {
Write-LogFile -LogLine "Warning: windream vfs Service is not running!"
Try {
Write-Logfile -LogLine "Trying to Start/Restart the windream vfs Service!"
Stop-Service -Name vfssvc -ErrorAction SilentlyContinue
Start-Service -Name vfssvc -ErrorAction Stop
} #end try
Catch {
Write-Logfile -LogLine "Cannot Start/Restart windream vfs Service!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
} #end if
ELSE {
Write-Logfile -LogLine " "
Write-LogFile -LogLine "windream vfs Service is running!"
} #end else
Write-LogFile -LogLine "Restart windream Client Components."
#Try to stop windream Client Components
Try {
Write-Logfile -LogLine "Stopping windream Client Components!"
$windreamControlCenter.StartVFSService(0) | Out-Null
$windreamIndexService.Shutdown() | Out-Null
} #end try
Catch {
Write-Logfile -LogLine "Cannot stop windream Client Components!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
#Try to start windream Client Components
Try {
Write-Logfile -LogLine "Starting windream Client Components!"
$windreamControlCenter.StartVFSService(1) | Out-Null
$windreamIndexService.Start() | Out-Null
} #end try
Catch {
Write-Logfile -LogLine "Cannot start windream Client Components!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
Return $True
} #end elseif
#If Function was called to Restart windream Client Components and Service Test was disabled
ELSEIF (($Action -like "Restart") -and ($ServiceTest -is [Switch])) {
Write-LogFile -LogLine "Restart windream Client Components."
#Try to stop windream Client Components
Try {
Write-Logfile -LogLine "Stopping windream Client Components!"
$windreamControlCenter.StartVFSService(0) | Out-Null
$windreamIndexService.Shutdown() | Out-Null
} #end try
Catch {
Write-Logfile -LogLine "Cannot stop windream Client Components!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
#Try to start windream Client Components
Try {
Write-Logfile -LogLine "Starting windream Client Components!"
$windreamControlCenter.StartVFSService(1) | Out-Null
$windreamIndexService.Start() | Out-Null
} #end try
Catch {
Write-Logfile -LogLine "Cannot start windream Client Components!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
Return $True
} #end elseif
#If Function was called to Start windream Client Components and Service Test was enabled
ELSEIF (($Action -like "Start") -and ($ServiceTest -is [Object])) {
#Checking if windream vfs Service is running
IF ((Get-Service -Name vfssvc).Status -ne 'running') {
Write-LogFile -LogLine "Warning: windream vfs Service is not running!"
Try {
Write-Logfile -LogLine "Trying to Start/Restart the windream vfs Service!"
Stop-Service -Name vfssvc -ErrorAction SilentlyContinue
Start-Service -Name vfssvc -ErrorAction Stop
} #end try
Catch {
Write-Logfile -LogLine "Cannot Start/Restart windream vfs Service!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
} #end if
ELSE {
Write-Logfile -LogLine " "
Write-LogFile -LogLine "windream vfs Service is running!"
} #end else
Write-LogFile -LogLine "Start windream Client Components."
#Try to start windream Client Components
Try {
Write-Logfile -LogLine "Starting windream Client Components!"
$windreamControlCenter.StartVFSService(1) | Out-Null
$windreamIndexService.Start() | Out-Null
} #end try
Catch {
Write-Logfile -LogLine "Cannot start windream Client Components!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
Return $True
} #end elseif
#If Function was called to Start windream Client Components and Service Test was disabled
ELSEIF (($Action -like "Start") -and ($ServiceTest -is [Switch])) {
Write-LogFile -LogLine "Start windream Client Components."
#Try to start windream Client Components
Try {
Write-Logfile -LogLine "Starting windream Client Components!"
$windreamControlCenter.StartVFSService(1) | Out-Null
$windreamIndexService.Start() | Out-Null
} #end try
Catch {
Write-Logfile -LogLine "Cannot start windream Client Components!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
Return $True
} #end elseif
#If Function was called invalid Values, which should be not possible be the ValidateSet of the Function Parameters
ELSE {
Write-Logfile -LogLine "Function Call went wrong, please check the ValidateSet"
Write-Logfile -LogLine $Error
Return $False
} #end else
} #end if
ELSE {
Write-Host ""
Write-Host "DEBUG Info: Write-LogFile - Module does not exist!"
Write-Host "DEBUG Info: Please load the Module and try again, running this Function/Module!"
Write-Host "DEBUG Info: Exiting, because of this Issue."
EXIT
} #end else
} #end function

361
current/Modules/Archiv/Restart-windreamClient-withLogging/1.1.0.1/Restart-windreamClient-withLogging.psm1 Normal file
View File

@@ -0,0 +1,361 @@
Function Restart-windreamClient-withLogging {
<#
.SYNOPSIS
Restart windream Client Components via COM Interface
.DESCRIPTION
If Connection to the windream Server gets interrupted (network loss, eg.), it is neccessery to restart the Client Components.
Otherwise you can Stop or Start Client Components with this Function.
For a successful performed Action, Function will Return $True, for unccessful $False.
.REQUIREMENT General
PowerShell V3, windream Client Connectivity (>=V3.6)
.REQUIREMENT Assembly
<NONE>
.REQUIREMENT Variables
windreamControlCenter, windreamIndexService, ServiceTest, Action
.REQUIREMENT Variables preSet
<NONE>
.REQUIREMENT Functions
Write-LogFile
.VERSION
1.1.0.1 / 22.11.2016
.PARAMETER Action
Determine which Action you want to perform <Stop|Restart|Start>. Default Value is <Restart>.
.PARAMETER ServiceTest
Set on $True, if Function should check for a running windream vfs Client Service. If it is and Service is stopped, Function will try to start Service. Default Value is $True.
.EXAMPLE
Restart-windreamClient
.EXAMPLE
Restart-windreamClient -Action Start
.EXAMPLE
Restart-windreamClient -Action Start -ServiceTest $False
#>
Param (
[Parameter(Mandatory=$False,HelpMessage='Determine which Action you want to perform <Stop|Restart|Start>. Default Value is "Restart".')]
[ValidateSet("Stop","Restart","Start")]
[String]$Action="Restart",
[Parameter(Mandatory=$False,HelpMessage='Set on $True, if Function should check for a running windream vfs Client Service. If it is and Service is stopped, Function will try to start Service. Default Value is $True.')]
[ValidateSet($True,$False)]
[Switch]$ServiceTest=$True
) #end param
#Clear Error Variable
$error.clear()
#Checking if "Write-LogFile" Module was loaded
IF (Get-Module -Name "Write-LogFile") {
Write-Host "DEBUG Info: Write-LogFile - Module exists."
#If Servie Test was enabled (by default true) check if windream vfs Service is running
IF ($ServiceTest -eq $True) {
Write-LogFile -LogLine " "
Write-LogFile -LogLine "Service Test is enabled!"
#Check if windream vfs Service is installed
Try {
[Object]$ServiceTest = $NULL
[Object]$ServiceTest = Get-Service -Name vfssvc -ErrorAction Stop
Write-LogFile -LogLine "Found Service: vfssvc"
Write-LogFile -LogLine "Service is currently: $((Get-Service -Name vfssvc).Status)"
} #end try
Catch {
Write-LogFile -LogLine "WARNING: windream Client seems not to be installed completely."
Write-LogFile -LogLine "Missing Service: vfssvc"
} #end catch
} #end if
#If Servie Test is disabled
ELSE {
Write-LogFile -LogLine " "
Write-LogFile -LogLine "Service Test is disabled!"
} #end else
#Try to create windream Objects
Try {
[Object]$windreamControlCenter = New-Object -ComObject "Wmcc.ControlCenter" -ErrorAction Stop
[Object]$windreamIndexService = New-Object -ComObject "WMIndexServer.WMIdxSvControl" -ErrorAction Stop
} #end try
Catch {
Write-Logfile -LogLine "Cannot create Object from windream Class Wmcc.ControlCenter or WMIndexServer.WMIdxSvControl!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
#If Function was called to Stop windream Client Components
IF ($Action -like "Stop") {
Write-LogFile -LogLine "Stop windream Client Components."
#Try to stop windream Client Components
Try {
Write-Logfile -LogLine "Stopping windream Client Components!"
$windreamControlCenter.StartVFSService(0) | Out-Null
$windreamIndexService.Shutdown() | Out-Null
$windreamControlCenter.ExitCC(0) | Out-Null
} #end try
Catch {
Write-Logfile -LogLine "Cannot stop windream Client Components!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
Return $True
} #end if
#If Function was called to Restart windream Client Components and Service Test was enabled
ELSEIF (($Action -like "Restart") -and ($ServiceTest -is [Object])) {
#Checking if windream vfs Service is running
IF ((Get-Service -Name vfssvc).Status -ne 'running') {
Write-LogFile -LogLine "Warning: windream vfs Service is not running!"
Try {
Write-Logfile -LogLine "Trying to Start/Restart the windream vfs Service!"
Stop-Service -Name vfssvc -ErrorAction SilentlyContinue
Start-Service -Name vfssvc -ErrorAction Stop
} #end try
Catch {
Write-Logfile -LogLine "Cannot Start/Restart windream vfs Service!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
} #end if
ELSE {
Write-Logfile -LogLine " "
Write-LogFile -LogLine "windream vfs Service is running!"
} #end else
Write-LogFile -LogLine "Restart windream Client Components."
#Try to stop windream Client Components
Try {
Write-Logfile -LogLine "Stopping windream Client Components!"
$windreamControlCenter.StartVFSService(0) | Out-Null
$windreamIndexService.Shutdown() | Out-Null
} #end try
Catch {
Write-Logfile -LogLine "Cannot stop windream Client Components!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
#Try to start windream Client Components
Try {
Write-Logfile -LogLine "Starting windream Client Components!"
$windreamControlCenter.StartVFSService(1) | Out-Null
$windreamIndexService.Start() | Out-Null
} #end try
Catch {
Write-Logfile -LogLine "Cannot start windream Client Components!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
Return $True
} #end elseif
#If Function was called to Restart windream Client Components and Service Test was disabled
ELSEIF (($Action -like "Restart") -and ($ServiceTest -is [Switch])) {
Write-LogFile -LogLine "Restart windream Client Components."
#Try to stop windream Client Components
Try {
Write-Logfile -LogLine "Stopping windream Client Components!"
$windreamControlCenter.StartVFSService(0) | Out-Null
$windreamIndexService.Shutdown() | Out-Null
} #end try
Catch {
Write-Logfile -LogLine "Cannot stop windream Client Components!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
#Try to start windream Client Components
Try {
Write-Logfile -LogLine "Starting windream Client Components!"
$windreamControlCenter.StartVFSService(1) | Out-Null
$windreamIndexService.Start() | Out-Null
} #end try
Catch {
Write-Logfile -LogLine "Cannot start windream Client Components!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
Return $True
} #end elseif
#If Function was called to Start windream Client Components and Service Test was enabled
ELSEIF (($Action -like "Start") -and ($ServiceTest -is [Object])) {
#Checking if windream vfs Service is running
IF ((Get-Service -Name vfssvc).Status -ne 'running') {
Write-LogFile -LogLine "Warning: windream vfs Service is not running!"
Try {
Write-Logfile -LogLine "Trying to Start/Restart the windream vfs Service!"
Stop-Service -Name vfssvc -ErrorAction SilentlyContinue
Start-Service -Name vfssvc -ErrorAction Stop
} #end try
Catch {
Write-Logfile -LogLine "Cannot Start/Restart windream vfs Service!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
} #end if
ELSE {
Write-Logfile -LogLine " "
Write-LogFile -LogLine "windream vfs Service is running!"
} #end else
Write-LogFile -LogLine "Start windream Client Components."
#Try to start windream Client Components
Try {
Write-Logfile -LogLine "Starting windream Client Components!"
$windreamControlCenter.StartVFSService(1) | Out-Null
$windreamIndexService.Start() | Out-Null
} #end try
Catch {
Write-Logfile -LogLine "Cannot start windream Client Components!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
Return $True
} #end elseif
#If Function was called to Start windream Client Components and Service Test was disabled
ELSEIF (($Action -like "Start") -and ($ServiceTest -is [Switch])) {
Write-LogFile -LogLine "Start windream Client Components."
#Try to start windream Client Components
Try {
Write-Logfile -LogLine "Starting windream Client Components!"
$windreamControlCenter.StartVFSService(1) | Out-Null
$windreamIndexService.Start() | Out-Null
} #end try
Catch {
Write-Logfile -LogLine "Cannot start windream Client Components!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
Return $True
} #end elseif
#If Function was called invalid Values, which should be not possible be the ValidateSet of the Function Parameters
ELSE {
Write-Logfile -LogLine "Function Call went wrong, please check the ValidateSet"
Write-Logfile -LogLine $Error
Return $False
} #end else
} #end if
ELSE {
Write-Host ""
Write-Host "DEBUG Info: Write-LogFile - Module does not exist!"
Write-Host "DEBUG Info: Please load the Module and try again, running this Function/Module!"
Write-Host "DEBUG Info: Exiting, because of this Issue."
EXIT
} #end else
} #end function

304
current/Modules/Archiv/Start-windreamSession-withLogging.psm1 Normal file
View File

@@ -0,0 +1,304 @@
Function Start-windreamSession-withLogging {
<#
.SYNOPSIS
Start a connection / Session with a windream Server.
.DESCRIPTION
To work in or with windream, you need to start a Session with a windream Server, to access its files, folders and indices.
The windream Drive letter which was retrived by running this module, will be set for the whole Script.
For Impersonation Login Methode, all these Parameters must be set: windreamServer, windreamDomain, windreamUserName and windreamUserPassword.
Function returns with the whole windreamSession Object if connection was successfully established, otherwise with a $False.
.REQUIREMENT General
PowerShell V3, windream Client Connectivity (>=V3.6)
.REQUIREMENT Assembly
<NONE>
.REQUIREMENT Variables
windreamServer, windreamVersion, windreamServerBrowser, windreamConnect, windreamSession
.REQUIREMENT Variables preSet
<NONE>
.REQUIREMENT Functions
Write-LogFile
.VERSION
1.1.0.0 / 21.11.2016
.PARAMETER windreamServer
Optional Parameter. Give Server Name of a specific windream Server, you want to connect with. Otherwise default will be choosen.
.PARAMETER windreamDomain
Optional Parameter. Give a Windows Domain (which is windream autorisiered) for Impersonation Login Methode. Otherwise current domain will be choosen.
.PARAMETER windreamUserName
Optional Parameter. Give a Windows User Name (who is windream autorisiered) for Impersonation Login Methode. Otherwise current User Name will be choosen.
.PARAMETER windreamUserPassword
Optional Parameter. Give the Password for the User name you set bevor in $windreamUserName for Impersonation Login Methode.
.PARAMETER windreamVersion
Optional Parameter. Give the minimum Version of windream, to make sure later function calls will work (Example 3.6, 4.0, ...).
.PARAMETER windream64Bit
Optional Parameter. Available since windream 6.0. Necessary, if following functions need 64Bit Integer Support (eg. GetWMObjectByIdEx64(WMEntity aWMEntity, int64 aWMObjectId)).
.EXAMPLE
Start-windreamSession
.EXAMPLE
Start-windreamSession -windreamVersion "3.6" -windream64Bit <$True|$False>
.EXAMPLE
Start-windreamSession -windreamServer <ServerName> -windreamDomain <domain.local> -windreamUserName <UserName> -windreamUserPassword <UserPassword>
.EXAMPLE
Start-windreamSession -windreamVersion "3.6" -windream64Bit <$True|$False> -windreamServer <ServerName> -windreamDomain <domain.local> -windreamUserName <UserName> -windreamUserPassword <UserPassword>
#>
[cmdletbinding()]
Param (
[Parameter(mandatory=$False,HelpMessage='Optional Parameter. Give Server Name of a specific windream Server, you want to connect with. Otherwise default will be choosen.')]
[AllowEmptyString()]
[String]$windreamServer=$NULL,
[Parameter(mandatory=$False,HelpMessage='Optional Parameter. Give a Windows Domain (which is windream autorisiered) for Impersonation Login Methode. Otherwise current domain will be choosen.')]
[ValidateNotNullOrEmpty()]
[String]$windreamDomain=$NULL,
[Parameter(mandatory=$False,HelpMessage='Optional Parameter. Give a Windows User Name (who is windream autorisiered) for Impersonation Login Methode. Otherwise current User Name will be choosen.')]
[ValidateNotNullOrEmpty()]
[String]$windreamUserName=$NULL,
[Parameter(mandatory=$False,HelpMessage='Optional Parameter. Give the Password for the User name you set bevor in $windreamUserName for Impersonation Login Methode.')]
[ValidateNotNullOrEmpty()]
[String]$windreamUserPassword=$NULL,
[Parameter(mandatory=$False,HelpMessage='Optional Parameter. Give the minimum Version of windream, to make sure later function calls will work (Example 3.6, 4.0, ...). Default Value is 4.0.')]
[ValidateNotNullOrEmpty()]
[String]$windreamVersion="4.0",
[Parameter(mandatory=$False,HelpMessage='Optional Parameter. Available since windream 6.0. Necessary, if following functions need 64Bit Integer Support (eg. GetWMObjectByIdEx64(WMEntity aWMEntity, int64 aWMObjectId)). Default Value is $False')]
[ValidateSet($True,$False)]
[Switch]$windream64Bit=$False
) #end param
#Clear Error Variable
$error.clear()
#Checking if "Write-LogFile" Module was loaded
IF (Get-Module -Name "Write-LogFile") {
Write-Host "DEBUG Info: Write-LogFile - Module exists."
#If Function was called without an explicite windream Server, try to get the default
IF (!$windreamServer) {
Write-Logfile -LogLine " "
Write-Logfile -LogLine "Function was called without a specific windream Server,"
Write-Logfile -LogLine "trying to find the default windream Server."
Try {
$windreamServerBrowser = New-Object -ComObject "WMOBrws.ServerBrowser" -ErrorAction Stop
$windreamServer = $windreamServerBrowser.GetCurrentServer()
Write-Logfile -LogLine "windream Server is: $windreamServer"
} #end try
Catch {
Write-Logfile -LogLine "Cannot create Object from windream Class WMOBrws.ServerBrowser!"
Write-Logfile -LogLine "And/Or unable the retrieve default windream Server!"
$windreamServer = $NULL
} #end catch
} #end if
#If Function was called with an explicite windream Server
ELSE {
Write-Logfile -LogLine " "
Write-Logfile -LogLine "Function was called with specific windream Server, trying to connect to $windreamServer"
Write-Logfile -LogLine "Remember: Since windream 4.0, this will only work if you are using Impersonation Login Methode."
Write-LogFile -Logline "windreamServer, windreamDomain, windreamUserName and windreamUserPassword"
Try {
$windreamServerBrowser = New-Object -ComObject "WMOBrws.ServerBrowser" -ErrorAction Stop
} #end try
Catch {
Write-Logfile -LogLine "Cannot create Object from windream Class WMOBrws.ServerBrowser!"
Return $False
} #end catch
} #end else
#Go ahead if windreamServer is not null and is reachable via network ping
IF (($windreamServer) -and (Test-Connection -ComputerName $windreamServer -Count 1 -ErrorAction SilentlyContinue)) {
Try {
$windreamConnect = New-Object -ComObject "Windream.WMConnect" -ErrorAction Stop
$windreamConnect.MinReqVersion = $windreamVersion
$windreamConnect.ClientSupports64BitID = $windream64Bit
Write-Logfile -LogLine "windream Connect created!"
} # end try
Catch {
Write-Logfile -LogLine "Cannot create Object from windream Class Windream.WMSession!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
Try {
$windreamSession = New-Object -ComObject "Windream.WMSession" #-ErrorAction Stop
Write-Logfile -LogLine "windream Session created!"
} #end try
Catch {
Write-Logfile -LogLine "Cannot create Object from windream Class Windream.WMSession!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
#Use Impersonation Login methode, if these three Parameters are set (-gt $NULL).
IF (($windreamUserName) -and ($windreamUserPassword) -and ($windreamDomain)) {
Try {
$windreamConnect.ModuleId = 9
$windreamImpersonation = New-Object -ComObject "WMOTool.WMUserIdentity" -ErrorAction Stop
$windreamImpersonation.aDomain = $windreamDomain
$windreamImpersonation.aPassword = $windreamUserPassword
$windreamImpersonation.aServerName = $windreamServer
$windreamImpersonation.aUserName = $windreamUserName
Try {
Write-Logfile -LogLine "Try to Login Impersonation"
$windreamSession = $windreamConnect.Login($windreamImpersonation)
} #end try
Catch {
Write-Logfile -LogLine "Cannot Login into windream Session!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
} #end try
Catch {
Write-Logfile -LogLine "Cannot create Object from windream Class WMOTool.WMUserIdentity!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
} #end if
#If Impersonation Login methode was not set, try to login with current username, domain and password
ELSE {
Try {
Write-Logfile -LogLine "Try to Login with current credentials."
$windreamConnect.LoginSession($windreamSession)
} #end try
Catch {
Write-Logfile -LogLine "Cannot Login into windream Session!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
} #end else
IF ($windreamSession.aLoggedin -eq $True) {
Write-Logfile -LogLine " "
Write-Logfile -LogLine "Connection established"
Write-Logfile -LogLine "You are connected with $($windreamConnect.ServerName) as $($windreamSession.aUser.aName)"
Write-Host "DEBUG Info: Do not forget to Logout Session after finished work."
$windreamDriveLetter = $windreamServerBrowser.GetServerValue($windreamServer, "DriveLetter", 0)
IF ($windreamDriveLetter) {
Write-Logfile -LogLine "The configured windream Drive Letter is: $windreamDriveLetter"
Set-Variable -Name windreamDriveLetter -Value $windreamDriveLetter -Scope Global -ErrorAction SilentlyContinue
} #end if
ELSE {
Write-Logfile -LogLine "WARNING: There is no windream Drive Letter configured."
Write-Logfile -LogLine "This could cause access problems!"
Write-Logfile -LogLine "Please check your windream Alias Settings!"
} #end else
Return $windreamSession
} #end if
ELSE {
Write-Logfile -LogLine " "
Write-Logfile -LogLine "Connection refused"
Write-Logfile -LogLine $Error
Return $False
} #end else
} #end if
#Stop if windream Server was unavailable
ELSE {
Write-Logfile -LogLine "Cannot retrieve windream Server to connect with or test connection failed!"
Write-Logfile -LogLine $Error
Return $False
} #end else
} #end if
ELSE {
Write-Host ""
Write-Host "DEBUG Info: Write-LogFile - Module does not exist!"
Write-Host "DEBUG Info: Please load the Module and try again, running this Function/Module!"
Write-Host "DEBUG Info: Exiting, because of this Issue."
EXIT
} #end else
} #end function

190
current/Modules/Archiv/Write-LogFile.psm1 Normal file
View File

@@ -0,0 +1,190 @@
Function Write-LogFile {
<#
.SYNOPSIS
Function will write a given String to a Logfile.
.DESCRIPTION
Just like the cmdlet Write-Host, this Function will display Output on the Console.
Parallel Output will be written into a designated LogFile.
It is recommended to init the LogPath Variable with $Null and the LogPaths Variable with a possible Path,
which has to be checked for accessible.
This is important, because if given Path was inaccessible (-> Access Test failed), Function will try some other Paths for accessible.
These are: The ScriptPath (\Logs) from, which triggerd this Function and $env:temp\Digital Data\$ScriptName\Logs.
After a successful Access Test, Function will set the Variable LogPath, with the first accessible Path tested.
Function will not give any Return Values, because if it is impossible to write a LogFile, Function will force the whole Script to exit.
.REQUIREMENT General
PowerShell V2
.REQUIREMENT Assembly
<NONE>
.REQUIREMENT Variables
PathTest, FileTest, Counter1, LogLine
.REQUIREMENT Variables preSet
LogFile, LogPath, LogPaths, ScriptName, ScriptPath
.REQUIREMENT Functions
<NONE>
.VERSION
Number: 2.0.0.0 / Date: 21.11.2016
.PARAMETER LogLine
Give the String you want to be written into the Logfile.
.EXAMPLE
Write-LogFile -LogLine "Write this in my Log, please."
.EXAMPLE
Write-LogFile -LogLine "Write this Variabel $Variable in my Log, please."
#>
[cmdletbinding()]
Param (
[Parameter(Position=0,Mandatory=$True,HelpMessage='Give the String you want to be written into the Logfile.')]
[AllowEmptyString()]
[String]$LogLine
) #end param
#Clear Error Variable
$error.clear()
# This if / else block is only for determine the LogPath
IF (!$LogPath) {
Write-Host ""
Write-Host "DEBUG Info: LogPath is currently not set!"
[Array]$LogPaths = $LogPaths
[Array]$LogPaths = ($LogPaths += "$ScriptPath\Logs","$env:temp\Digital Data\$ScriptName\Logs")
[int]$Counter1 = 0
DO {
#Determine the current Array object
[String]$LogPath = [Array]$($LogPaths[$Counter1])
Write-Host ""
Write-Host "DEBUG Info: Testing LogPath: $LogPath"
$PathTest = Test-Path -PathType Container "$LogPath"
#Check if Path already exists
IF ($PathTest -eq $True) {
Write-Host "DEBUG Info: LogPath seems already to exists: $LogPath"
} #end if
ELSE {
#If Path doesnt exist, try to create it!
Try {
Write-Host "DEBUG Info: Trying to create LogPath: $LogPath"
New-Item -ItemType Directory -Path "$LogPath" -Force -ErrorAction Stop | Out-Null
Write-Host "DEBUG Info: Trying seems to be successful!"
} #end try
Catch {
Write-Host "DEBUG Info: Cannot create LogPath or access denied!"
Write-Host $Error
} #end catch
} #end else
#Check again if path exists
$PathTest = Test-Path -PathType Container "$LogPath"
IF ($PathTest -eq $True) {
Try {
Write-Host "DEBUG Info: Trying to write a TestFile into the LogPath."
New-Item -ItemType File -Path "$LogPath\AccessTest.txt" -Force -ErrorAction Stop | Out-Null
Add-content "$LogPath\AccessTest.txt" -Value "This is a Test!" -Force -ErrorAction Stop | Out-Null
$FileTest = Test-Path -Path "$LogPath\AccessTest.txt" -PathType Leaf -ErrorAction Stop
Remove-Item -Path "$LogPath\AccessTest.txt" -Force -ErrorAction Stop | Out-Null
Write-Host "DEBUG Info: Write Test seems to be successful."
Set-Variable -Name LogPath -Value $LogPath -Scope Global -Force
} #end try
Catch {
Write-Host "DEBUG Info: Cannot write into LogPath or access denied!"
Write-Host $Error
} #end catch
} #end if
ELSE {
Write-Host "DEBUG Info: Cannot create LogPath or access denied!"
Write-Host $Error
} #end else
[int]$Counter1++ | Out-Null
} #end do
UNTIL ((($PathTest -eq $True) -and ($FileTest -eq $True)) -or ($Counter1 -eq $($LogPaths.count)) )
} #end if
ELSEIF ($LogPath) {
#Write-Host "DEBUG Info: LogPath was already been set!"
#Write-Host "DEBUG Info: LogPath is $LogPath"
} #end elseif
ELSE {
Write-Host "Unexpected Error!"
Write-Host $Error
Return $False
} #end else
IF ($LogPath) {
#After LogPath determination - try to log the string
Try {
Write-Host "$LogLine"
Add-content $LogPath\$LogFile -value "$(Get-Date -Format 'dd.MM.yyyy')-$(Get-Date -Format 'HH:mm:ss'): $LogLine" -ErrorAction Stop
} #end try
Catch {
Write-Host "DEBUG Info: Cannot write to LogFile!"
Write-Host "DEBUG Info: Exiting, because of this Issue."
Write-Host $Error
EXIT
} #end catch
} #end if
ELSE {
Write-Host "DEBUG Info: Cannot write to LogFile!"
Write-Host "DEBUG Info: Exiting, because of this Issue."
Write-Host $Error
EXIT
} #end else
} #end function

23
current/Modules/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
current/Modules/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
current/Modules/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

BIN
current/Modules/DD_LIB_Standards.dll Normal file
View File

Binary file not shown.

BIN
current/Modules/GdPicture.NET.14.Imaging.Rendering.Skia.64.dll Normal file
View File

Binary file not shown.

BIN
current/Modules/GdPicture.NET.14.Imaging.Rendering.Skia.dll Normal file
View File

Binary file not shown.

BIN
current/Modules/GdPicture.NET.14.filters.64.dll Normal file
View File

Binary file not shown.

BIN
current/Modules/GdPicture.NET.14.filters.dll Normal file
View File

Binary file not shown.

BIN
current/Modules/GdPicture.NET.14.image.gdimgplug.64.dll Normal file
View File

Binary file not shown.

BIN
current/Modules/GdPicture.NET.14.image.gdimgplug.dll Normal file
View File

Binary file not shown.

186176
current/Modules/GdPicture.NET.14.xml Normal file
View File

File diff suppressed because it is too large Load Diff

BIN
current/Modules/GdPicture_NET_14.dll Normal file
View File

Binary file not shown.

143
current/Modules/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
current/Modules/GetLeftPad.vbs Normal file
View File

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

77
current/Modules/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

268
current/Modules/GetWinLineDocInfoByAccountAndRunningNr.vbs Normal file
View File

@@ -0,0 +1,268 @@
Function GetWinLineDocInfoByAccountAndRunningNr(DocAccountAndRunningNr, PostingType, WinLineDocType)
'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_OrderWhere
'Set SQL Table and Query for DocMid. Default: "T026"
SQLTable_DocMid = "[T026]"
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_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_OrderWhere
IF (SQLTable_DocHead <> "") and (SQLQuery_DocHead <> "") and (PostingType <> "") and (WinLineDocType <> "") Then
Set SQLResult_DocHead = CWLStart.CurrentCompany.SearchRecord (SQLTable_DocHead, SQLQuery_DocHead)
If Err.Number <> 0 Then
MSGBOX "Error Code: "& Err.Number & vbCrlf & _
"Error Description: "& Err.Description,,"ERROR: Function GetWinLineDocInfoByAccountAndRunningNr Getting DocHead from DB Table "& SQLTable_DocHead
Err.Clear
Else
'If no line results
If SQLResult_DocHead.RowCount = -1 Then
If DebugMode = "Enabled" Then
MSGBOX "No Rows found, SQL: "& SQLQuery_DocHead,,"DEBUG - Info: Function GetWinLineDocInfoByAccountAndRunningNrDocHead from Database table "& SQLTable_DocHead
End If
Elseif SQLResult_DocHead.RowCount = 1 Then
If DebugMode = "Enabled" Then
MSGBOX "One Row found, SQL: "& SQLQuery_DocHead,,"DEBUG - Info: Function GetWinLineDocInfoByAccountAndRunningNrDocHead from Database table "& SQLTable_DocHead
End If
'Unique Key
DocAccountAndRunningNr = SQLResult_DocHead.value(0)
'Laufnumemr
DocRunningNr = SQLResult_DocHead.value(21)
'Druckstatus Angebot / Anfrage
DocPrintState1 = SQLResult_DocHead.value(22)
'Druckstatus Auftrag / Bestellung
DocPrintState2 = SQLResult_DocHead.value(23)
'Druckstatus Lieferschein
DocPrintState3 = SQLResult_DocHead.value(24)
'Druckstatus Rechnung
DocPrintState4 = SQLResult_DocHead.value(25)
'Number of the Offer ("Angebot")
DocOfferNr = SQLResult_DocHead.value(41)
'Number of the Order ("Angebot")
DocOrderNr = SQLResult_DocHead.value(42)
'Number of delivery note ("Lieferschein")
DocDeliveryNoteNr = SQLResult_DocHead.value(43)
'Number of the Invoice ("Rechung")
DocInvoiceNr = SQLResult_DocHead.value(52)
'When the doc ("Beleg") was created
DocCreated = SQLResult_DocHead.value(56)
'When the doc ("Beleg") was last changed
DocLastChange = SQLResult_DocHead.value(57)
'The ten "Belegkopfnotizen"
DocHeadText1 = SQLResult_DocHead.value(59)
DocHeadText2 = SQLResult_DocHead.value(60)
DocHeadText3 = SQLResult_DocHead.value(61)
DocHeadText4 = SQLResult_DocHead.value(62)
DocHeadText5 = SQLResult_DocHead.value(63)
DocHeadText6 = SQLResult_DocHead.value(64)
DocHeadText7 = SQLResult_DocHead.value(65)
DocHeadText8 = SQLResult_DocHead.value(66)
DocHeadText9 = SQLResult_DocHead.value(67)
DocHeadText10 = SQLResult_DocHead.value(68)
'The current type (1= Anfrage/Angebot; 2= Auftrag/Bestellung; 3= Lieferschein; 4=Rechnung)
DocType = SQLResult_DocHead.value(134)
DocComment = SQLResult_DocHead.value(163)
'msgbox SQLQuery_DocMid_MengeGeliefert
'msgbox SQLQuery_DocMid_RueckstandsMenge
Set SQLResult_DocMid_MengeGeliefert = CWLStart.CurrentCompany.Connection.Select(SQLQuery_DocMid_MengeGeliefert)
'msgbox SQLResult_DocMid_MengeGeliefert.value("MengeGeliefert")
Set SQLResult_DocMid_RueckstandsMenge = CWLStart.CurrentCompany.Connection.Select(SQLQuery_DocMid_RueckstandsMenge)
'msgbox SQLResult_DocMid_RueckstandsMenge.value("RueckstandsMenge")
IF DebugMode = "Enabled" THEN
End if
DocBackOrder = SQLResult_DocMid_RueckstandsMenge.value("RueckstandsMenge")
'msgbox SQLResult_DocMid_Rueckstandsmenge.value("RueckstandsMenge")
IF (PostingType = 1) Then
'If doc = "Angebot" or "Angebots-storno"
IF (WinLineDocType = 1) or (WinLineDocType = 11) then
DocNr = DocOfferNr
IF (WinLineDocType = 1) then
WinLineDocType = "Angebot (debitorisch)"
ElseIF (WinLineDocType = 11) then
WinLineDocType = "Angebot-Storno (debitorisch)"
End If
'If doc = "Auftrag" or "Auftrag-storno"
ElseIf (WinLineDocType = 2) or (WinLineDocType = 12) then
DocNr = DocOrderNr
IF (WinLineDocType = 2) then
WinLineDocType = "Auftrag (debitorisch)"
ElseIF (WinLineDocType = 12) then
WinLineDocType = "Auftrag-Storno (debitorisch)"
End If
'If doc = "Lieferschein" or "Lieferschein-storno" or "Teillieferschein"
ElseIf (WinLineDocType = 3) or (WinLineDocType = 13) or (WinLineDocType = -3) then
DocNr = DocDeliveryNoteNr
IF (DocBackOrder = 0) and (DocPrintState3 <> "L") then
WinLineDocType = "Lieferschein (debitorisch)"
ElseIF (DocBackOrder = 0) and (DocPrintState3 = "L") then
WinLineDocType = "Lieferschein-Storno (debitorisch)"
ElseIF (DocBackOrder <> 0) and (DocPrintState3 <> "L") then
WinLineDocType = "Teillieferschein (debitorisch)"
ElseIF (DocBackOrder <> 0) and (DocPrintState3 = "L") then
'Über die DB Werte ist eine Unterscheidung zwischen Lieferschein und Teillieferschein Storno nicht möglich!
WinLineDocType = "Teillieferschein-Storno (debitorisch)"
End If
'If doc = "Rechnung" or "Rechnungs-storno"
ElseIf (WinLineDocType = 4) or (WinLineDocType = 14) then
DocNr = DocInvoiceNr
IF (WinLineDocType = 4) and (DocPrintState4 <> "L") then
WinLineDocType = "Rechnung (debitorisch)"
ElseIF (WinLineDocType = 4) and (DocPrintState4 = "L") then
WinLineDocType = "Rechnung-Storno (debitorisch)"
ElseIF (WinLineDocType = 14) and (DocPrintState4 = "L") then
WinLineDocType = "Rechnung-Storno (debitorisch)"
End If
Else
IF DebugMode = "Enabled" THEN
MSGBOX "WinLineDocType is not configured!" & vbCrLf & _
"WinLineDocType: " & WinLineDocType, , "DEBUG - Info: Export Metadata"
END IF
End if
ElseIf (PostingType = 2) Then
'not implement
End if
'Array for the function to return
DIM DocInfo(250)
'Items like T25 c000 to c188
DocInfo(59) = DocCreated
DocInfo(60) = DocLastChange
DocInfo(63) = DocHeadText1
DocInfo(64) = DocHeadText2
DocInfo(65) = DocHeadText3
DocInfo(66) = DocHeadText4
DocInfo(67) = DocHeadText5
DocInfo(68) = DocHeadText6
DocInfo(69) = DocHeadText7
DocInfo(70) = DocHeadText8
DocInfo(71) = DocHeadText9
DocInfo(72) = DocHeadText10
DocInfo(139) = DocType
DocInfo(165) = DocComment
'Items beyond T25
DocInfo(200) = WinLineDocType
DocInfo(201) = DocNr
IF DebugMode = "Enabled" THEN
CRLF = chr(13)&chr(10)
msg = "Parameter:" & CRLF
For i = 0 To Ubound(DocInfo)
If (DocInfo(i) <> "") then
msg = msg & i & ".: " & DocInfo(i) & CRLF
end if
Next
msgbox msg ,, "Macro Name: " & CWLMacro.MName
End if
GetWinLineDocInfoByAccountAndRunningNr = DocInfo
Else
If DebugMode = "Enabled" Then
MSGBOX "To many Rows found, SQL: "& SQLQuery_DocHead,,"DEBUG - Info: Function GetWinLineDocInfoByAccountAndRunningNr DocHead from Database table "& SQLTable_DocHead
End If
GetWinLineDocInfoByAccountAndRunningNr = ""
End If
End If
Else
If DebugMode = "Enabled" Then
MSGBOX "Missing Parameter values, SQL: "& SQLQuery_DocHead,,"DEBUG - Info: Function GetWinLineDocInfoByAccountAndRunningNrDocHead from Database table " & SQLTable_DocHead
End If
GetWinLineDocInfoByAccountAndRunningNr = ""
End If
End Function

91
current/Modules/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
current/Modules/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

42
current/Modules/GetWinLineOriginalLineNumber.vbs Normal file
View File

@@ -0,0 +1,42 @@
' 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_OrderWhere
Set Result = Conn.Select(SQL)
If DEBUG_ON = True Then
AddDebugLine "Querying for Original Line Number.. " & vbNewline
AddDebugLine "Result Columns: " & Result
AddDebugLine "Result Rows: " & Result.RowCount
AddDebugLine "SQL: " & SQL
ShowDebugBox "GetWinLineOriginalLineNumber"
End If
If Result < 0 Then
If err <> 0 Then
Msgbox "Fehler bei Abfrage:" & vbNewline & err.description, vbExclamation, DEFAULT_TITLE & " - GetWinLineOriginalLineNumber"
Exit Function
Else
Msgbox "Abfrage lieferte keine Ergebnisse.", vbExclamation, DEFAULT_TITLE & " - GetWinLineOriginalLineNumber"
Exit Function
End If
End If
GetWinLineOriginalLineNumber = Result.Value("c078")
Else
If DEBUG_ON = True Then
AddDebugLine "Setting Original Line Number to 0.."
ShowDebugBox "GetWinLineOriginalLineNumber"
End If
GetWinLineOriginalLineNumber = "0"
End If
End Function

35
current/Modules/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
current/Modules/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

62
current/Modules/GetWinLineStorageLocation.vbs Normal file
View File

@@ -0,0 +1,62 @@
' Version Date: 07.01.2021
Function GetWinLineStorageLocation(ProductNumber, ProductSerialNumber, IsSerialNumberArticle)
Set Conn = CWLStart.CurrentCompany.Connection
' Get 'Lagerortstruktur' for Product
SQL = "SELECT c178 FROM [V021] (NOLOCK) WHERE c010 = '"& ProductNumber &"'"
Set Result = Conn.Select(SQL)
If Result.Value("c178") = 0 Then
GetWinLineStorageLocation = 0
Exit Function
End If
If IsSerialNumberArticle = 1 Then
Identifier = GetWinLineInternalProductNumber(ProductNumber, ProductSerialNumber)
Else
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)
ShowDebugBox "GetWinLineStorageLocation"
AddDebugLine "SQL Part 2: " & Mid(SQL, 750)
ShowDebugBox "GetWinLineStorageLocation"
End If
Set Result = Conn.Select(SQL)
If DEBUG_ON = True Then
AddDebugLine "Querying storage location... " & vbNewline
AddDebugLine "ArticleNumber: " & ProductNumber
AddDebugLine "SerialNumber: " & ProductSerialNumber
AddDebugLine "IsSerialNumber Article: " & IsSerialNumberArticle
AddDebugLine "Result Columns: " & Result
AddDebugLine "Result Rows: " & Result.RowCount
AddDebugLine "SQL: " & SQL
ShowDebugBox "GetWinLineStorageLocation"
End If
If Result = -1 Then
GetWinLineStorageLocation = 0
Else
GetWinLineStorageLocation = Result.Value("c000")
End If
End Function

BIN
current/Modules/Load-EMLFile-withLogging.psm1 Normal file
View File

Binary file not shown.

BIN
current/Modules/Load-PowerShellModule.ps1 Normal file
View File

Binary file not shown.

292
current/Modules/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
'------------------------------------------------------------------------------------------------------

291
current/Modules/MoveOrCopy-Item-withLogging.psm1 Normal file
View File

@@ -0,0 +1,291 @@
Function MoveOrCopy-Item-withLogging {
<#
.SYNOPSIS
Function will copy or move File(s).
.DESCRIPTION
If File already exists in target Path new File will get a Version ~2.
.REQUIREMENT General
PowerShell V2
.REQUIREMENT Assembly
<NONE>
.REQUIREMENT Variables
Datei, Datei1, DateiName, DateiEndung, DateiTest, DateiVersion,ZielPath, MoveorCopy, SourcePath
.REQUIREMENT Variables preSet
VersionSeperator
.REQUIREMENT Functions
Write-Logfile
.VERSION
1.2.1.1 / 17.12.2016
.PARAMETER SourceFile
Give the full Path and Filename to one File.
.PARAMETER DestinationPath
Give the Target Path you want to move or copy the specified File.
.PARAMETER Action
Determine which Action you want to perform <Copy|Move>. Default Value is "Copy".
.PARAMETER NewFileName
Give a String, which get the new Name of the File you are moving.
.PARAMETER NewFileName_prefix
Give a String, which get the new prefix Name of the File you are moving.
.PARAMETER NewFileName_suffix
Give a String, which get the new suffix Name of the File you are moving.
.EXAMPLE
MoveOrCopy-Item-withLogging -SourceFile "E:\Quellpfad\Test.txt" -DestinationPath "E:\Zielpfad" -move_or_copy move
.EXAMPLE
MoveOrCopy-Item-withLogging -SourceFile "E:\Quellpfad\Test.txt" -DestinationPath "E:\Zielpfad" -move_or_copy copy
#>
Param (
[Parameter(Position=0,Mandatory=$True,HelpMessage='Give the full Path and Filename to one File.')]
[ValidateNotNullOrEmpty()]
[String]$SourceFile,
[Parameter(Mandatory=$True,HelpMessage='Give the Target Path you want to move or copy the specified File.')]
[ValidateNotNullOrEmpty()]
[String]$DestinationPath,
[Parameter(Mandatory=$True,HelpMessage='Determine which Action you want to perform <Copy|Move>. Default Value is "Copy".')]
[ValidateSet("copy","move")]
[String]$Action="copy",
[Parameter(Mandatory=$False,HelpMessage='Give a String, which get the new Name of the File you are moving.')]
[ValidateNotNullOrEmpty()]
[String]$NewFileName,
[Parameter(Mandatory=$False,HelpMessage='Give a String, which get the new prefix Name of the File you are moving.')]
[ValidateNotNullOrEmpty()]
[String]$NewFileName_prefix,
[Parameter(Mandatory=$False,HelpMessage='Give a String, which get the new suffix Name of the File you are moving.')]
[ValidateNotNullOrEmpty()]
[String]$NewFileName_suffix
) #end param
#Clear Error Variable
$error.clear()
#Checking if "Write-LogFile" Module was loaded
IF (Get-Module -Name "Write-LogFile") {
$FileTest = Test-Path "$SourceFile" -PathType Leaf
IF ($Filetest -eq 'True') {
Write-Logfile -LogLine ""
$SourcePath = ([System.IO.Path]::GetDirectoryName($SourceFile).ToString())
$FileName = ([System.IO.Path]::GetFileName($SourceFile).ToString())
$FileName_noExt = ([System.IO.Path]::GetFileNameWithoutExtension($SourceFile).ToString())
$FileExtension = ([System.IO.Path]::GetExtension($SourceFile).ToString())
IF (!$VersionSeperator) {
Write-Logfile -LogLine "ERROR: Wrong Function call."
Write-Logfile -LogLine "INFO: Variable VersionSeperator is not valid."
Write-Logfile -LogLine "Application was unplannd terminated."
EXIT
} #end if
IF ($newfilename) {
Write-Logfile -LogLine "New Filename ($newfilename) will replace the old one."
Set-Variable -Name Filename -Value ($newfilename+$FileExtension)
Set-Variable -Name Filename_noExt -Value ($newfilename)
} #end if
IF ($newfilename_prefix) {
Write-Logfile -LogLine "New prefix ($newfilename_prefix) has been set for file."
Set-Variable -Name Filename -Value (($newfilename_prefix+$FileSeperator+$Filename) -replace "$FileSeperator$FileSeperator","$FileSeperator")
Set-Variable -Name Filename_noExt -Value (($newfilename_prefix+$FileSeperator+$Filename_noExt) -replace "$FileSeperator$FileSeperator","$FileSeperator")
} #end if
IF ($newfilename_suffix) {
Write-Logfile -LogLine "New suffix ($newfilename_suffix) has been set for file."
Set-Variable -Name FileName -Value (($Filename -split "$VersionSeperator")[0])
Set-Variable -Name FileName_noExt -Value (($Filename_noExt -split "$VersionSeperator")[0])
Set-Variable -Name Filename -Value (($Filename_noExt+$FileSeperator+$newfilename_suffix+$FileExtension) -replace "$FileSeperator$FileSeperator","$FileSeperator")
Set-Variable -Name Filename_noExt -Value (($Filename_noExt+$FileSeperator+$newfilename_suffix) -replace "$FileSeperator$FileSeperator","$FileSeperator")
} #end if
# Does file already exist in the target directory?
$FileTest = Test-Path "$DestinationPath\$FileName" -PathType Leaf
IF ($Filetest -eq 'True') {
Write-Logfile -LogLine "The File ($Filename) already exists in the target directory, starting Version Check."
[String]$FileNameSplit = ($Filename_noExt -split "$VersionSeperator")
[Int]$FileVersion = $NULL
[Int]$FileVersion = $FileNameSplit[1]
# Has the new file already a Version tag?
IF ($FileVersion -eq 0) {
Write-Host "DEBUG Info: Sourcefile includes no VersionSeperator."
# To skip Version ~1.
$FileVersion++
} #end if
ELSE {
Write-Host "DEBUG Info: Sourcefile includes VersionSeperator."
$FileName_noExt = $FilenameSplit[0]
} #end else
DO {
Write-Host "DEBUG Info: Count file version:" $FileVersion; $FileVersion++
}
WHILE (($Filetest = Test-Path -Path "$DestinationPath\$FileName_noExt$VersionSeperator$FileVersion$FileExtension") -eq 'True')
# code block for the copy or move process
Try {
Set-Variable -Name FileHash_befor -Value (Get-FileHash -Path "$SourceFile" -Algorithm SHA512 | select Hash | Foreach-Object {$_ -replace "@{Hash=", ""} | Foreach-Object {$_ -replace "}", ""})
Set-Variable -Name FileTemp -Value (Copy-Item -Path "$SourceFile" -Destination "$DestinationPath\$Timestamp3`_$FileName" -PassThru -Force)
Write-Logfile -LogLine "The $Action command has been completed."
Set-Variable -Name FileFinal -Value (Rename-Item -Path "$FileTemp" -NewName "$FileName_noExt$VersionSeperator$FileVersion$FileExtension" -PassThru -Force )
Write-Logfile -LogLine "File was renamed to: $FileName_noExt$VersionSeperator$FileVersion$FileExtension, and is now transferd to: $DestinationPath."
Set-Variable -Name FileHash_after -Value (Get-FileHash -Path "$FileFinal" -Algorithm SHA512 | select Hash | Foreach-Object {$_ -replace "@{Hash=", ""} | Foreach-Object {$_ -replace "}", ""})
Write-Host "DEBUG Info: Hash Value before: $FileHash_befor"
Write-Host "DEBUG Info: Hash Value after: $FileHash_after"
IF ($Action -eq 'move') {
Write-Host "DEBUG Info: Moving action was choosen, will delete source file."
IF ($FileHash_befor -eq $FileHash_after) {
Try {
Remove-Item -Path "$SourceFile" -Force
} #end try
Catch {
Write-Logfile -LogLine "Error removing the source file."
} #end catch
} #end if
ELSE {
Write-Logfile -LogLine "HASH Value does mismatch!"
Write-Logfile -LogLine "Aborting delete operation!"
} #end else
} #end if
Return $FileFinal.Fullname
} #end try
Catch {
Write-Logfile -LogLine "Error at $Action command, processing file: $SourceFile"
Write-Logfile -LogLine "Please check your privileges"
exit
} #end catch
} #end if
ELSE {
Set-Variable -Name FileHash_befor -Value (Get-FileHash -Path "$SourceFile" -Algorithm SHA512 | select Hash | Foreach-Object {$_ -replace "@{Hash=", ""} | Foreach-Object {$_ -replace "}", ""})
Set-Variable -Name FileFinal -Value (Copy-Item -Path "$SourceFile" -Destination "$DestinationPath\$FileName" -PassThru -Force)
Set-Variable -Name FileHash_after -Value (Get-FileHash -Path "$FileFinal" -Algorithm SHA512 | select Hash | Foreach-Object {$_ -replace "@{Hash=", ""} | Foreach-Object {$_ -replace "}", ""})
Write-Logfile -LogLine "The $Action command has been completed for file: $SourceFile"
Write-Logfile -LogLine "And is now transferd to: $DestinationPath"
Write-Host "DEBUG Info: Hash Value before: $FileHash_befor"
Write-Host "DEBUG Info: Hash Value after: $FileHash_after"
IF ($Action -eq 'move') {
Write-Host "DEBUG Info: Moving action was choosen, will delete source file."
IF ($FileHash_befor -eq $FileHash_after) {
Try {
Remove-Item -Path "$SourceFile" -Force
} #end try
Catch {
Write-Logfile -LogLine "Error removing the source file."
} #end catch
} #end if
ELSE {
Write-Logfile -LogLine "HASH Value does mismatch!"
Write-Logfile -LogLine "Aborting delete operation!"
} #end else
} #end if
ELSEIF ($Action -eq 'copy') {
Write-Host "DEBUG Info: Coping action was choosen, will not delete original file."
} #end elseif
Return $FileFinal.Fullname
} #end else
} #end if
ELSE {
Write-LogFile -LogLine "Cannot find Source File!"
Return $False
} #end else
} #end if
ELSE {
Write-Host ""
Write-Host "DEBUG Info: Write-LogFile - Module does not exist!"
Write-Host "DEBUG Info: Please load the Module and try again, running this Function/Module!"
Write-Host "DEBUG Info: Exiting, because of this Issue."
EXIT
} #end else
} #end function

BIN
current/Modules/New-ComplexPassword-withLogging.psm1 Normal file
View File

Binary file not shown.

19
current/Modules/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

BIN
current/Modules/Read-ConfigFile.psm1 Normal file
View File

Binary file not shown.

BIN
current/Modules/Read-ConfigFile2.psm1 Normal file
View File

Binary file not shown.

122
current/Modules/Remove-Item-withLogging.psm1 Normal file
View File

@@ -0,0 +1,122 @@
Function Remove-Item-withLogging {
<#
.SYNOPSIS
Function will delete Items selected by Path, Name and Age.
.DESCRIPTION
Function will delete Items selected by Path, Name and Age, with logging this.
For a successful performed deletion, Function will Return $True, for unccessful $False.
.REQUIREMENT General
PowerShell V2
.REQUIREMENT Variables
Path, FileKeepTime, FileBaseName, Item, Items
.REQUIREMENT Assembly
<NONE>
.REQUIREMENT Functions
Write-LogFile
.VERSION
Number: 1.1.1.1 / Date: 25.04.2017
.PARAMETER Path
Give the Full Path, where the Item(s) located, which should be deleted.
.PARAMETER FileKeepTime
Give the time in Days, which Items should be deleted, which are older than...
.PARAMETER FileBaseName
Give the <Filename> which will be selected, the Item(s) to delete. Given <Filename> will be set with Wildcards: *<Filename>*.
.PARAMETER FileExtension
Give the FileExtension which Files will be selected for deletion (Default: log).
.EXAMPLE
Remove-Item-withLogging -Path "E:\LogFiles" -FileKeepTime 5 -FileBaseName Filename
#>
[cmdletbinding()]
Param (
[Parameter(Mandatory=$True,HelpMessage='Give the Full Path, where the Item(s) located, which should be deleted.')]
[ValidateNotNullOrEmpty()]
[String]$Path=$NULL,
[Parameter(Mandatory=$True,HelpMessage='Give the time in Days, which Item(s) should be deleted, which are older than...')]
[ValidateRange(0,1000)]
[Int]$FileKeepTime=$NULL,
[Parameter(Mandatory=$True,HelpMessage='Give the Filename which will be selected, the Item(s) to delete. Given <Filename> will be set with Wildcards: *<Filename>*.')]
[ValidateNotNullOrEmpty()]
[String]$FileBaseName=$NULL,
[Parameter(Mandatory=$False,HelpMessage='Give the FileExtension which Files will be selected for deletion (Default: log).')]
[ValidateNotNullOrEmpty()]
[String]$FileExtension="log"
) #end param
#Checking if "Write-LogFile" Module was loaded
IF (Get-Module -Name "Write-LogFile") {
IF ($FileKeepTime -gt 0) {
Write-Logfile -LogLine "Files should be removed which are older than $FileKeepTime Day(s)."
[Array]$Items = (Get-ChildItem -Path "$Path\*" -Filter *.$FileExtension | where {$_.Name -like "*$FileBaseName*" -and $_.lastwritetime -lt $((Get-Date).AddDays(-$FileKeepTime)) -and -not $_.psiscontainer})
IF ($Items.count -le 0) {
Write-Logfile -LogLine "Found no old Files."
Return $False
} #end if
ELSE {
Write-Logfile -LogLine "Deleting old Files (Found: $($Items.count)) :"
Try {
$Items | Remove-Item -Path $Item -Force -Verbose -ErrorAction Stop
Write-Logfile -LogLine "Files were removed!"
Return $True
} #end try
Catch {
Write-Logfile -LogLine "Cannot remove Files!"
Write-Logfile -LogLine "Please check your privileges!"
Return $False
} #end catch
} #end else
} #end if
ELSE {
Write-Logfile -LogLine "You disabled File deletion, they all will be kept."
Return $False
} #end else
} #end if
ELSE {
Write-Host ""
Write-Host "DEBUG Info: Write-LogFile - Module does not exist!"
Write-Host "DEBUG Info: Please load the Module and try again, running this Function/Module!"
Write-Host "DEBUG Info: Exiting, because of this Issue."
EXIT
} #end else
} #end function

BIN
current/Modules/Remove-SpecialCharacter-withLogging.psm1 Normal file
View File

Binary file not shown.

41
current/Modules/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

367
current/Modules/Restart-windreamClient-withLogging.psm1 Normal file
View File

@@ -0,0 +1,367 @@
Function Restart-windreamClient-withLogging {
<#
.SYNOPSIS
Restart windream Client Components via COM Interface
.DESCRIPTION
If Connection to the windream Server gets interrupted (network loss, eg.), it is neccessery to restart the Client Components.
Otherwise you can Stop or Start Client Components with this Function.
For a successful performed Action, Function will Return $True, for unccessful $False.
.REQUIREMENT General
PowerShell V3, windream Client Connectivity (>=V3.6)
.REQUIREMENT Assembly
<NONE>
.REQUIREMENT Variables
windreamControlCenter, windreamIndexService, ServiceTest, Action
.REQUIREMENT Variables preSet
<NONE>
.REQUIREMENT Functions
Write-LogFile
.VERSION
1.2.0.0 / 28.09.2018
.PARAMETER Action
Determine which Action you want to perform <Stop|Restart|Start>. Default Value is <Restart>.
.PARAMETER ServiceTest
Set on $True, if Function should check for a running windream vfs Client Service. If it is and Service is stopped, Function will try to start Service. Default Value is $True.
.PARAMETER StartTimeout
.EXAMPLE
Restart-windreamClient
.EXAMPLE
Restart-windreamClient -Action Start
.EXAMPLE
Restart-windreamClient -Action Start -ServiceTest $False
#>
Param (
[Parameter(Position=0,Mandatory=$False,HelpMessage='Determine which Action you want to perform <Stop|Restart|Start>. Default Value is "Restart".')]
[ValidateSet("Stop","Restart","Start")]
[String]$Action="Restart",
[Parameter(Position=1,Mandatory=$False,HelpMessage='Set on $True, if Function should check for a running windream vfs Client Service. If it is and Service is stopped, Function will try to start Service. Default Value is $True.')]
[ValidateSet($True,$False)]
[Switch]$ServiceTest=$True,
[Parameter(Position=2,Mandatory=$False,HelpMessage='Give the Timeout limit in Seconds for the windream Start/Restart procedure, ValidateRange(1 - 300). Default Value is "10".')]
[ValidateRange(1,300)]
[INT]$StartTimeout=10
) #end param
#Clear Error Variable
$error.clear()
#Checking if "Write-LogFile" Module was loaded
IF (Get-Module -Name "Write-LogFile") {
Write-Host "DEBUG Info: Write-LogFile - Module exists."
#If Servie Test was enabled (by default true) check if windream vfs Service is running
IF ($ServiceTest -eq $True) {
Write-LogFile -LogLine " "
Write-LogFile -LogLine "Service Test is enabled!"
#Check if windream vfs Service is installed
Try {
[Object]$ServiceTest = $NULL
[Object]$ServiceTest = Get-Service -Name vfssvc -ErrorAction Stop
Write-LogFile -LogLine "Found Service: vfssvc"
Write-LogFile -LogLine "Service is currently: $((Get-Service -Name vfssvc).Status)"
} #end try
Catch {
Write-LogFile -LogLine "WARNING: windream Client seems not to be installed completely."
Write-LogFile -LogLine "Missing Service: vfssvc"
} #end catch
} #end if
#If Servie Test is disabled
ELSE {
Write-LogFile -LogLine " "
Write-LogFile -LogLine "Service Test is disabled!"
} #end else
#Try to create windream Objects
Try {
[Object]$windreamControlCenter = New-Object -ComObject "Wmcc.ControlCenter" -ErrorAction Stop
[Object]$windreamIndexService = New-Object -ComObject "WMIndexServer.WMIdxSvControl" -ErrorAction Stop
} #end try
Catch {
Write-Logfile -LogLine "Cannot create Object from windream Class Wmcc.ControlCenter or WMIndexServer.WMIdxSvControl!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
#If Function was called to Stop windream Client Components
IF ($Action -like "Stop") {
Write-LogFile -LogLine "Stop windream Client Components."
#Try to stop windream Client Components
Try {
Write-Logfile -LogLine "Stopping windream Client Components!"
$windreamControlCenter.StartVFSService(0) | Out-Null
$windreamIndexService.Shutdown() | Out-Null
$windreamControlCenter.ExitCC(0) | Out-Null
} #end try
Catch {
Write-Logfile -LogLine "Cannot stop windream Client Components!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
Return $True
} #end if
#If Function was called to Restart windream Client Components and Service Test was enabled
ELSEIF (($Action -like "Restart") -and ($ServiceTest -is [Object])) {
#Checking if windream vfs Service is running
IF ((Get-Service -Name vfssvc).Status -ne 'running') {
Write-LogFile -LogLine "Warning: windream vfs Service is not running!"
Try {
Write-Logfile -LogLine "Trying to Start/Restart the windream vfs Service!"
Stop-Service -Name vfssvc -ErrorAction SilentlyContinue
Start-Service -Name vfssvc -ErrorAction Stop
} #end try
Catch {
Write-Logfile -LogLine "Cannot Start/Restart windream vfs Service!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
} #end if
ELSE {
Write-Logfile -LogLine " "
Write-LogFile -LogLine "windream vfs Service is running!"
} #end else
Write-LogFile -LogLine "Restart windream Client Components."
#Try to stop windream Client Components
Try {
Write-Logfile -LogLine "Stopping windream Client Components!"
$windreamControlCenter.StartVFSService(0) | Out-Null
$windreamIndexService.Shutdown() | Out-Null
} #end try
Catch {
Write-Logfile -LogLine "Cannot stop windream Client Components!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
#Try to start windream Client Components
Try {
Write-Logfile -LogLine "Starting windream Client Components!"
$windreamControlCenter.StartVFSService(1) | Wait-Process -Timeout $StartTimeout | Out-Null
$windreamIndexService.Start() | Out-Null
} #end try
Catch {
Write-Logfile -LogLine "Cannot start windream Client Components!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
Return $True
} #end elseif
#If Function was called to Restart windream Client Components and Service Test was disabled
ELSEIF (($Action -like "Restart") -and ($ServiceTest -is [Switch])) {
Write-LogFile -LogLine "Restart windream Client Components."
#Try to stop windream Client Components
Try {
Write-Logfile -LogLine "Stopping windream Client Components!"
$windreamControlCenter.StartVFSService(0) | Out-Null
$windreamIndexService.Shutdown() | Out-Null
} #end try
Catch {
Write-Logfile -LogLine "Cannot stop windream Client Components!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
#Try to start windream Client Components
Try {
Write-Logfile -LogLine "Starting windream Client Components!"
$windreamControlCenter.StartVFSService(1) | Wait-Process -Timeout $StartTimeout | Out-Null
$windreamIndexService.Start() | Out-Null
} #end try
Catch {
Write-Logfile -LogLine "Cannot start windream Client Components!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
Return $True
} #end elseif
#If Function was called to Start windream Client Components and Service Test was enabled
ELSEIF (($Action -like "Start") -and ($ServiceTest -is [Object])) {
#Checking if windream vfs Service is running
IF ((Get-Service -Name vfssvc).Status -ne 'running') {
Write-LogFile -LogLine "Warning: windream vfs Service is not running!"
Try {
Write-Logfile -LogLine "Trying to Start/Restart the windream vfs Service!"
Stop-Service -Name vfssvc -ErrorAction SilentlyContinue
Start-Service -Name vfssvc -ErrorAction Stop
} #end try
Catch {
Write-Logfile -LogLine "Cannot Start/Restart windream vfs Service!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
} #end if
ELSE {
Write-Logfile -LogLine " "
Write-LogFile -LogLine "windream vfs Service is running!"
} #end else
Write-LogFile -LogLine "Start windream Client Components."
#Try to start windream Client Components
Try {
Write-Logfile -LogLine "Starting windream Client Components!"
$windreamControlCenter.StartVFSService(1) | Wait-Process -Timeout $StartTimeout | Out-Null
$windreamIndexService.Start() | Out-Null
} #end try
Catch {
Write-Logfile -LogLine "Cannot start windream Client Components!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
Return $True
} #end elseif
#If Function was called to Start windream Client Components and Service Test was disabled
ELSEIF (($Action -like "Start") -and ($ServiceTest -is [Switch])) {
Write-LogFile -LogLine "Start windream Client Components."
#Try to start windream Client Components
Try {
Write-Logfile -LogLine "Starting windream Client Components!"
$windreamControlCenter.StartVFSService(1) | Wait-Process -Timeout $StartTimeout | Out-Null
$windreamIndexService.Start() | Out-Null
} #end try
Catch {
Write-Logfile -LogLine "Cannot start windream Client Components!"
Write-Logfile -LogLine $Error
Return $False
} #end catch
Return $True
} #end elseif
#If Function was called invalid Values, which should be not possible be the ValidateSet of the Function Parameters
ELSE {
Write-Logfile -LogLine "Function Call went wrong, please check the ValidateSet"
Write-Logfile -LogLine $Error
Return $False
} #end else
} #end if
ELSE {
Write-Host ""
Write-Host "DEBUG Info: Write-LogFile - Module does not exist!"
Write-Host "DEBUG Info: Please load the Module and try again, running this Function/Module!"
Write-Host "DEBUG Info: Exiting, because of this Issue."
EXIT
} #end else
} #end function

20
current/Modules/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
current/Modules/SetWinLineDocProductStorage.vbs Normal file
View File

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

4
current/Modules/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
current/Modules/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
current/Modules/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
current/Modules/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
current/Modules/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

18
current/Modules/Sicherungen/Modules_20230623/AddDebugLine.vbs Normal file
View File

@@ -0,0 +1,18 @@
' AddDebugLine(Message: String)
' ----------------------------------------------------------------------------
' Fügt der DEBUG_MESSAGE eine neue Zeile hinzu
'
' Returns: -
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 20.08.2020 / XX
' Version Date / Editor: 20.08.2020 / XX
' Version Number: 1.0.0.0
Sub AddDebugLine(Message)
DEBUG_MESSAGE = DEBUG_MESSAGE & Message & vbNewLine
End Sub

19
current/Modules/Sicherungen/Modules_20230623/AddTwoDimArrayRow.vbm Normal file
View File

@@ -0,0 +1,19 @@
' AddTwoDimArrayRow(arr: Array)
' ----------------------------------------------------------------------------
' Fügt an ein zweidimensionales Array eine Zeile an.
' Wichtig: Die Spalten müssen die erste Dimension sein!
'
' Returns: -
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 18.02.2021 / JJ
' Version Date / Editor: 18.02.2021 / JJ
' Version Number: 3.0.0.0
Sub AddTwoDimArrayRow(Byref arr)
ReDim Preserve arr(UBound(arr, 1), UBound(arr, 2) + 1)
End Sub

49
current/Modules/Sicherungen/Modules_20230623/ConvertFromSecureString.vbs Normal file
View File

@@ -0,0 +1,49 @@
' ConvertFromSecureString(Ciphertext : String)
' ----------------------------------------------------------------------------
' Gibt den entschlüsselten String zurück
'
' Source: https://gist.github.com/albert1205/c8430b5bfa505f9308e4fa789b9b1d7f
'
' Returns: ConvertFromSecureString : String
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 26.08.2020 / XX
' Version Date / Editor: 26.08.2020 / XX
' Version Number: 1.0.0.0
Public Function ConvertFromSecureString(Ciphertext)
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

55
current/Modules/Sicherungen/Modules_20230623/ConvertToSecureString.vbs Normal file
View File

@@ -0,0 +1,55 @@
' ConvertToSecureString(Plaintext : String)
' ----------------------------------------------------------------------------
' Verschlüsselt einen String
'
' Source: https://gist.github.com/albert1205/c8430b5bfa505f9308e4fa789b9b1d7f
'
' Returns: ConvertToSecureString : String
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 26.08.2020 / XX
' Version Date / Editor: 26.08.2020 / XX
' Version Number: 1.0.0.0
Public Function ConvertToSecureString(Plaintext)
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

68
current/Modules/Sicherungen/Modules_20230623/CreateDateDirectory.vbm Normal file
View File

@@ -0,0 +1,68 @@
' ArticleExists(Identifier: String)
' ----------------------------------------------------------------------------
' Findet Artikelnummer anhand von versch. Kriterien
' - Artikel-Nummer, Alternative Artikel-Nummer, EAN-Code, Seriennummer
' - Gibt die Zeile im Grid zurück in der Artikel das erste Mal gefunden wurde
'
' Returns: ArticleExists: Int
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 02.02.2022 / JJ/MP
' Version Date / Editor: 22.03.2022 / JJ/MP
' Version Number: 1.0.0.0
Function CreateDateDirectory(BasePath)
Set oFileSys = CreateObject("Scripting.FileSystemObject")
NowDate = Date
NowYear = Year(NowDate)
NowMonth = PadZero(Month(NowDate))
NowDay = PadZero(Day(NowDate))
If Right(BasePath, 1) <> "\" Then
BasePath = BasePath & "\"
End If
YearPath = BasePath & NowYear & "\"
MonthPath = YearPath & NowMonth & "\"
DayPath = MonthPath & NowDay
If Not oFileSys.FolderExists(YearPath) Then
oFileSys.CreateFolder(YearPath)
End If
If Not oFileSys.FolderExists(MonthPath) Then
oFileSys.CreateFolder(MonthPath)
End If
If Not oFileSys.FolderExists(DayPath) Then
oFileSys.CreateFolder(DayPath)
End If
CreateDateDirectory = DayPath
End Function
Function PadZero(Num)
If Len(Num) = 1 Then
PadZero = "0" & Num
Else
PadZero = Num
End If
End Function
Function GetRelativDateDirectoryName()
GetRelativDateDirectoryName = ""
NowDate = Date
NowYear = Year(NowDate)
NowMonth = PadZero(Month(NowDate))
NowDay = PadZero(Day(NowDate))
GetRelativDateDirectoryName = NowYear & "\" & NowMonth & "\" & NowDay
End Function

18
current/Modules/Sicherungen/Modules_20230623/GetLeftPad.vbs Normal file
View File

@@ -0,0 +1,18 @@
' GetLeftPad(Value)
' ----------------------------------------------------------------------------
' KURZBESCHREIBUNG
'
' Returns: GetLeftPad : String
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 10.08.2020 / MK
' Version Date / Editor: 10.08.2020 / MK
' Version Number: 1.0.0.0
Function GetLeftPad(Value)
GetLeftPad = Right("0" & Value, 2)
End Function

80
current/Modules/Sicherungen/Modules_20230623/GetWinLineDocDeliveryNoteByUnsplittedProducts.vbs Normal file
View File

@@ -0,0 +1,80 @@
' GetWinLineDocDeliveryNoteByUnsplittedProducts(ProductNumber : String, WinLineMandatorNr : String, WinLineYear : Int)
' ----------------------------------------------------------------------------
' Dieses Modul fndet die Eingangsbelege zu einer ProductNumber
'
' Returns: SQL-Results
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 15.09.2020 / JJ
' Version Date / Editor: 05.10.2021 / MP/JJ
' Version Number: 3.0.0.6
Function GetWinLineDocDeliveryNoteByUnsplittedProducts(ProductNumber, WinLineMandatorNr, WinLineYear)
Dim Conn, Result
Set Conn = CWLStart.CurrentCompany.Connection
If (ProductNumber <> "") and (WinLineMandatorNr <> "") and (WinLineYear <> "") Then
'c999 = DeliveryNr
'c998 = InvoiceNr
'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 <= '"& ProductNumber &"') "
SQL = SQL & ") as [c994] " ' Summe aller gefundenen gelieferten Mengen
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 "
Set Result = Conn.Select(SQL)
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

281
current/Modules/Sicherungen/Modules_20230623/GetWinLineDocInfoByAccountAndRunningNr.vbs Normal file
View File

@@ -0,0 +1,281 @@
' GetWinLineDocInfoByAccountAndRunningNr(DocAccountAndRunningNr : String, PostingType : String, WinLineDocType : String)
' ----------------------------------------------------------------------------
' KURZBESCHREIBUNG
'
' Returns: GetWinLineDocInfoByAccountAndRunningNr : String
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 08.01.2021 / XX
' Version Date / Editor: 08.01.2021 / XX
' Version Number: 1.0.0.0
Function GetWinLineDocInfoByAccountAndRunningNr(DocAccountAndRunningNr, PostingType, WinLineDocType)
On Error Resume Next
'Set SQL Table and Query for DocHead. Default: "T025"
SQLTable_DocHead = "[T025]"
SQLQuery_DocHead = "c000 = '" & DocAccountAndRunningNr & "'" & SQLQuery_OrderWhere
'Set SQL Table and Query for DocMid. Default: "T026"
SQLTable_DocMid = "[T026]"
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_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_OrderWhere
IF (SQLTable_DocHead <> "") and (SQLQuery_DocHead <> "") and (PostingType <> "") and (WinLineDocType <> "") Then
Set SQLResult_DocHead = CWLStart.CurrentCompany.SearchRecord (SQLTable_DocHead, SQLQuery_DocHead)
If Err.Number <> 0 Then
MSGBOX "Error Code: "& Err.Number & vbCrlf & _
"Error Description: "& Err.Description,,"ERROR: Function GetWinLineDocInfoByAccountAndRunningNr Getting DocHead from DB Table "& SQLTable_DocHead
Err.Clear
Else
'If no line results
If SQLResult_DocHead.RowCount = -1 Then
If DebugMode = "Enabled" Then
MSGBOX "No Rows found, SQL: "& SQLQuery_DocHead,,"DEBUG - Info: Function GetWinLineDocInfoByAccountAndRunningNrDocHead from Database table "& SQLTable_DocHead
End If
Elseif SQLResult_DocHead.RowCount = 1 Then
If DebugMode = "Enabled" Then
MSGBOX "One Row found, SQL: "& SQLQuery_DocHead,,"DEBUG - Info: Function GetWinLineDocInfoByAccountAndRunningNrDocHead from Database table "& SQLTable_DocHead
End If
'Unique Key
DocAccountAndRunningNr = SQLResult_DocHead.value(0)
'Laufnumemr
DocRunningNr = SQLResult_DocHead.value(21)
'Druckstatus Angebot / Anfrage
DocPrintState1 = SQLResult_DocHead.value(22)
'Druckstatus Auftrag / Bestellung
DocPrintState2 = SQLResult_DocHead.value(23)
'Druckstatus Lieferschein
DocPrintState3 = SQLResult_DocHead.value(24)
'Druckstatus Rechnung
DocPrintState4 = SQLResult_DocHead.value(25)
'Number of the Offer ("Angebot")
DocOfferNr = SQLResult_DocHead.value(41)
'Number of the Order ("Angebot")
DocOrderNr = SQLResult_DocHead.value(42)
'Number of delivery note ("Lieferschein")
DocDeliveryNoteNr = SQLResult_DocHead.value(43)
'Number of the Invoice ("Rechung")
DocInvoiceNr = SQLResult_DocHead.value(52)
'When the doc ("Beleg") was created
DocCreated = SQLResult_DocHead.value(56)
'When the doc ("Beleg") was last changed
DocLastChange = SQLResult_DocHead.value(57)
'The ten "Belegkopfnotizen"
DocHeadText1 = SQLResult_DocHead.value(59)
DocHeadText2 = SQLResult_DocHead.value(60)
DocHeadText3 = SQLResult_DocHead.value(61)
DocHeadText4 = SQLResult_DocHead.value(62)
DocHeadText5 = SQLResult_DocHead.value(63)
DocHeadText6 = SQLResult_DocHead.value(64)
DocHeadText7 = SQLResult_DocHead.value(65)
DocHeadText8 = SQLResult_DocHead.value(66)
DocHeadText9 = SQLResult_DocHead.value(67)
DocHeadText10 = SQLResult_DocHead.value(68)
'The current type (1= Anfrage/Angebot; 2= Auftrag/Bestellung; 3= Lieferschein; 4=Rechnung)
DocType = SQLResult_DocHead.value(134)
DocComment = SQLResult_DocHead.value(163)
'msgbox SQLQuery_DocMid_MengeGeliefert
'msgbox SQLQuery_DocMid_RueckstandsMenge
Set SQLResult_DocMid_MengeGeliefert = CWLStart.CurrentCompany.Connection.Select(SQLQuery_DocMid_MengeGeliefert)
'msgbox SQLResult_DocMid_MengeGeliefert.value("MengeGeliefert")
Set SQLResult_DocMid_RueckstandsMenge = CWLStart.CurrentCompany.Connection.Select(SQLQuery_DocMid_RueckstandsMenge)
'msgbox SQLResult_DocMid_RueckstandsMenge.value("RueckstandsMenge")
IF DebugMode = "Enabled" THEN
End if
DocBackOrder = SQLResult_DocMid_RueckstandsMenge.value("RueckstandsMenge")
'msgbox SQLResult_DocMid_Rueckstandsmenge.value("RueckstandsMenge")
IF (PostingType = 1) Then
'If doc = "Angebot" or "Angebots-storno"
IF (WinLineDocType = 1) or (WinLineDocType = 11) then
DocNr = DocOfferNr
IF (WinLineDocType = 1) then
WinLineDocType = "Angebot (debitorisch)"
ElseIF (WinLineDocType = 11) then
WinLineDocType = "Angebot-Storno (debitorisch)"
End If
'If doc = "Auftrag" or "Auftrag-storno"
ElseIf (WinLineDocType = 2) or (WinLineDocType = 12) then
DocNr = DocOrderNr
IF (WinLineDocType = 2) then
WinLineDocType = "Auftrag (debitorisch)"
ElseIF (WinLineDocType = 12) then
WinLineDocType = "Auftrag-Storno (debitorisch)"
End If
'If doc = "Lieferschein" or "Lieferschein-storno" or "Teillieferschein"
ElseIf (WinLineDocType = 3) or (WinLineDocType = 13) or (WinLineDocType = -3) then
DocNr = DocDeliveryNoteNr
IF (DocBackOrder = 0) and (DocPrintState3 <> "L") then
WinLineDocType = "Lieferschein (debitorisch)"
ElseIF (DocBackOrder = 0) and (DocPrintState3 = "L") then
WinLineDocType = "Lieferschein-Storno (debitorisch)"
ElseIF (DocBackOrder <> 0) and (DocPrintState3 <> "L") then
WinLineDocType = "Teillieferschein (debitorisch)"
ElseIF (DocBackOrder <> 0) and (DocPrintState3 = "L") then
'Über die DB Werte ist eine Unterscheidung zwischen Lieferschein und Teillieferschein Storno nicht möglich!
WinLineDocType = "Teillieferschein-Storno (debitorisch)"
End If
'If doc = "Rechnung" or "Rechnungs-storno"
ElseIf (WinLineDocType = 4) or (WinLineDocType = 14) then
DocNr = DocInvoiceNr
IF (WinLineDocType = 4) and (DocPrintState4 <> "L") then
WinLineDocType = "Rechnung (debitorisch)"
ElseIF (WinLineDocType = 4) and (DocPrintState4 = "L") then
WinLineDocType = "Rechnung-Storno (debitorisch)"
ElseIF (WinLineDocType = 14) and (DocPrintState4 = "L") then
WinLineDocType = "Rechnung-Storno (debitorisch)"
End If
Else
IF DebugMode = "Enabled" THEN
MSGBOX "WinLineDocType is not configured!" & vbCrLf & _
"WinLineDocType: " & WinLineDocType, , "DEBUG - Info: Export Metadata"
END IF
End if
ElseIf (PostingType = 2) Then
'not implement
End if
'Array for the function to return
DIM DocInfo(250)
'Items like T25 c000 to c188
DocInfo(59) = DocCreated
DocInfo(60) = DocLastChange
DocInfo(63) = DocHeadText1
DocInfo(64) = DocHeadText2
DocInfo(65) = DocHeadText3
DocInfo(66) = DocHeadText4
DocInfo(67) = DocHeadText5
DocInfo(68) = DocHeadText6
DocInfo(69) = DocHeadText7
DocInfo(70) = DocHeadText8
DocInfo(71) = DocHeadText9
DocInfo(72) = DocHeadText10
DocInfo(139) = DocType
DocInfo(165) = DocComment
'Items beyond T25
DocInfo(200) = WinLineDocType
DocInfo(201) = DocNr
IF DebugMode = "Enabled" THEN
CRLF = chr(13)&chr(10)
msg = "Parameter:" & CRLF
For i = 0 To Ubound(DocInfo)
If (DocInfo(i) <> "") then
msg = msg & i & ".: " & DocInfo(i) & CRLF
end if
Next
msgbox msg ,, "Macro Name: " & CWLMacro.MName
End if
GetWinLineDocInfoByAccountAndRunningNr = DocInfo
Else
If DebugMode = "Enabled" Then
MSGBOX "To many Rows found, SQL: "& SQLQuery_DocHead,,"DEBUG - Info: Function GetWinLineDocInfoByAccountAndRunningNr DocHead from Database table "& SQLTable_DocHead
End If
GetWinLineDocInfoByAccountAndRunningNr = ""
End If
End If
Else
If DebugMode = "Enabled" Then
MSGBOX "Missing Parameter values, SQL: "& SQLQuery_DocHead,,"DEBUG - Info: Function GetWinLineDocInfoByAccountAndRunningNrDocHead from Database table " & SQLTable_DocHead
End If
GetWinLineDocInfoByAccountAndRunningNr = ""
End If
End Function

103
current/Modules/Sicherungen/Modules_20230623/GetWinLineDocUniqueByNumber.vbs Normal file
View File

@@ -0,0 +1,103 @@
' GetWinLineDocUniqueIdentifier(GetWinLineDocUniqueIdentifierParams)
' ----------------------------------------------------------------------------
' KURZBESCHREIBUNG
'
' Returns: NAME : TYP
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 01.12.2020 / MK
' Version Date / Editor: 01.12.2020 / MK
' Version Number: 1.0.0.0
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 Module 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 not an Array!" & vbCrlf & _
"",,"DEBUG Info: Parameter is not an Array - GetWinLineDocUniqueIdentifierParams"
End If
GetWinLineDocUniqueIdentifier = ""
End if
End Function 'GetWinLineDocUniqueIdentifier

49
current/Modules/Sicherungen/Modules_20230623/GetWinLineInternalProductNumber.vbs Normal file
View File

@@ -0,0 +1,49 @@
' GetWinLineInternalProductNumber(ProductNumber : String, SerialNumber : String)
' ----------------------------------------------------------------------------
' Holt die interne ProductNumber (c002) aus der Artikelview, wenn es eine
' Seriennummer gibt, ansonsten passt der Wert aus dem Parameter
'
' Returns: Interne Artikelnummer
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 10.08.2020 / MK
' Version Date / Editor: 26.04.2021 / MP
' Version Number: 3.0.0.3
Function GetWinLineInternalProductNumber(ProductNumber, SerialNumber)
Set Conn = CWLStart.CurrentCompany.Connection
Err.Clear
If SerialNumber = "" Then
GetWinLineInternalProductNumber = ProductNumber
Else
SQL = "SELECT [c002] FROM [v021] (NOLOCK) WHERE [c011] = '"& ProductNumber &"' AND [c068] = '"& SerialNumber &"' AND (c038 IS NULL) " & 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

60
current/Modules/Sicherungen/Modules_20230623/GetWinLineOriginalLineNumber.vbs Normal file
View File

@@ -0,0 +1,60 @@
' GetWinLineOriginalLineNumber(OrderNumber : String, ArticleNumber : String, IsSerialNumberArticle : Int)
' ----------------------------------------------------------------------------
' Ermittelt die originale Zeilennummer einer belegposition
'
' 18.02.21 - Wird im Packtisch 3.0 nicht mehr verwendet
'
' Returns: GetWinLineOriginalLineNumber : Int
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 18.08.2020 / MK
' Version Date / Editor: 26.04.2021 / MP
' Version Number: 3.0.0.3
Function GetWinLineOriginalLineNumber(OrderNumber, ArticleNumber, IsSerialNumberArticle)
Set Conn = CWLStart.CurrentCompany.Connection
Err.Clear
If IsSerialNumberArticle = 1 Then
SQL = "SELECT TOP 1 c078 FROM t026 (NOLOCK) "
SQL = SQL & "WHERE c067 = '"& OrderNumber &"' AND c003 = '"& ArticleNumber &"' "
SQL = SQL & SQLQuery_OrderWhere
Set Result = Conn.Select(SQL)
If DEBUG_ON = True Then
AddDebugLine "Querying for Original Line Number.. " & vbNewline
AddDebugLine "Result Columns: " & Result
AddDebugLine "Result Rows: " & Result.RowCount
AddDebugLine "SQL: " & SQL
ShowDebugBox "GetWinLineOriginalLineNumber"
End If
If Result < 0 Then
If err <> 0 Then
Msgbox "Fehler bei Abfrage:" & vbNewline & err.description, vbExclamation, DEFAULT_TITLE & " - GetWinLineOriginalLineNumber"
Exit Function
Else
Msgbox "Abfrage lieferte keine Ergebnisse.", vbExclamation, DEFAULT_TITLE & " - GetWinLineOriginalLineNumber"
Exit Function
End If
End If
GetWinLineOriginalLineNumber = Result.Value("c078")
Else
If DEBUG_ON = True Then
AddDebugLine "Setting Original Line Number to 0.."
ShowDebugBox "GetWinLineOriginalLineNumber"
End If
GetWinLineOriginalLineNumber = "0"
End If
End Function

48
current/Modules/Sicherungen/Modules_20230623/GetWinLineProductInfoByProductNumber.vbs Normal file
View File

@@ -0,0 +1,48 @@
' GetWinLineProductInfoByProductNumber(ProductNumber : String, WinLineMandatorNr : String, WinLineYear : Int)
' ----------------------------------------------------------------------------
' Läd den passenden Datensatz aus v021 zur übergebenen Artikelnummer
'
' Returns: GetWinLineProductInfoByProductNumber : WinLineProductInfo-Objekt
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 23.09.2020 / JJ
' Version Date / Editor: 23.09.2020 / JJ
' Version Number: 1.0.0.0
Function GetWinLineProductInfoByProductNumber(ProductNumber, WinLineMandatorNr, WinLineYear)
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

36
current/Modules/Sicherungen/Modules_20230623/GetWinLineStockedAmount.vbs Normal file
View File

@@ -0,0 +1,36 @@
' GetWinLineStockedAmount(ProductNumber : String, IncludeSalesDocuments : Boolean)
' ----------------------------------------------------------------------------
' Lagerstand des Artikels prüfen
'
' Returns: NAME : TYP
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 22.01.2021 / XX
' Version Date / Editor: 13.12.2021 / MP
' Version Number: 3.0.0.6
Function GetWinLineStockedAmount(ProductNumber, IncludeSalesDocuments)
SQL = ""
SQL = SQL & "SELECT "
SQL = SQL & " (SELECT C008 - C009 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

88
current/Modules/Sicherungen/Modules_20230623/GetWinLineStorageLocation.vbs Normal file
View File

@@ -0,0 +1,88 @@
' GetWinLineStorageLocation(ProductNumber : String, ProductSerialNumber : String, IsSerialNumberArticle : Int)
' ----------------------------------------------------------------------------
' KURZBESCHREIBUNG
'
' Returns: GetWinLineStorageLocation : Int
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 07.01.2021 / XX
' Version Date / Editor: 23.06.2023 / MK/JJ
' Version Number: 1.1.0.0
'
' 23.06.2023: Lagerortstruktur-SQL erweitert/korrigiert
Function GetWinLineStorageLocation(ProductNumber, ProductSerialNumber, IsSerialNumberArticle)
Set Conn = CWLStart.CurrentCompany.Connection
If IsSerialNumberArticle = 1 Then
' Get 'Lagerortstruktur' for SN Product
SQL = "SELECT TOP 1 c178 FROM [V021] (NOLOCK) WHERE c011 = '"& ProductNumber &"' AND c068 = '" & ProductSerialNumber & "' AND mesocomp = '" & MandatorNr & "' AND mesoyear = " & WinLineCurrentYear & " ORDER BY c029 DESC "
Else
' Get 'Lagerortstruktur' for Non-SN Product
SQL = "SELECT TOP 1 c178 FROM [V021] (NOLOCK) WHERE c011 = '"& ProductNumber &"' AND mesocomp = '" & MandatorNr & "' AND mesoyear = " & WinLineCurrentYear
End If
If DEBUG_ON = True Then
AddDebugLine "SQL Lagerortstruktur: "
AddDebugLine SQL
ShowDebugBox "GetWinLineStorageLocation"
End If
Set Result = Conn.Select(SQL)
If Result.Value("c178") = 0 Then
GetWinLineStorageLocation = 0
Exit Function
End If
If IsSerialNumberArticle = 1 Then
Identifier = GetWinLineInternalProductNumber(ProductNumber, ProductSerialNumber)
Else
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)
ShowDebugBox "GetWinLineStorageLocation"
AddDebugLine "SQL Part 2: " & Mid(SQL, 750)
ShowDebugBox "GetWinLineStorageLocation"
End If
Set Result = Conn.Select(SQL)
If DEBUG_ON = True Then
AddDebugLine "Querying storage location... " & vbNewline
AddDebugLine "ArticleNumber: " & ProductNumber
AddDebugLine "SerialNumber: " & ProductSerialNumber
AddDebugLine "IsSerialNumber Article: " & IsSerialNumberArticle
AddDebugLine "Result Columns: " & Result
AddDebugLine "Result Rows: " & Result.RowCount
AddDebugLine "SQL: " & SQL
ShowDebugBox "GetWinLineStorageLocation"
End If
If Result = -1 Then
GetWinLineStorageLocation = 0
Else
GetWinLineStorageLocation = Result.Value("c000")
End If
End Function

74
current/Modules/Sicherungen/Modules_20230623/GetWinLineUserData.vbm Normal file
View File

@@ -0,0 +1,74 @@
' GetWinLineUserData(UserID: Int)
' ----------------------------------------------------------------------------
' Holt anhand der UserID Loginname, Namen und Durchwahl
' aus der Systemtabelle CWLSYSTEM.T002SRV
'
' Aus den Daten wird ein String aufgebaut, der dann in Meldungen
' verwendet werden kann.
'
' Returns: GetWinLineUserData : String
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 26.04.2021 / MP
' Version Date / Editor: 26.04.2021 / MP
' Version Number: 3.0.0.3
Function GetWinLineUserData(UserID)
Err.Clear
GetWinLineUserData = ""
If Len(UserID) <= 0 Then
If DEBUG_ON = True Then
Msgbox "Parameter UserID ist leer!", vbExclamation, DEFAULT_TITLE & " - GetWinLineUserData"
End If
Exit Function
End If
Set Conn = CWLCompany.GetSystemConnection(cwlSystemServerSRV)
SQL = "SELECT TOP 1 c001, c026, c028 FROM T002SRV (NOLOCK) "
SQL = SQL & "WHERE c000 = " & UserID
Set Result = Conn.Select(SQL)
If DEBUG_ON = True Then
AddDebugLine "Querying for Original Line Number.. " & vbNewline
AddDebugLine "Result Columns: " & Result
AddDebugLine "Result Rows: " & Result.RowCount
AddDebugLine "SQL: " & SQL
ShowDebugBox "GetWinLineUserData"
End If
If Result < 0 Then
If err <> 0 Then
Msgbox "Fehler bei Abfrage:" & vbNewline & err.description, vbExclamation, DEFAULT_TITLE & " - GetWinLineUserData"
Exit Function
Else
Msgbox "Abfrage lieferte keine Ergebnisse.", vbExclamation, DEFAULT_TITLE & " - GetWinLineUserData"
Exit Function
End If
End If
ResultString = ""
If Len(Result.Value("c026")) > 0 Then
' Name des Benutzers
ResultString = Result.Value("c026")
Else
' Loginname des Benutzers, muss immer belegt sein.
ResultString = Result.Value("c001")
End If
If Len(Result.Value("c026")) > 0 Then
' Durchwahl ergänzen, wenn vorhanden
ResultString = ResultString & " (" & Result.Value("c028") & ")"
End If
GetWinLineUserData = ResultString
End Function

29
current/Modules/Sicherungen/Modules_20230623/GetWindowsEnvironment.vbm Normal file
View File

@@ -0,0 +1,29 @@
' GetWindowsEnvironment(EnvName: String)
' ----------------------------------------------------------------------------
' URL: https://skriptwiki.ffsf.de/doku.php/umgebungsvariablen
'
' Mögliche Werte für EnvName sind hier zu finden:
' http://www.winfaq.de/faq_html/Content/tip0000/onlinefaq.php?h=tip0328.htm
'
' Returns: GetWindowsEnvironment : String
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 23.03.2021 / MP
' Version Date / Editor: 23.03.2021 / MP
' Version Number: 3.0.0.0
Function GetWindowsEnvironment(EnvName)
If (Len(EnvName) <= 0) Then
GetWindowsEnvironment = ""
Exit Function
End If
Set WshShell = CreateObject("WScript.Shell")
Set oEnv = WshShell.Environment("Process")
GetWindowsEnvironment = oEnv(EnvName)
Set oEnv = Nothing
End Function

234
current/Modules/Sicherungen/Modules_20230623/Packtisch/ArticleExists.vbs Normal file
View File

@@ -0,0 +1,234 @@
' ArticleExists(Identifier: String)
' ---------------------------------------------------------
' Findet Artikelnummer anhand von versch. Kriterien
' - Artikel-Nummer, Alternative Artikel-Nummer, EAN-Code, Seriennummer
' - Gibt die Zeile im Grid zurück in der Artikel das erste Mal gefunden wurde
'
' Rückgabewert: ArticleRow: Int
' ---------------------------------------------------------
' Version Date: 04.01.2021
Const ARTICLE_EXISTS_NO_STOCK = -99
Const ARTICLE_EXISTS_NO_SERIALNUMBER = -98
Const ARTICLE_EXISTS_NO_ARTICLE_EAN = -97
Const ARTICLE_EXISTS_NO_REGEX_MATCH = -96
Function ArticleExists(Identifier)
ArticleExists = 0
HasError = False
CURRENT_SERIALNUMBER = ""
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
' ===================== ARTIKEL NUMMER / EAN-CODE =====================
SQL = ""
' Artikelnummer / EAN-Code / Alternative Artikelnummer
SQL = SQL & "((C002 = '" & Identifier & "') Or (C075 = '" & Identifier & "') Or (C114 = '" & Identifier & "')) AND "
' Artikel darf nicht inaktiv sein
SQL = SQL & "(c038 IS NULL) "
' Nach Mandant und Wirtschaftsjahr filtern
SQL = SQL & SQLQuery_BasicWhere
Set ResultArtikel = CWLStart.CurrentCompany.SearchRecord(TABLE_21, SQL)
If DEBUG_ON = True Then
AddDebugLine "Searching for Article by ArticleNo/EAN-Code.. " & vbNewline & vbNewline
AddDebugLine "Result Columns: " & ResultArtikel & vbNewline
AddDebugLine "Result Rows: " & ResultArtikel.RowCount & vbNewline
AddDebugLine "SQL: " & SQL
ShowDebugBox "ArticleExists"
End If
' ===================== SERIENNUMMER =====================
SQL = ""
' Artikelnummer
SQL = SQL & "(C068 = '" & Identifier & "') AND "
' Artikel darf nicht inaktiv sein
SQL = SQL & "(c038 IS NULL) "
' Nach Mandant und Wirtschaftsjahr filtern
SQL = SQL & SQLQuery_BasicWhere
Set ResultSeriennummer = CWLStart.CurrentCompany.SearchRecord(TABLE_21, SQL)
If DEBUG_ON = True Then
AddDebugLine "Searching for Article by Article serial number " & vbNewline
AddDebugLine "Result Columns: " & ResultSeriennummer
AddDebugLine "Result Rows: " & ResultSeriennummer.RowCount
AddDebugLine "SQL: " & SQL
ShowDebugBox "ArticleExists"
End If
If ResultSeriennummer.RowCount > 0 Then
SerialNumberString = ResultSeriennummer.Value("C068")
MainArticleNumber = ResultSeriennummer.Value("C011")
SQL = ""
SQL = SQL & "(C002 = '" & MainArticleNumber & "') "
' Nach Mandant und Wirtschaftsjahr filtern
SQL = SQL & SQLQuery_BasicWhere
Set ResultMainArticle = CWLStart.CurrentCompany.SearchRecord(TABLE_21, SQL)
If ResultMainArticle.RowCount > 0 Then
SerialNumberPattern = ResultMainArticle.Value("C222")
End If
If DEBUG_ON = True Then
AddDebugLine "Preparing Regex Check. " & vbNewline
AddDebugLine "SerialNumberString: " & SerialNumberString
AddDebugLine "SerialNumberPattern: " & SerialNumberPattern
AddDebugLine "MainArticleNumber: " & MainArticleNumber
ShowDebugBox "ArticleExists"
End If
If Len(SerialNumberPattern) > 0 And Len(SerialNumberString) > 0 Then
Set SerialNumberRegex = New Regexp
With SerialNumberRegex
.Pattern = SerialNumberPattern
.IgnoreCase = False
.Global = False
End With
Set RegexMatch = SerialNumberRegex.Execute(SerialNumberString)
Set FirstMatch = RegexMatch.Item(0)
If DEBUG_ON = True Then
AddDebugLine "Checked Serialnumber against Regex. (1/2)" & vbNewline
AddDebugLine "FirstMatch.Length: " & FirstMatch.Length
AddDebugLine "Len(SerialNumberString): " & Len(SerialNumberString)
AddDebugLine "FirstMatch.FirstIndex: " & FirstMatch.FirstIndex
ShowDebugBox "ArticleExists"
End If
If Not (FirstMatch.Length = Len(SerialNumberString) And FirstMatch.FirstIndex = 0) Then
ArticleExists = ARTICLE_EXISTS_NO_REGEX_MATCH
HasError = True
End If
If DEBUG_ON = True Then
AddDebugLine "Checked Serialnumber against Regex. (2/2)" & vbNewline
AddDebugLine "Result: " & SerialNumberRegex.Test(SerialNumberString)
AddDebugLine "Serialnumber: " & SerialNumberString
AddDebugLine "Regex: " & SerialNumberPattern
ShowDebugBox "ArticleExists"
End If
End If
CURRENT_SERIALNUMBER = Identifier
Set Result = ResultSeriennummer
Else
Set Result = ResultArtikel
End If
'==========================================================
If HasError = True Then
' Just skip the rest of the function and return the current error
Elseif Result.RowCount > 0 Then
' Wir brauchen die Hauptartikelnummer, weil die Prüfung sonst bei SN-Artikeln fehlschlägt
MainArticleNumber = Result.Value("C011")
RealArticleNumber = Result.Value("C002")
ProductShape = 0
' Ausprägung des Artikels prüfen
SQL = ""
SQL = "SELECT c001 FROM t301 (NOLOCK) WHERE c003 = (SELECT c066 FROM v021 (NOLOCK) WHERE c002 = '" & RealArticleNumber & "' " & SQLQuery_BasicWhere & ")" & SQLQuery_BasicWhere
If DEBUG_ON = True Then
AddDebugLine "SQL: " & SQL
ShowDebugBox "ArticleExists"
End If
Set Result = CWLStart.CurrentCompany.Connection.Select(SQL)
If Result > -1 Then
ProductShape = Result.Value("c001")
Else
ProductShape = 0
End If
CURRENT_SHAPE = ProductShape
' 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 & " - "
SQL = SQL & "(SELECT C009 AS [MengeAbgang] from [v021] (NOLOCK) where (c002 = '__ARTICLENUMBER__') "& SQLQuery_BasicWhere &") "
'SQL = SQL & " - "
'SQL = SQL & "ISNULL((SELECT SUM(C035) AS [MengeVerkauf] FROM [t014] (NOLOCK) where c000 = '__ARTICLENUMBER__' "& SQLQuery_BasicWhere &"), 0)"
SQL = SQL & " AS c000"
SQL = Replace(SQL, "__ARTICLENUMBER__", RealArticleNumber)
If DEBUG_ON = True Then
AddDebugLine "SQL: " & SQL
ShowDebugBox "ArticleExists"
End If
Set Result = CWLStart.CurrentCompany.Connection.Select(SQL)
AmountStocked = Result.Value("c000")
If DEBUG_ON = True Then
AddDebugLine "Checking stock of product: " & RealArticleNumber & " (" & MainArticleNumber & ")" & vbNewline
AddDebugLine "Result Columns: " & Result
AddDebugLine "Result Rows: " & Result.RowCount
AddDebugLine "Stock: " & AmountStocked
AddDebugLine "SQL: " & SQL
ShowDebugBox "ArticleExists"
End If
If AmountStocked > 0 Then
If DEBUG_ON = True Then
AddDebugLine "Amount stocked: " & AmountStocked
End If
' Vorkommen in Tabelle prüfen
For Row = 1 To Grid.LineCount
CurrentArticleNumber = Grid.GetCellValue(Row, COLUMN_ARTICLENUMBER)
Total = Cint(Grid.GetCellValue(Row, COLUMN_TOTAL))
Scanned = Cint(Grid.GetCellValue(Row, COLUMN_SCANNED))
If CurrentArticleNumber = MainArticleNumber Then
If DEBUG_ON = True Then
AddDebugLine "CurrentArticleNumber matches MainArticleNumber! (" & CurrentArticleNumber & ")"
End If
If Total > Scanned Then
If DEBUG_ON = True Then
AddDebugLine "Product is not yet scanned completetly and exists in Row " & Row & "!"
End If
ArticleExists = Row
Exit For
End If
End If
Next
Else
If DEBUG_ON = True Then
AddDebugLine "Amount stocked: 0"
End If
ArticleExists = ARTICLE_EXISTS_NO_STOCK
End If
If DEBUG_ON = True Then
ShowDebugBox "ArticleExists"
End If
Else
If CURRENT_SERIALNUMBER = "" Then
ArticleExists = ARTICLE_EXISTS_NO_ARTICLE_EAN
Else
ArticleExists = ARTICLE_EXISTS_NO_SERIALNUMBER
End If
End If
End Function

210
current/Modules/Sicherungen/Modules_20230623/Packtisch/CompleteOrder.vbs Normal file
View File

@@ -0,0 +1,210 @@
' CompleteOrder()
' ---------------------------------------------------------
' Schließt die Prüfung ab und erstellt einen Lieferschein
'
' Rückgabewert: OrderSuccessful : Boolean
' ---------------------------------------------------------
' Version Date: 05.01.2021
Function CompleteOrder()
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Conn = CWLStart.CurrentCompany.Connection
Set Grid = mywin.Controls.Item(GRID_ID).Grid
Dim OrderId, AccountSQL, MandatorId, RunningNumber
If DEBUG_ON = True Then
AddDebugLine "Completing order.. " & vbNewline
ShowDebugBox "CompleteOrder"
End If
OrderId = mywin.Controls.Item(ORDER_INPUT).ScreenContents
AccountSQL = "SELECT DISTINCT c021 FROM t025 (NOLOCK) WHERE c044 = '" & OrderId & "' " & SQLQuery_OrderWhere
Set AccountResult = Connection.Select(AccountSQL)
If DEBUG_ON = True Then
AddDebugLine "Querying for CustomerAccountId.. " & vbNewline
AddDebugLine "Result Columns: " & AccountResult
AddDebugLine "Result Rows: " & AccountResult.RowCount
AddDebugLine "SQL: " & AccountSQL
ShowDebugBox "CompleteOrder"
End If
MandatorId = AccountResult.Value("c021")
RunningNumber = RUNNING_NUMBER_PREFIX & OrderId
BelegKey = Cstr(DateDiff("s", "01/01/1970 00:00:00", Now))
' ===================== KOPFDATEN =====================
Dim Request, URL, XML
Dim DObj : DObj = Now
Dim DateString : DateString = Year(DObj) & "-" & GetLeftPad(Month(DObj)) & "-" & GetLeftPad(Day(DObj))
' === WEB SERVICES =======================
XML = ""
XML = XML & "<?xml version=""1.0"" encoding=""UTF-8""?>"
XML = XML & "<MESOWebService TemplateType=""__TYPE__"" Template=""__VORLAGE__"" option=""__OPTION__"" printVoucher=""__PRINT__"">"
XML = XML & "<__VORLAGE__T025>"
XML = XML & "<BELEGKEY>" & BelegKey & "</BELEGKEY>"
XML = XML & "<Kontonummer>" & MandatorId & "</Kontonummer>"
XML = XML & "<Laufnummer>" & RunningNumber & "</Laufnummer>"
XML = XML & "<Auftragsnummer>" & OrderId & "</Auftragsnummer>"
XML = XML & "<Datum_Lieferschein>" & DateString & "</Datum_Lieferschein>"
XML = XML & "</__VORLAGE__T025>"
' === EXIM TABELLE =======================
HeadSQL = "INSERT INTO " & SQLDB_for_EXIM & "." & SQLHeadTB_for_EXIM & " "
HeadSQL = HeadSQL & "(BELEGKEY, Kontonummer, Laufnummer, Auftragsnummer, Belegdatum) "
HeadSQL = HeadSQL & "VALUES("& BelegKey &", '"& MandatorId &"', '"& RunningNumber &"', '"& OrderId &"', GETDATE())"
HeadResult = Conn.ExecuteSQL(HeadSQL)
If DEBUG_ON = True Then
AddDebugLine "Inserting Head Data" & vbNewline
AddDebugLine "Result: " & HeadResult
AddDebugLine "SQL: " & HeadSQL
ShowDebugBox "CompleteOrder"
End If
' ===================== ENDE KOPFDATEN =====================
' ============================ MITTEDATEN ============================
Dim ArticleNumber, AmountScanned, SerialNumber, StorageLocation, LineNumber
For Row = 1 To Grid.LineCount
IsSerialNumberArticle = Grid.GetCellValue(Row, COLUMN_TYPE)
ArticleNumber = Grid.GetCellValue(Row, COLUMN_ARTICLENUMBER)
SerialNumber = Grid.GetCellValue(Row, COLUMN_SERIALNUMBER)
AmountScanned = Grid.GetCellValue(Row, COLUMN_SCANNED)
AmountTotal = Grid.GetCellValue(Row, COLUMN_TOTAL)
If PRINT_DOCUMENT_AFTER_COMPLETION = True Then
StorageLocation = GetWinLineStorageLocation(ArticleNumber, SerialNumber, IsSerialNumberArticle)
InternalArticleNumber = GetWinLineInternalProductNumber(ArticleNumber, SerialNumber)
Else
StorageLocation = 0
InternalArticleNumber = 0
End If
LineNumber = GetWinLineOriginalLineNumber(OrderId, ArticleNumber, IsSerialNumberArticle)
' === EXIM TABELLE =======================
If IsSerialNumberArticle = 1 Then
MidSQL = "INSERT INTO " & SQLDB_for_EXIM & "." & SQLMiddleTB_for_EXIM & " "
MidSQL = MidSQL & "(BELEGKEY, Artikelnummer, Hauptartikelnummer, Zeilennummer, Datentyp, Mengegeliefert, ChargeIdentnummer, Lagerort) "
MidSQL = MidSQL & "VALUES("& BelegKey &", '"& ArticleNumber &"', '"& ArticleNumber &"', "& LineNumber &", '1', "& AmountScanned &", '"& SerialNumber &"', "& StorageLocation &")"
Else
MidSQL = "INSERT INTO " & SQLDB_for_EXIM & "." & SQLMiddleTB_for_EXIM & " "
MidSQL = MidSQL & "(BELEGKEY, Artikelnummer, Hauptartikelnummer, Zeilennummer, Datentyp, Mengegeliefert, ChargeIdentnummer, Lagerort) "
MidSQL = MidSQL & "VALUES("& BelegKey &", '"& ArticleNumber &"', '"& ArticleNumber &"', NULL, '1', "& AmountScanned &", '"& SerialNumber &"', "& StorageLocation &")"
End If
MidResult = Conn.ExecuteSQL(MidSQL)
' === WEB SERVICES =======================
MidXML = ""
MidXML = MidXML & "<__VORLAGE__T026>"
MidXML = MidXML & "<BELEGKEY>" & BelegKey & "</BELEGKEY>"
MidXML = MidXML & "<Artikelnummer>" & InternalArticleNumber & "</Artikelnummer>"
MidXML = MidXML & "<Hauptartikelnummer>" & ArticleNumber & "</Hauptartikelnummer>"
MidXML = MidXML & "<Zeilennummer>" & LineNumber & "</Zeilennummer>"
MidXML = MidXML & "<Datentyp>" & "1" & "</Datentyp>"
MidXML = MidXML & "<Mengegeliefert>" & AmountScanned & "</Mengegeliefert>"
MidXML = MidXML & "<ChargeIdentnummer>" & SerialNumber & "</ChargeIdentnummer>"
MidXML = MidXML & "<Lagerort>" & StorageLocation & "</Lagerort>"
MidXML = MidXML & "</__VORLAGE__T026>"
If DEBUG_ON = True Then
AddDebugLine "Inserting Middle Data" & vbNewline
AddDebugLine "For Article " & ArticleNumber
AddDebugLine "And Amount " & AmountScanned
AddDebugLine "Result: " & MidResult & vbNewline
AddDebugLine "SQL: " & MidSQL & vbNewline
AddDebugLine "XML: " & MidXML
ShowDebugBox "CompleteOrder"
End If
XML = XML & MidXML
Next
XML = XML & "</MESOWebService>"
XML = Replace(XML, "__VORLAGE__", WEB_VORLAGE)
XML = Replace(XML, "__TYPE__", WEB_TYPE)
XML = Replace(XML, "__PRINT__", WEB_PRINT)
XML = Replace(XML, "__OPTION__", WEB_OPTION)
URL = "http://__SERVER__/ewlservice/import?User=__USER__&Password=__PASSWORD__&Company=__COMPANY__&Type=30&Vorlage=__VORLAGE__&Actioncode=__ACTIONCODE__&byref=0&Data=__DATA__"
URL = Replace(URL, "__SERVER__", WEB_SERVER)
URL = Replace(URL, "__USER__", WEB_USER)
URL = Replace(URL, "__PASSWORD__", WEB_PASS)
URL = Replace(URL, "__COMPANY__", WEB_COMPANY)
URL = Replace(URL, "__VORLAGE__", WEB_VORLAGE)
URL = Replace(URL, "__ACTIONCODE__", WEB_ACTIONCODE)
URL = Replace(URL, "__DATA__", XML)
If DEBUG_ON = True Then
AddDebugLine "Sending Request to WebServices.."
AddDebugLine "URL: " & URL
AddDebugLine "WEB_PRINT: " & WEB_PRINT
AddDebugLine "WEB_OPTION: " & WEB_OPTION
ShowDebugBox "CompleteOrder"
End If
' ======================= ENDE MITTEDATEN =======================
If PRINT_DOCUMENT_AFTER_COMPLETION = True Then
' ===================== HTTP REQUEST =====================
Set Request = CreateObject("MSXML2.XMLHTTP")
Request.Open "POST", URL, False
Request.Send
Response = Request.ResponseText
Status = Request.Status
If DEBUG_ON = True Then
AddDebugLine "Response from WebServices!"
AddDebugLine "Status: " & Status
AddDebugLine "Body: " & Response
ShowDebugBox "CompleteOrder"
End If
' =================== ENDE HTTP REQUEST ==================
Error = False
Message = ""
If Status = 200 Then
If TestIsWebserviceResponseSuccessful(Response) = True Then
Message = "Lieferschein wurde uebertragen!"
Else
Error = True
Message = "Lieferschein wurde nicht uebertragen! Fehlerdetails: " & vbNewline & vbNewline & Response
End If
Else
Error = True
Message = "Fehler beim Zugriff auf Webservices aufgetreten!" & vbNewline & vbNewline & "Status: " & Status
End If
If Error = False Then
MsgBox Message, vbInformation, DEFAULT_TITLE
CompleteOrder = True
Else
MsgBox Message, vbExclamation, DEFAULT_TITLE & " - Fehler bei Abschluss"
CompleteOrder = False
End If
Else
CompleteOrder = True
End If
End Function

20
current/Modules/Sicherungen/Modules_20230623/Packtisch/CountRowsForArticle.vbs Normal file
View File

@@ -0,0 +1,20 @@
Function CountRowsForArticle(ArticleNumber)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
Dim Count : Count = 0
If DEBUG_ON = True Then
AddDebugLine "Counting rows for Article: " & ArticleNumber
ShowDebugBox "CountRowsForArticle"
End If
For Row = 1 To Grid.LineCount
CurrentArticleNumber = Grid.GetCellValue(Row, COLUMN_ARTICLENUMBER)
If ArticleNumber = CurrentArticleNumber Then
Count = Count + 1
End If
Next
CountRowsForArticle = Count
End Function

34
current/Modules/Sicherungen/Modules_20230623/Packtisch/GetArticleNumberFromSecondaryIndentifier.vbs Normal file
View File

@@ -0,0 +1,34 @@
' Version Date: 23.11.2020
Function GetArticleNumberFromSecondaryIndentifier(Identifier)
SQL = ""
' EAN-Code / Alternative Artikelnummer 1 / Alternative Artikelnummer 2 / Artikelnummer / S/N
SQL = SQL & "("
SQL = SQL & "(C002 = '" & Identifier & "') Or "
SQL = SQL & "(C068 = '" & Identifier & "') Or "
SQL = SQL & "(C075 = '" & Identifier & "') Or "
SQL = SQL & "(C114 = '" & Identifier & "') Or "
SQL = SQL & "(C115 = '" & Identifier & "')"
SQL = SQL & ") "
' Nur Nach Hauptartikel/Ausprägungs(kind)artikel suchen
' SQL = SQL & "And C014 IN (0, 2)"
' Nach Mandant und Wirtschaftsjahr filtern
SQL = SQL & SQLQuery_BasicWhere
Set Result = CWLStart.CurrentCompany.SearchRecord(TABLE_21, SQL)
If DEBUG_ON = True Then
AddDebugLine "Searching for SerialNumber-Regex by ArticleNumber " & vbNewline
AddDebugLine "Result Columns: " & Result
AddDebugLine "Result Rows: " & Result.RowCount
AddDebugLine "SQL: " & SQL
ShowDebugBox "GetArticleNumberFromSecondaryIndentifier"
End If
If Result.RowCount > 0 Then
GetArticleNumberFromSecondaryIndentifier = Result.Value("c010")
Else
GetArticleNumberFromSecondaryIndentifier = ""
End If
End Function

23
current/Modules/Sicherungen/Modules_20230623/Packtisch/GetNextFreeArticleRow.vbs Normal file
View File

@@ -0,0 +1,23 @@
' Version Date: 30.09.2020
Function GetNextFreeArticleRow(ArticleNumber)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
Dim NextFreeRow : NextFreeRow = -1
If DEBUG_ON = True Then
AddDebugLine "Getting next free row for Article: " & ArticleNumber
ShowDebugBox "GetNextFreeArticleRow"
End If
For Row = 1 To Grid.LineCount
CurrentArticleNumber = Grid.GetCellValue(Row, COLUMN_ARTICLENUMBER)
CurrentSerialNumber = Grid.GetCellValue(Row, COLUMN_SERIALNUMBER)
If UCase(ArticleNumber) = UCase(CurrentArticleNumber) And Len(CurrentSerialNumber) = 0 Then
NextFreeRow = Row
Exit For
End If
Next
GetNextFreeArticleRow = NextFreeRow
End Function

58
current/Modules/Sicherungen/Modules_20230623/Packtisch/IsOrderAvailable.vbs Normal file
View File

@@ -0,0 +1,58 @@
' IsOrderAvailable()
' ---------------------------------------------------------
' Überprüft, ob Auftrag noch (teilweise) offen ist
'
' Rückgabewert: OrderAvailable: Boolean
' ---------------------------------------------------------
Function IsOrderAvailable(OrderNumber)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
IsOrderAvailable = False
'Set SQL Table and Query for DocHead. Default: "T025"
'c023 - c026 = Druckstufen; c098 = Freigabeflag Angebot; c139 = Belegstufe;
'c035 = Belegart
'--> Query is not complete, will be build in the script later this time!
SQL = ""
SQL = SQL & "(c044 = '" & OrderNumber & "') "
SQL = SQL & "AND (c024 = '*' AND c025 != '*' AND c026 != '*') "
SQL = SQL & "AND (c025 IN ('M', 'A', 'S')) "
SQL = SQL & "AND (c115 < 900) "
SQL = SQL & "AND (c139 = 2) "
SQL = SQL & SQLQuery_OrderWhere
Set Result = CWLStart.CurrentCompany.SearchRecord(TABLE_25, SQL)
If DEBUG_ON = True Then
MsgBox "SQL: ... FROM " & TABLE_25 & " WHERE " & SQL, vbOkonly, DEBUG_TITLE
AddDebugLine "Checking For Order by OrderId.." & vbNewline & vbNewline
AddDebugLine "Result Columns: " & Result & vbNewline
AddDebugLine "Result Rows: " & Result.RowCount & vbNewline
AddDebugLine "SQL: " & SQL
ShowDebugBox "IsOrderAvailable"
End If
If Result < 0 Then
If err <> 0 Then
Msgbox "Fehler bei Abfrage:" & vbNewline & err.description, vbExclamation, DEFAULT_TITLE & " - IsOrderAvailable"
Exit Function
Else
Message = "Der Auftrag [" & OrderNumber & "] wurde nicht geladen aus einem der folgenden Gründe:" & vbNewLine & vbNewLine
Message = Message & "- Auftrag existiert nicht" & vbNewLine
Message = Message & "- Auftrag ist durch Fibu gesperrt" & vbNewLine
Message = Message & "- Auftrag wurde bereits erledigt" & vbNewLine
Message = Message & "- Beleg ist kein Auftrag"
MsgBox Message, vbExclamation, DEFAULT_TITLE
Exit Function
End If
End If
If Result.RowCount > 0 Then
IsOrderAvailable = True
End If
End Function

22
current/Modules/Sicherungen/Modules_20230623/Packtisch/IsOrderComplete.vbs Normal file
View File

@@ -0,0 +1,22 @@
' IsOrderComplete()
' ---------------------------------------------------------
' Überprüft, ob alle Zeilen vollständig gescannt wurden
'
' Rückgabewert: OrderComplete: Boolean
' ---------------------------------------------------------
Function IsOrderComplete()
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
IsOrderComplete = True
For Row = 1 To Grid.LineCount
Total = Cint(Grid.GetCellValue(Row, COLUMN_TOTAL))
Scanned = Cint(Grid.GetCellValue(Row, COLUMN_SCANNED))
If Scanned < Total Then
IsOrderComplete = False
Exit For
End If
Next
End Function

153
current/Modules/Sicherungen/Modules_20230623/Packtisch/LoadOrder.vbs Normal file
View File

@@ -0,0 +1,153 @@
' LoadOrder(OrderNumber: String)
' ---------------------------------------------------------
' Sucht Belegzeilen zur angegebenen Belegnummer
' - Filtert Artikel der Gruppe 100 aus
' - Lädt Ergebnisse in eine Tabelle auf dem Formular
' - Erzeugt N Zeilen für Seriennummer-Artikel der Menge N
'
' Rückgabewert: LoadSuccessful: Boolean
' ---------------------------------------------------------
' Version Date: 04.01.2021
Function LoadOrder(OrderNumber)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
' ARTIKEL FILTERN
SQL = ""
' Nach eingescannter Auftragsnummer/Belegnummer filtern
SQL = SQL & "(c067 = '"& OrderNumber &"') "
' Nur Artikelzeilen anzeigen
SQL = SQL & "AND (c042 = 1) "
' Teillieferungs-Zeilen rausfiltern
SQL = SQL & "AND (c005 - c016) > 0 AND (c099 = 0) "
'SQL = SQL & "AND c039 <> '*' AND (c005 - c016) > 0 AND (c099 = 0) "
' Versandkosten (Art.Gruppe 100) rausfiltern
' SQL = SQL & "AND c012 NOT IN (100, 101) "
' Keine Hauptartikel, wenn dazu auch Ausprägungen vorhanden sind
' Legende:
'-1 - Ausprägung
' 0 - HA ohne Ausprägungen
' 2 - HA mit Ausprägungen + Ident
' 12 - HA mit Ausprägungen + Ident (bereits ausgeprägt)
SQL = SQL & "AND c055 NOT IN (12)"
' Nach Mandant und Wirtschaftsjahr filtern
SQL = SQL & SQLQuery_OrderWhere
Set Result = CWLStart.CurrentCompany.SearchRecord (TABLE_26, SQL)
If DEBUG_ON = True Then
MsgBox "SQL: ... FROM "& TABLE_26 & " WHERE " & SQL, vbOkonly, DEBUG_TITLE
AddDebugLine "Searching For Order by OrderId (Mid Table).." & vbNewline & vbNewline
AddDebugLine "Result Columns: " & Result & vbNewline
AddDebugLine "Result Rows: " & Result.RowCount & vbNewline
AddDebugLine "SQL: " & SQL
ShowDebugBox "LoadOrder"
End If
If Result < 0 Then
If err <> 0 Then
Msgbox "Fehler bei Abfrage:" & vbNewline & err.description, vbExclamation, DEFAULT_TITLE & " - LoadOrder"
Exit Function
Else
Msgbox "Abfrage lieferte keine Ergebnisse.", vbExclamation, DEFAULT_TITLE & " - LoadOrder"
Exit Function
End If
End If
Grid.InitUserGrid
Grid.Header
Grid.Clear(1002)
Grid.IsRedraw = False
If Result.RowCount > 0 Then
LineCounter = 1
' Speicher für benutzerdefinierte Felder
' (495,0) - Menge Gescannt
' (495,1) - Menge Gesamt
' (495,2) - Seriennummer
' (495,3) - Artikelnummer
' (495,4) - Bezeichnung
ORDER_ACCOUNT_NUMBER = Result.Value("c044")
ORDER_RUNNING_NUMBER = Result.Value("c045")
ORDER_DOCUMENT_NUMBER = Result.Value("c067")
Do
' Zeilen hochzählen
Dim AmountOrdered, AmountDelivered
AmountOrdered = Cint(Result.Value("c005"))
AmountDelivered = Cint(Result.Value("c016"))
ProductGroup = Cint(Result.Value("c012"))
Amount = AmountOrdered - AmountDelivered
ChargeFlag = Cint(Result.Value("c055"))
If ChargeFlag = 2 Then
For index = 1 To Amount
Dim IsLateShape
SQL = "(C002 = '" & Result.Value("c003") & "')"
' Nach Mandant und Wirtschaftsjahr filtern
SQL = SQL & SQLQuery_BasicWhere
Set ShapeResult = CWLStart.CurrentCompany.SearchRecord (TABLE_21, SQL)
If Len(ShapeResult.Value("C222")) > 0 Then
IsLateShape = 1
Else
IsLateShape = 0
End If
CWLCurrentWindow.ActiveWindow.Vars.Value(495,0) = 1
CWLCurrentWindow.ActiveWindow.Vars.Value(495,1) = 0
CWLCurrentWindow.ActiveWindow.Vars.Value(495,2) = ""
CWLCurrentWindow.ActiveWindow.Vars.Value(495,3) = Result.Value("c003")
CWLCurrentWindow.ActiveWindow.Vars.Value(495,4) = Result.Value("c004")
CWLCurrentWindow.ActiveWindow.Vars.Value(495,5) = 1
CWLCurrentWindow.ActiveWindow.Vars.Value(495,6) = IsLateShape
Grid.AddLine
' Zeilenfarbe mit ROT vorbelegen
Grid.SetLineColor LineCounter, COLOR_RED
LineCounter = LineCounter + 1
Next
Else
If ProductGroup >= 100 Then
CWLCurrentWindow.ActiveWindow.Vars.Value(495,0) = Amount
CWLCurrentWindow.ActiveWindow.Vars.Value(495,1) = Amount
LineColor = COLOR_GREEN
Else
CWLCurrentWindow.ActiveWindow.Vars.Value(495,0) = Amount
CWLCurrentWindow.ActiveWindow.Vars.Value(495,1) = 0
LineColor = COLOR_RED
End If
CWLCurrentWindow.ActiveWindow.Vars.Value(495,2) = ""
CWLCurrentWindow.ActiveWindow.Vars.Value(495,3) = Result.Value("c003")
CWLCurrentWindow.ActiveWindow.Vars.Value(495,4) = Result.Value("c004")
CWLCurrentWindow.ActiveWindow.Vars.Value(495,5) = 0
CWLCurrentWindow.ActiveWindow.Vars.Value(495,6) = 0
' Ergebnisse aus SQL in Zeile schreiben
Grid.AddLine
' Zeilenfarbe mit ROT vorbelegen
Grid.SetLineColor LineCounter, LineColor
LineCounter = LineCounter + 1
End If
Loop While Result.NextRecord = True
Else
MsgBox "Beim Laden des Auftrags ["& OrderNumber &"] wurden keine Zeilen zurück gegeben.", vbExclamation, DEFAULT_TITLE
LoadOrder = False
End If
LoadOrder = True
Grid.IsRedraw = True
End Function

16
current/Modules/Sicherungen/Modules_20230623/Packtisch/SerialNumberExists.vbs Normal file
View File

@@ -0,0 +1,16 @@
' Version Date: 25.09.2020
Function SerialNumberExists(SerialNumber)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
SerialNumberExists = False
For Row = 1 To Grid.LineCount
CurrentSerialNumber = Grid.GetCellValue(Row, COLUMN_SERIALNUMBER)
If SerialNumber = CurrentSerialNumber Then
SerialNumberExists = True
Exit For
End If
Next
End Function

76
current/Modules/Sicherungen/Modules_20230623/Packtisch/SerialNumberMatches.vbs Normal file
View File

@@ -0,0 +1,76 @@
' Version Date: 05.01.2021
Function SerialNumberMatches(ArticleNumber, SerialNumber)
HasError = False
SQL = ""
SQL = SQL & "(C002 = '" & ArticleNumber & "')"
' Nach Mandant und Wirtschaftsjahr filtern
SQL = SQL & SQLQuery_BasicWhere
Set ResultMainArticle = CWLStart.CurrentCompany.SearchRecord(TABLE_21, SQL)
If ResultMainArticle.RowCount > 0 Then
SerialNumberPattern = ResultMainArticle.Value("C222")
End If
If DEBUG_ON = True Then
AddDebugLine "Preparing Regex Check. " & vbNewline
AddDebugLine "SerialNumber: " & SerialNumber
AddDebugLine "SerialNumberPattern: " & SerialNumberPattern
AddDebugLine "ArticleNumber: " & ArticleNumber
ShowDebugBox "SerialNumberMatches"
End If
If Len(SerialNumberPattern) > 0 And Len(SerialNumber) > 0 Then
Set SerialNumberRegex = New Regexp
SerialNumberRegex.Pattern = SerialNumberPattern
SerialNumberRegex.IgnoreCase = False
SerialNumberRegex.Global = False
Set RegexMatch = SerialNumberRegex.Execute(SerialNumber)
If RegexMatch.Count > 0 Then
Set FirstMatch = RegexMatch.Item(0)
If DEBUG_ON = True Then
AddDebugLine "Checked Serialnumber against Regex. (1/2)" & vbNewline
AddDebugLine "FirstMatch.Length: " & FirstMatch.Length
AddDebugLine "Len(SerialNumber): " & Len(SerialNumber)
AddDebugLine "FirstMatch.FirstIndex: " & FirstMatch.FirstIndex
ShowDebugBox "SerialNumberMatches"
End If
If FirstMatch.Length = Len(SerialNumber) And FirstMatch.FirstIndex = 0 Then
HasError = False
Else
HasError = True
End If
If DEBUG_ON = True Then
AddDebugLine "Checked Serialnumber against Regex. (2/2)" & vbNewline
AddDebugLine "Result: " & SerialNumberRegex.Test(SerialNumber)
AddDebugLine "Serialnumber: " & SerialNumber
AddDebugLine "Regex: " & SerialNumberPattern
ShowDebugBox "SerialNumberMatches"
End If
Else
HasError = True
End If
Else
HasError = True
End If
If HasError = True Then
SerialNumberMatches = False
Else
SerialNumberMatches = True
End If
End Function

18
current/Modules/Sicherungen/Modules_20230623/Packtisch/SetAmount.vbs Normal file
View File

@@ -0,0 +1,18 @@
' SetAmount(Amount: Integer)
' ---------------------------------------------------------
' Setzt eigegeben Menge in das Mengenfeld
' - Überschreibt Menge beim ersten Eintrag, danach
' wird die Zahl angehängt
'
' Rückgabewert: Keiner
' ---------------------------------------------------------
Sub SetAmount(Amount)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set amountBox = mywin.Controls.Item(AMOUNT_INPUT)
If amountBox.Contents = AMOUNT_PLACEHOLDER Then
amountBox.Contents = Cstr(Amount)
Else
amountBox.Contents = amountBox.Contents & Cstr(Amount)
End If
End Sub

47
current/Modules/Sicherungen/Modules_20230623/Packtisch/SetupWindow.vbs Normal file
View File

@@ -0,0 +1,47 @@
' Version Date: 01.10.2020
Sub SetupWindow()
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
' Speicher für benutzerdefinierte Felder
' (495,0) - Menge Gescannt
' (495,1) - Menge Gesamt
' (495,2) - Seriennummer
' (495,3) - Artikelnummer
' (495,4) - Bezeichnung
' (495,5) - Chargen-/Identflag
' (495,5) - Spät ausgeprägt bzw. Regex vorhanden
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 0, "2", 10
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 1, "2", 10
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 2, "1", 20
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 3, "1", 20
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 4, "1", 60
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 5, "2", 3
CWLCurrentWindow.ActiveWindow.Vars.CreateVar 495, 6, "2", 3
Grid.InitUserGrid
Grid.IsRedraw = False
Grid.Header
If COLUMNS_CREATED = False Then
COLUMN_ARTICLENUMBER = Grid.AddColumn("Artikelnummer", "T21,Artikelnummer", "1","V",0,495,3,20,scrtflag+sizeflag+hideflag)
COLUMN_DESCRIPTION = Grid.AddColumn("Bezeichnung", "T21,Bezeichnung", "1","V",0,495,4,30,scrtflag+sizeflag+hideflag)
COLUMN_TOTAL = Grid.AddColumn("Gesamt", "T22,Gesamt", "1","V",0,495,0,10,scrtflag+sizeflag+hideflag)
COLUMN_SCANNED = Grid.AddColumn("Gescannt", "T22,Gescannt", "1","V",0,495,1,10,scrtflag+sizeflag+hideflag)
COLUMN_SERIALNUMBER = Grid.AddColumn("Seriennummer", "T21,Seriennummer", "l","V",0,495,2,20,scrtflag+sizeflag+hideflag)
COLUMN_TYPE = Grid.AddColumn("S/N?", "T17,Seriennummer", "l","V",0,495,5,6,scrtflag+sizeflag+hideflag)
COLUMN_LATE_SHAPE = Grid.AddColumn("Auspr?", "T17,Spaetausgepr.", "l","V",0,495,6,6,scrtflag+sizeflag+hideflag)
COLUMNS_CREATED = True
End If
Grid.IsRedraw = True
Set amountBox = mywin.Controls.Item(AMOUNT_INPUT)
amountBox.Contents = AMOUNT_PLACEHOLDER
Set articleBox = mywin.Controls.Item(ARTICLE_INPUT)
articleBox.Contents = ""
MacroCommands.MSetFieldFocus WINDOW_ID, ORDER_INPUT
End Sub

55
current/Modules/Sicherungen/Modules_20230623/Packtisch/TestArticleHasSerialNumberRegex.vbs Normal file
View File

@@ -0,0 +1,55 @@
' TestArticleHasSerialNumberRegex(Identifier: String)
' ---------------------------------------------------------
' Findet Artikelnummer anhand von versch. Kriterien
' - Artikel-Nummer, Alternative Artikel-Nummer, EAN-Code, Seriennummer
' - Gibt die Zeile im Grid zurück in der Artikel das erste Mal gefunden wurde
'
' Rückgabewert: ArticleRow: Int
' ---------------------------------------------------------
' Version Date: 25.09.2020
Function TestArticleHasSerialNumberRegex(Identifier)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
If DEBUG_ON = True Then
AddDebugLine "Testing for Regex in Identifier: " & Identifier
ShowDebugBox "TestArticleHasSerialNumberRegex"
End If
SQL = ""
' Artikelnummer / EAN-Code / Alternative Artikelnummer
SQL = SQL & "((C002 = '" & Identifier & "') Or (C075 = '" & Identifier & "') Or (C114 = '" & Identifier & "')) AND "
' Serienummer-Regex muss vorhanden sein
SQL = SQL & "(C222 IS NOT NULL) AND "
' Artikel darf nicht inaktiv sein
SQL = SQL & "(c038 IS NULL) "
' Nach Mandant und Wirtschaftsjahr filtern
SQL = SQL & SQLQuery_BasicWhere
If DEBUG_ON = True Then
AddDebugLine "SQL: " & SQL
ShowDebugBox "TestArticleHasSerialNumberRegex"
End If
Set Result = CWLStart.CurrentCompany.SearchRecord(TABLE_21, SQL)
If DEBUG_ON = True Then
AddDebugLine "Searching for SerialNumber-Regex by ArticleNumber " & vbNewline
AddDebugLine "Result Columns: " & Result
AddDebugLine "Result Rows: " & Result.RowCount
AddDebugLine "SQL: " & SQL
ShowDebugBox "TestArticleHasSerialNumberRegex"
End If
If Result.RowCount > 0 Then
TestArticleHasSerialNumberRegex = True
Else
TestArticleHasSerialNumberRegex = False
End If
End Function

23
current/Modules/Sicherungen/Modules_20230623/Packtisch/TestHasFreeArticleRow.vbs Normal file
View File

@@ -0,0 +1,23 @@
' Version Date: 25.09.2020
Function TestHasFreeArticleRow(ArticleNumber)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
Dim NextFreeRow : NextFreeRow = False
If DEBUG_ON = True Then
AddDebugLine "Getting next free row for Article: " & ArticleNumber
ShowDebugBox "TestHasFreeArticleRow"
End If
For Row = 1 To Grid.LineCount
CurrentArticleNumber = Grid.GetCellValue(Row, COLUMN_ARTICLENUMBER)
CurrentSerialNumber = Grid.GetCellValue(Row, COLUMN_SERIALNUMBER)
If UCase(ArticleNumber) = UCase(CurrentArticleNumber) And Len(CurrentSerialNumber) = 0 Then
NextFreeRow = True
Exit For
End If
Next
TestHasFreeArticleRow = NextFreeRow
End Function

47
current/Modules/Sicherungen/Modules_20230623/Packtisch/TestIsWebserviceResponseSuccessful.vbs Normal file
View File

@@ -0,0 +1,47 @@
' Version Date: 30.09.2020
Function TestIsWebserviceResponseSuccessful(XmlString)
' Check if XmlString is actually a xml string
If InStr(XmlString, "<?xml") = 1 Then
Set Doc = CreateObject("MSXML2.DOMDocument")
Doc.loadXML(XmlString)
Set Nodes = Doc.SelectNodes("MESOWebServiceResult/ResultDetails")
Set OverallSuccess = Doc.SelectSingleNode("MESOWebServiceResult/OverallSuccess")
If OverallSuccess.Text = "true" Then
Dim IsSuccess : IsSuccess = True
For Each Node in Nodes
Set Success = Node.SelectSingleNode("Success")
If Success.Text <> "true" Then
IsSuccess = False
End If
Next
TestIsWebserviceResponseSuccessful = IsSuccess
Else
TestIsWebserviceResponseSuccessful = False
End If
Else
TestIsWebserviceResponseSuccessful = False
End If
End Function
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

60
current/Modules/Sicherungen/Modules_20230623/Packtisch/UpdateArticleRow.vbs Normal file
View File

@@ -0,0 +1,60 @@
' UpdateArticleRow(RowNumber: Integer)
' ---------------------------------------------------------
' Trägt die gescannte Menge eines Artikel in das Grid ein
' - Ändert die Farbe, abhängig von Gesamtmenge und Gescannte Menge
' - Überprüft, ob Artikel in der Gescannten Menge auf Lager liegt
'
' Rückgabewert: Keiner
' ---------------------------------------------------------
' Version Date: 03.12.2020
Sub UpdateArticleRow(RowNumber)
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
Set amountBox = mywin.Controls.Item(AMOUNT_INPUT)
DebugMessage = ""
' Bereits gescannte, Gesamt und Anzahl zu Scannen auslesen
ProductNumber = Grid.GetCellValue(RowNumber, COLUMN_ARTICLENUMBER)
Total = Cint(Grid.GetCellValue(RowNumber, COLUMN_TOTAL))
Scanned = Cint(Grid.GetCellValue(RowNumber, COLUMN_SCANNED))
ScannedAmount = Cint(amountBox.Contents)
' Aktuellen Lagerstand abfragen
StockedAmount = GetWinLineStockedAmount(ProductNumber, False)
' Neue bereits gescannte berechnen
NewScanned = Scanned + ScannedAmount
If DEBUG_ON = True Then
AddDebugLine "Total " & Total
AddDebugLine "Scanned: " & Scanned
AddDebugLine "NewScanned: " & NewScanned
AddDebugLine "StockedAmount: " & StockedAmount
ShowDebugBox "UpdateArticleRow"
End If
' Zeilenfarbe anpassen:
' GRÜN: Komplett gescannt
' GELB: Teilweise gescannt
If NewScanned > StockedAmount Then
Message = ""
Message = Message & "Der Artikel ist nur in der Menge " & StockedAmount & " vorhanden." & vbNewline
Message = Message & "Der Scan wird abgebrochen!"
Msgbox Message, vbExclamation, DEFAULT_TITLE
Elseif NewScanned = Total Then
Grid.SetLineColor RowNumber, COLOR_GREEN
Grid.SetCellValue RowNumber, COLUMN_SCANNED, NewScanned
Elseif NewScanned < Total Then
Grid.SetLineColor RowNumber, COLOR_YELLOW
Grid.SetCellValue RowNumber, COLUMN_SCANNED, NewScanned
Else
Message = ""
Message = Message & "Eingegebene Menge überschreitet die Gesamt-Anzahl oder" & vbNewline
Message = Message & "Artikel wurde bereits vollständig gescannt!"
Msgbox Message, vbExclamation, DEFAULT_TITLE
End If
End Sub

237
current/Modules/Sicherungen/Modules_20230623/Packtisch_3_0/ArticleExists.vbm Normal file
View File

@@ -0,0 +1,237 @@
' ArticleExists(Identifier: String)
' ----------------------------------------------------------------------------
' Findet Artikelnummer anhand von versch. Kriterien
' - Artikel-Nummer, Alternative Artikel-Nummer, EAN-Code, Seriennummer
' - Gibt die Zeile im Grid zurück in der Artikel das erste Mal gefunden wurde
'
' Returns: ArticleExists: Int
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 01.09.2020 / JJ
' Version Date / Editor: 13.12.2021 / MP
' Version Number: 3.0.0.6
Const ARTICLE_EXISTS_NO_STOCK = -99
Const ARTICLE_EXISTS_NO_SERIALNUMBER = -98
Const ARTICLE_EXISTS_NO_ARTICLE_EAN = -97
Const ARTICLE_EXISTS_NO_REGEX_MATCH = -96
Const ARTICLE_EXISTS_OVERSCANNED = -95
Function ArticleExists(Identifier)
ArticleExists = 0
HasError = False
CURRENT_SERIALNUMBER = ""
Set mywin = CWLStart.CurrentModule.Windows.Item(WINDOW_ID)
Set amountBox = mywin.Controls.Item(AMOUNT_INPUT)
Set Grid = mywin.Controls.Item(GRID_ID).Grid
' ===================== SERIENNUMMER =====================
' Zuerst prüfen wir, ob es ein Seriennummerartikel ist
Set ResultSeriennummer = GetSeriennummerRow(Identifier)
If ResultSeriennummer.RowCount > 0 Then
SerialNumberString = ResultSeriennummer.Value("C068")
MainArticleNumber = ResultSeriennummer.Value("C011")
SQL = ""
SQL = SQL & "(C002 = '" & MainArticleNumber & "') "
' Nach Mandant und Wirtschaftsjahr filtern
SQL = SQL & SQLQuery_BasicWhere
Set ResultMainArticle = CWLStart.CurrentCompany.SearchRecord(TABLE_21, SQL)
If ResultMainArticle.RowCount > 0 Then
' Default: ART_REGEX_FLDBEZ = C222
SerialNumberPattern = ResultMainArticle.Value(ART_REGEX_FLDBEZ)
End If
If DEBUG_ON = True Then
AddDebugLine "Preparing Regex Check. " & vbNewline
AddDebugLine "SerialNumberString: " & SerialNumberString
AddDebugLine "SerialNumberPattern: " & SerialNumberPattern
AddDebugLine "MainArticleNumber: " & MainArticleNumber
ShowDebugBox "ArticleExists"
End If
If Len(SerialNumberPattern) > 0 And Len(SerialNumberString) > 0 Then
Set SerialNumberRegex = New Regexp
With SerialNumberRegex
.Pattern = SerialNumberPattern
.IgnoreCase = False
.Global = False
End With
Set RegexMatch = SerialNumberRegex.Execute(SerialNumberString)
Set FirstMatch = RegexMatch.Item(0)
If DEBUG_ON = True Then
AddDebugLine "Checked Serialnumber against Regex. (1/2)" & vbNewline
AddDebugLine "FirstMatch.Length: " & FirstMatch.Length
AddDebugLine "Len(SerialNumberString): " & Len(SerialNumberString)
AddDebugLine "FirstMatch.FirstIndex: " & FirstMatch.FirstIndex
ShowDebugBox "ArticleExists"
End If
If Not (FirstMatch.Length = Len(SerialNumberString) And FirstMatch.FirstIndex = 0) Then
ArticleExists = ARTICLE_EXISTS_NO_REGEX_MATCH
HasError = True
End If
If DEBUG_ON = True Then
AddDebugLine "Checked Serialnumber against Regex. (2/2)" & vbNewline
AddDebugLine "Result: " & SerialNumberRegex.Test(SerialNumberString)
AddDebugLine "Serialnumber: " & SerialNumberString
AddDebugLine "Regex: " & SerialNumberPattern
ShowDebugBox "ArticleExists"
End If
End If
CURRENT_SERIALNUMBER = Identifier
Set Result = ResultSeriennummer
Else
' ===================== ARTIKEL NUMMER / EAN-CODE =====================
' Wenn es kein Ausprägeartikel ist, suchen wir im Artikelstamm
Set Result = GetArticleRow(Identifier)
End If
'==========================================================
If HasError = True Then
' Just skip the rest of the function and return the current error
Elseif Result.RowCount > 0 Then
' Wir brauchen die Hauptartikelnummer, weil die Prüfung sonst bei SN-Artikeln fehlschlägt
MainArticleNumber = Result.Value("C011")
RealArticleNumber = Result.Value("C002")
AmountStocked = GetWinLineStockedAmount(RealArticleNumber, False)
If DEBUG_ON = True Then
AddDebugLine "Checking stock of product: " & RealArticleNumber & " (" & MainArticleNumber & ")" & vbNewline
AddDebugLine "Result Columns: " & Result
AddDebugLine "Result Rows: " & Result.RowCount
AddDebugLine "Stock: " & AmountStocked
AddDebugLine "SQL: " & SQL
ShowDebugBox "ArticleExists"
End If
If AmountStocked > 0 Then
If DEBUG_ON = True Then
AddDebugLine "Amount stocked: " & AmountStocked
End If
' Vorkommen in Tabelle prüfen
For GridLineIndex = 1 To Grid.LineCount
CurrentArticleNumber = Grid.GetCellValue(GridLineIndex, COLUMN_ARTICLENUMBER)
Total = Cint(Grid.GetCellValue(GridLineIndex, COLUMN_TOTAL))
Scanned = Cint(Grid.GetCellValue(GridLineIndex, COLUMN_SCANNED))
Amount = CInt(amountBox.ScreenContents)
If CurrentArticleNumber = MainArticleNumber Then
If DEBUG_ON = True Then
AddDebugLine "CurrentArticleNumber matches MainArticleNumber! (" & CurrentArticleNumber & ")"
End If
If Total > Scanned Then
If DEBUG_ON = True Then
AddDebugLine "Product is not yet scanned completely and exists in Row " & GridLineIndex & "!"
End If
If (Total - Scanned) >= Amount Then
ArticleExists = GridLineIndex
Exit For
Else
If GetCountInDuplList(CurrentArticleNumber) <= 1 Then
Exit For
End If
End If
Else
ArticleExists = ARTICLE_EXISTS_OVERSCANNED
End If
End If
Next
Else
If DEBUG_ON = True Then
AddDebugLine "Amount stocked: 0"
End If
ArticleExists = ARTICLE_EXISTS_NO_STOCK
End If
If DEBUG_ON = True Then
ShowDebugBox "ArticleExists"
End If
Else
If CURRENT_SERIALNUMBER = "" Then
ArticleExists = ARTICLE_EXISTS_NO_ARTICLE_EAN
Else
ArticleExists = ARTICLE_EXISTS_NO_SERIALNUMBER
End If
End If
End Function
Function GetSeriennummerRow(Identifier)
Set GetSeriennummerRow = Nothing
If Len(Identifier) > 0 Then
Set Conn = CWLStart.Connection
SQL = ""
SQL = SQL & " SELECT TOP 1 C002, C011, C068 "
SQL = SQL & " FROM T024 (NOLOCK) "
SQL = SQL & " WHERE C068 = '" & Identifier & "' "
SQL = SQL & " AND c038 IS NULL " ' Nur aktive Artikel
SQL = SQL & SQLQuery_BasicWhere
Set GetSeriennummerRow = Conn.Select(SQL)
If DEBUG_ON = True Then
AddDebugLine "Searching for Article by Article serial number " & vbNewline
AddDebugLine "Result Columns: " & GetSeriennummerRow
AddDebugLine "Result Rows: " & GetSeriennummerRow.RowCount
AddDebugLine "SQL: " & SQL
ShowDebugBox "ArticleExists - GetSeriennummerRow"
End If
End If
End Function
' Ruft Daten aus der Tabelle t024 ab, für Artikel OHNE Ausprägung
Function GetArticleRow(Identifier)
Set GetArticleRow = Nothing
If Len(Identifier) > 0 Then
Set Conn = CWLStart.Connection
SQL = ""
SQL = SQL & " SELECT TOP 1 C002, C011 "
SQL = SQL & " FROM T024 (NOLOCK) "
SQL = SQL & " WHERE (C002 = '" & Identifier & "' OR C075 = '" & Identifier & "' OR C114 = '" & Identifier & "' OR C115 = '" & Identifier & "') "
SQL = SQL & " AND c038 IS NULL " ' Nur aktive Artikel
SQL = SQL & SQLQuery_BasicWhere
Set GetArticleRow = Conn.Select(SQL)
If DEBUG_ON = True Then
AddDebugLine "Searching for Article by ArticleNo/EAN-Code.. " & vbNewline & vbNewline
AddDebugLine "Result Columns: " & GetArticleRow & vbNewline
AddDebugLine "Result Rows: " & GetArticleRow.RowCount & vbNewline
AddDebugLine "SQL: " & SQL
ShowDebugBox "ArticleExists - GetArticleRow"
End If
End If
End Function

82
current/Modules/Sicherungen/Modules_20230623/Packtisch_3_0/CheckArticleGroupIsRelevant.vbm Normal file
View File

@@ -0,0 +1,82 @@
' CheckArticleGroupIsRelevant(ArticleGroup : Integer)
' ----------------------------------------------------------------------------
' Prüft, ob die übergebene Artikelgruppe am Packtisch bearbeitet/gescannt
' werden kann (true), oder ob es sich um eine "nicht-relevante" Artikelgruppe
' handelt (false), zb Versandkosten, die auf nicht sichtbar geschaltet wird.
'
' Geprüft wird gegen die Variable EXCLUDED_ARTICLEGROUPS, die im Fensterscript
' konfiguriert werden kann.
' Die Variable kann entweder genau einen Wert, einen unteren/oberen Grenzwert
' oder eine Liste von Werten enthalten.
' Erlaubte Beispiele:
' - Genau ein Wert: "100"
' - Grenzwert bis/ab dem dies gilt: "100-" / "100+"
' - Array von verschiedenen Werten: "100, 101, 102"
'
' Wenn keine Artikelgruppe als nicht-relevant definiert wurde oder die zu
' prüfende Artikelgruppe ist leer oder kleiner 1, wird True zurückgegeben.
'
' Returns: CheckArticlegroupIsRelevant : Boolean
' ----------------------------------------------------------------------------
' Copyright (c) 2021 by Digital Data GmbH
'
' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
' Tel.: 0641/202360 • E-Mail: info-flow(at)digitaldata.works
' ----------------------------------------------------------------------------
' Creation Date / Author: 24.06.2021 / MP
' Version Date / Editor: 28.06.2021 / MP
' Version Number: 3.0.0.4
Function CheckArticleGroupIsRelevant(ArticleGroup)
CheckArticleGroupIsRelevant = True
' Wenn die Variable leer ist, sind alle Artikelgruppen relevant
If Len(EXCLUDED_ARTICLEGROUPS) <= 0 Then
Exit Function
End If
' Ohne Wert geht gar nichts, auch Negative Werte sind sinnlos
If Len(ArticleGroup) <= 0 Or ArticleGroup < 0 Then
CheckArticleGroupIsRelevant = False
Exit Function
End If
' Wenn EXCLUDED_ARTICLEGROUPS ein Komma enthält, muss ein Array
' aus den Elementen erzeugt werden.
posKomma = InStr(EXCLUDED_ARTICLEGROUPS, ",")
If posKomma > 0 Then
exValueArray = Split(EXCLUDED_ARTICLEGROUPS, ",")
For Each exValue in exValueArray
If Cint(exValue) = ArticleGroup Then
CheckArticleGroupIsRelevant = False
Exit Function
End If
Next
Else
posPlus = InStr(EXCLUDED_ARTICLEGROUPS, "+")
posMinus = InStr(EXCLUDED_ARTICLEGROUPS, "-")
If posPlus > 0 Then
' + enthalten, die Variable enthält ein unteres Limit
limit = CInt(Mid(EXCLUDED_ARTICLEGROUPS, 1, posPlus-1))
If ArticleGroup >= limit Then
CheckArticleGroupIsRelevant = False
End If
ElseIf posMinus > 0 Then
' - enthalten, die Variable enthält ein oberes Limit
limit = CInt(Mid(EXCLUDED_ARTICLEGROUPS, 1, posMinus-1))
If ArticleGroup <= limit Then
CheckArticleGroupIsRelevant = False
End If
Else
' Die Variable enthält genau eine Artikelgruppe
If ArticleGroup = CInt(EXCLUDED_ARTICLEGROUPS) Then
CheckArticleGroupIsRelevant = False
End If
End If
End If
End Function

Some files were not shown because too many files have changed in this diff Show More