PowerShell aus einem Menüpunkt starten #

sub main(id)
    Dim command, strOutput, strError
    
    command = CommandScript("C:\users\johndoe\desktop\pwtest.ps1")
    command = Append(command, "-udl", """X:\Eulanda_1 MyCompany.udl""")
    command = Append(command, "-deliveryId", id)

    call Powershell(command, true, 30, strOutput, strError)
end sub

option explicit


Sub Popup(sec)
    Dim WshShell, fso, tempFolder, tempFilePath, file
    Dim vbscriptCode

    if sec > 0 then
        vbscriptCode = "Dim message, WshShell" & vbCrLf & _                        
            "Set WshShell = CreateObject(""WScript.Shell"")" & vbCrLf & _
            "message = ""Bitte warten, die Verarbeitung kann bis zu '" & sec & "' Sekunden dauern...""" & vbCrLf & _
            "firstRun = False" & vbCrLf & _
            "Do" & vbCrLf & _
            "    If Not firstRun Then WshShell.Popup message, " & sec & " , ""Info-Popup"", 0" & vbCrLf & _
            "    WScript.Sleep 10" & vbCrLf & _
            "    firstRun = True" & vbCrLf & _
            "Loop While WshShell.AppActivate(""ShowPopup.vbs"")"

        Set fso = CreateObject("Scripting.FileSystemObject")
        tempFolder = fso.GetSpecialFolder(2)  ' 2 stands for the temporary folder
        If Not fso.FolderExists(tempFolder) Then
            fso.CreateFolder(tempFolder)
        End If
        tempFilePath = fso.BuildPath(tempFolder, "ShowPopup.vbs")

        Set file = fso.CreateTextFile(tempFilePath, True)
        file.Write vbscriptCode
        file.Close
        Set WshShell = CreateObject("WScript.Shell")
        WshShell.Run "wscript.exe " & tempFilePath, 0, false
    end if
End Sub



Function ConvertUmlaute(strInput)
    Dim strOutput
    strOutput = ""

    Dim i
    For i = 1 To Len(strInput)
        Dim character
        character = Mid(strInput, i, 1)

        Dim asciiValue
        asciiValue = AscW(character)

        Select Case asciiValue
            Case 8482
                character = "Ö"
            Case 381
                character = "Ä"
            Case 353
                character = "Ü"
            Case 8221
                character = "ö"
            Case 8222
                character = "ä"
            Case 129
                character = "ü"
            Case 225
                character = "ß"
            case 184
                character = "©"    
            case 169
                character = "®"    
        End Select        
        strOutput = strOutput & character
    Next

    ConvertUmlaute = strOutput
End Function


Function RemoveAnsiCodes(str)
    Dim regex

    Set regex = New RegExp
    regex.Pattern = "\x1B\[([0-9]{1,2}(;[0-9]{1,2})?)?[mGK]"
    regex.Global = True
    RemoveAnsiCodes = regex.Replace(str, "")
End Function

Function TrimCrLf(ByVal str)
    ' Remove leading line breaks and spaces
    Do While Left(str, 2) = vbCrLf Or Left(str, 1) = vbLf Or Left(str, 1) = " "
        If Left(str, 2) = vbCrLf Then
            str = Mid(str, 3)
        ElseIf Left(str, 1) = vbLf Then
            str = Mid(str, 2)
        Else
            str = Trim(Mid(str, 2))
        End If
    Loop

    ' Remove trailing line breaks and spaces
    Do While Right(str, 2) = vbCrLf Or Right(str, 1) = vbLf Or Right(str, 1) = " "
        If Right(str, 2) = vbCrLf Then
            str = Left(str, Len(str) - 2)
        ElseIf Right(str, 1) = vbLf Then
            str = Left(str, Len(str) - 1)
        Else
            str = Trim(Left(str, Len(str) - 1))
        End If
    Loop

    TrimCrLf = str
End Function


Function GetOutput(Message)
    Dim output
    output = ""

    Dim line, lines
    lines = Split(Message, vbCrLf)

    For Each line In lines
        ' Check that the line does not start with "Write-Error:"
        If (Left(line, 12) <> "Write-Error:") and  (Left(line, 14) <> "ERROR Message:") Then
            output = output & vbCrLf & Trim(line)            
        End If
    Next

    output = TrimCrLf(output)
    GetOutput = output
End Function


Function GetError(Message)
    Dim errors
    errors = ""

    Dim line, lines
    lines = Split(Message, vbCrLf)

    For Each line In lines
        If Left(line, 12) = "Write-Error:" Then
            errors = errors & vbCrLf & Trim(Mid(line, 13))
        elseif Left(line, 14) = "ERROR Message:" Then 
            errors = errors & vbCrLf & Trim(Mid(line, 15))
        End If
    Next

    errors = TrimCrLf(errors)
    GetError = errors
End Function



Function Append(strBase, strAppend1, strAppend2)
    If (strBase <> "") And (Right(strBase, 1) <> " ") Then
        strBase = strBase & " "
    End If
    strBase = strBase & strAppend1
    If strAppend2 <> "" Then
        strBase = strBase & " " & strAppend2
    End If
    Append = strBase
End Function


function CommandScript(strScript)
    Const quotes = """"
    dim strBase
    strBase = "pwsh.exe -windowstyle hidden -nologo -noprofile -ExecutionPolicy Bypass -File"
    CommandScript = Append("", strBase, quotes & strScript & quotes)
end function


function CommandInline(str)
    dim strBase
    strBase = "pwsh.exe -windowstyle hidden -nologo -noprofile -ExecutionPolicy Bypass --Command"
    Command = strBase & " " & str
    ' sample to call this sub procedure
    ' CommandInline("try {throw 'This is an exception, ut with Umlaut ÖÄÜ!'} catch {Write-Output $_.Exception.Message; exit 99}")
end function


Function IsPwshInstalled()
    Dim WshShell, strPwsh

    Set WshShell = CreateObject("WScript.Shell")
    On Error Resume Next
    strPwsh = WshShell.RegRead("HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\pwsh.exe\")
    On Error GoTo 0
    Dim fso: Set fso = CreateObject("Scripting.FileSystemObject")
    If fso.FileExists(strPwsh) Then
        IsPwshInstalled = True
    Else
        IsPwshInstalled = False
    End If
End Function


dim top

sub PowerShell(CommandLine, MsgOnSuccess, sec, ByRef strOutput, ByRef strError)
    ' 1. paramater = call with pwsh, standard switches and script as well as script parameters
    ' 2. parameter = show no message if successful
    ' 3. parameter = Wait seconds for the popup. Draws attention to the fact that something is still happening. At 0 no popup comes

    ' Popup is called in backgroud to inform the slow loading process of powershell
    Popup(sec)

    Dim fso, WshShell, tempFileName, file, line, strCommon, result
    Const TemporaryFolder = 2
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set WshShell = CreateObject("WScript.Shell")

    tempFileName = fso.GetSpecialFolder(TemporaryFolder) & "\" & fso.GetTempName                       
    CommandLine = "%comspec% /c """ & CommandLine & " > " & tempFileName & " 2>&1" & """"
    ' Use RUN, because it hides the window, side effect it did not support stdErr
    Top = top & "Now22 = " & Now
    result = WshShell.Run(CommandLine, 0, true)


    ' Read the output from the temp file
    Set file = fso.OpenTextFile(tempFileName, 1)
    strOutput = ""
    strError = ""
    Do Until file.AtEndOfStream
    strOutput = strOutput & file.ReadLine() & vbCrLf
    Loop
    file.Close()
    fso.DeleteFile(tempFileName)
    strOutput = ConvertUmlaute(strOutput)
    strOutput = RemoveAnsiCodes(strOutput)
    strError = GetError(strOutput)
    strOutput = GetOutput(strOutput)
    if strOutput <> "" then strCommon = "Output:" & vbCrLf & strOutput else strCommon = ""         
        if strError <> "" then strCommon = Trim(strCommon & vbCrLf & vbCrlf & "Error(s):" & vbCrlf & strError)
     
    if result <> 0 Then         
                ellib.showMessage(strCommon & vbCrLf & vbCrLf & "Errorcode: " & result )
    Else
        If MsgOnSuccess Then
            ellib.showMessage(strOutput)
        End if
    end if
end sub


sub main(id)
    Dim command, strOutput, strError
    
    command = CommandScript("C:\users\johndoe\desktop\pwtest.ps1")
    command = Append(command, "-udl", """X:\Eulanda_1 MyCompany.udl""")
    command = Append(command, "-deliveryId", id)

    call Powershell(command, true, 30, strOutput, strError)
end sub


Main(1)

[cmdletbinding()]
Param(
    [string]$udl,
    [int]$deliveryId
)

function Start-Popup {
    param (
        [Parameter(Mandatory=$true)]
        [int]$sec
    )

    if ($sec -gt 0) {
        $vbscriptCode = @'
        Dim message, WshShell
        Set WshShell = CreateObject("WScript.Shell")
        message = "Bitte warten, die Verarbeitung kann bis zu '{0}' Sekunden dauern..."
        firstRun = False
        Do
            If Not firstRun Then WshShell.Popup message, {0} , "Info-Popup", 0
            WScript.Sleep 10
            firstRun = True
        Loop While WshShell.AppActivate("ShowPopup.vbs")

'@ -f $sec

        $tempFolder = [System.IO.Path]::GetTempPath()
        $tempFilePath = Join-Path -Path $tempFolder -ChildPath "ShowPopup.vbs"

        try {
            $vbscriptCode | Out-File -FilePath $tempFilePath -Force
            Start-Process -FilePath "wscript.exe" -ArgumentList $tempFilePath -WindowStyle Hidden
        } catch {
            Write-Error "Failed to create and run VBScript: $_"
        }

    }
}


function Stop-Popup {
    param ()

    $windowTitle = "Info-Popup"
    $process = Get-Process | Where-Object { $_.MainWindowTitle -eq $windowTitle }
    if ($process) {
        Stop-Process -Id $process.Id
    }
}


try {
    Clear-Host -ErrorAction SilentContinue
}
catch {
    <#
        When Clear-Host is called but the script is piped, Clear-Host
        returns an exception like 'Cannot bind argument to parameter 'Path'
        because it is an empty string'. This happens especially when the ps1
        script is called from Eulanda, because here the output is always
        read back via pipe. Clear-Host should be in a separate
        try/catch block in any case.
    #>
}

# Alternatively, an identical function for displaying a popup with start popup is available
# Start-Popup -sec 5

write-error "First error"

Write-Host "Udl: $udl"
Write-Host "DeliveryId: $deliveryId"
Write-Verbose "Verbose is on"

start-sleep -Seconds 3

try {
    write-error "This is umlaut test: ÖÄÜ"
}
catch {
    $ErrorMessage = $_.Exception.Message
    # Try to write error messages
    # Write-Error $ErrorMessage
}
finally {
	<#
  		It can't hurt to call the command Stop-Popup in the finallly block, 
  		especially in case of an exception the popup will be hidden immediately. 
  		In addition, call the command before the first dialog, so that the 
  		popup is then also hidden.
	#>
	Stop-Popup
}

# If an exit code > 0 is set, the error is always displayed within EULANDA
# Exit 99