RzLauncher vs. Win API call

[David Schwartz 430]

I'm using the TRzLauncher (part of the old Raize Library available in GetIt from Konopka) to launch some apps from another app.

 

For some reason, it will sometimes just stop working. It does not generate any sort of error, it simply doesn't do anything. 

 

I've had no problem running the same things using windows API calls, or going into the File Explorer and using right-click -> Open With...

 

It usually works again if I close something else that I'd opened first. It also works if I close and restart the app itself. So I'm curious if there could be some odd memory limitations using it that don't apply if I'm calling the Win API directly. 

 

FYI: I drop one of these on the form and re-use it in a bunch of places in order to avoid having to manage individual instances of it. As I'm typing this, I'm wondering if there could be a reentrancy problem with it? This only happens if I launch something and say to not wait for it to complete. Then it won't let me launch anything else. I guess the Win API doesn't care, but the component might.

 

The help doesn't mention this anywhere. It's a really simple component, but I guess that could be an issue. Any thoughts?

Edited September 11, 2020 by David Schwartz

[Fr0sT.Brutal 900]

No idea. Maybe JVCL implementation would perform better?

[David Schwartz 430]

On 9/11/2020 at 3:10 AM, Fr0sT.Brutal said:

No idea. Maybe JVCL implementation would perform better?

since you're familiar with it, maybe you can tell me if it would suffer from the same problem?

[Anders Melander 1815]

On 9/11/2020 at 9:40 AM, David Schwartz said:

Any thoughts?

I have no idea about how TRzLauncher is implemented, but regardless I would just use a thin wrapper around ShellExecuteEx. Here's the implementation I usually use:

unit amShell;

(*
 * Copyright © 2006 Anders Melander
 *
 * This Source Code Form is subject to the terms of the Mozilla Public
 * License, v. 2.0. If a copy of the MPL was not distributed with this
 * file, You can obtain one at http://mozilla.org/MPL/2.0/.
 *)

interface

uses
  Windows,
  Controls;

type
  Shell = class
  private
  public
    class procedure DisplayURL(const URL: string; Parent: TWinControl = nil; const AdditionalParams: string = '');
    class function DisplayFile(const Filename: string; Parent: TWinControl = nil): boolean;
    class function Execute(const Filename: string; const Parameters: string = ''; Parent: TWinControl = nil; Wait: boolean = False): boolean; overload;
    class function Execute(Parent: TWinControl; const FileName: string; const Operation: string = 'open'; const Parameters: string = ''; ShowCmd: Integer = SW_SHOWNORMAL; Wait: boolean = False): boolean; overload; static;
  end;

resourcestring
  sShellExecuteBrowseError = 'Failed to open the homepage in your default browser.'+#13#13+
    'Homepage: %s'+#13+
    'Error: %s';
  sShellExecuteFileOpenError = 'Failed to open the file.'+#13#13+
    'Filename: %s'+#13+
    'Error: %s';

implementation

uses
  ActiveX,
  ShellAPI,
  SysUtils,
  IOUtils,
  Forms,
  Dialogs,
  StrUtils,
  Classes,
  Types,
  Messages,
  IdURI,
  amCursorService,
  amDialogs;

class function Shell.DisplayFile(const Filename: string; Parent: TWinControl): boolean;
var
  Error: integer;
begin
  Result := Execute(Parent, Filename);

  if (not Result) then
  begin
    Error := GetLastError;
    MessageDlgEx(Format(sShellExecuteFileOpenError, [Filename, SysErrorMessage(Error)]), mtWarning, [mbOk], 0);
  end;
end;

class function Shell.Execute(const Filename, Parameters: string; Parent: TWinControl; Wait: boolean): boolean;
var
  Error: integer;
begin
  Result := Execute(Parent, Filename, '', Parameters, SW_SHOWNORMAL, Wait);

  if (not Result) then
  begin
    Error := GetLastError;
    MessageDlgEx(Format(sShellExecuteFileOpenError, [Filename, SysErrorMessage(Error)]), mtWarning, [mbOk], 0);
  end;
end;

class procedure Shell.DisplayURL(const URL: string; Parent: TWinControl; const AdditionalParams: string);
var
  Error: integer;
  URI: TIdURI;
  FinalURL: string;
  FinalParams: string;
  ParamList: TStringDynArray;
  s: string;
  Params: TStringList;
  n: integer;
  Name, Value: string;
begin
  try
    URI := TIdURI.Create(URL);
    try
      // Note that we use TIdURI even with no additional params as we would still like to get the original params encoded (' '->'%20').
      if (AdditionalParams <> '') then
      begin
        Params := TStringList.Create;
        try
          Params.CaseSensitive := False;

          // Create a Key/Value list of original parameters
          ParamList := SplitString(URI.Params, '&');
          for s in ParamList do
            Params.Add(s);

          // Add additional parameters, overriding the original values if there are duplicates
          ParamList := SplitString(AdditionalParams, '&');
          for s in ParamList do
          begin
            n := Pos('=', s);
            if (n <> 0) then
            begin
              // Key/Value pair
              Name := Copy(s, 1, n-1);
              Value := Copy(s, n+1, MaxInt);
              Params.Values[Name] := Value;
            end else
              // No value, just key
              Params.Values[s] := '';
          end;

          // Build parameter string
          FinalParams := '';
          for s in Params do
            if (FinalParams = '') then
              FinalParams := s
            else
              FinalParams := FinalParams + '&' + s;
        finally
          Params.Free;
        end;
        URI.Params := FinalParams;
      end;

      FinalURL := URI.URI;
    finally
      URI.Free;
    end;
  except
    on E: EIdURIException do
    begin
      s := URL;
      if (AdditionalParams <> '') then
        s := s + '(' + AdditionalParams + ')';
      MessageDlgEx(Format('Invalid URL: %s'#13'%s', [s, E.Message]), mtWarning, [mbOk], 0);
      exit;
    end;
  end;

  if (not Execute(Parent, 'rundll32.exe', 'open', 'url.dll,FileProtocolHandler '+FinalURL)) then
  begin
    Error := GetLastError;
    MessageDlgEx(Format(sShellExecuteBrowseError, [FinalURL, SysErrorMessage(Error)]), mtWarning, [mbOk], 0);
  end;
end;

class function Shell.Execute(Parent: TWinControl; const FileName, Operation, Parameters: string; ShowCmd: Integer; Wait: boolean): boolean;
var
  Handle: HWND;
  ShellExecuteInfo: TShellExecuteInfo;
  Error: integer;
  Res: Cardinal;
  Msg: TMsg;
begin
  if (Parent <> nil) then
    Handle := Parent.Handle
  else
    Handle := Application.MainForm.Handle;

  FillChar(ShellExecuteInfo, SizeOf(ShellExecuteInfo), 0);
  ShellExecuteInfo.cbSize := SizeOf(ShellExecuteInfo);
  ShellExecuteInfo.fMask := SEE_MASK_FLAG_NO_UI or SEE_MASK_HMONITOR or SEE_MASK_NOZONECHECKS;// or SEE_MASK_NOCLOSEPROCESS;
  if (Wait) then
    ShellExecuteInfo.fMask := ShellExecuteInfo.fMask or SEE_MASK_NOCLOSEPROCESS or SEE_MASK_NOASYNC;
  ShellExecuteInfo.Wnd := Handle;
  ShellExecuteInfo.hMonitor := THandle(Application.MainForm.Monitor.Handle); // Cast to avoind range check error
  if (Operation <> '') then
    ShellExecuteInfo.lpVerb := PChar(Operation);
  if (FileName <> '') then
    ShellExecuteInfo.lpFile := PChar(FileName);
  if (Parameters <> '') then
    ShellExecuteInfo.lpParameters := PChar(Parameters);
  ShellExecuteInfo.lpDirectory := PChar(TPath.GetDirectoryName(Filename));
  ShellExecuteInfo.nShow := ShowCmd;

  SaveCursor(crAppStart);

  Result := ShellAPI.ShellExecuteEx(@ShellExecuteInfo);

  if (not Result) then
  begin
    Error := GetLastError;

    if (Error = ERROR_ACCESS_DENIED) then
    begin
      // See:
      // * https://support.microsoft.com/en-us/kb/287087
      // * http://wellsr.com/vba/2016/excel/use-vba-shellexecute-to-open-url-in-default-browser/
      if (ShellAPI.ShellExecute(Handle, ShellExecuteInfo.lpVerb, ShellExecuteInfo.lpFile, ShellExecuteInfo.lpParameters, nil, CmdShow) > SE_ERR_DLLNOTFOUND) then
        Result := True
      else
        SetLastError(Error);
    end;
  end else
  if (Wait) then
  begin
    try
      while (True) do
      begin
        Res := MsgWaitForMultipleObjects(1, ShellExecuteInfo.hProcess, False, INFINITE, QS_PAINT);

        case Res of
          WAIT_OBJECT_0:
            break;

          WAIT_OBJECT_0+1:
            while (PeekMessage(Msg, 0, QS_PAINT shl 16, QS_PAINT shl 16, PM_REMOVE)) do
            begin
              if (Msg.message = WM_QUIT) then
              begin
                PostQuitMessage(Msg.wParam);
                exit;
              end;
              TranslateMessage(Msg);
              DispatchMessage(Msg);
            end;
        else
          break;
        end;
      end;
    finally
      CloseHandle(ShellExecuteInfo.hProcess);
    end;
  end;
end;

var
  NeedCoUninitialize: boolean = False;
initialization
  // ShellExecute needs CoInitialize
  NeedCoUninitialize := Succeeded(CoInitializeEx(nil, COINIT_APARTMENTTHREADED or COINIT_DISABLE_OLE1DDE));
finalization
  if (NeedCoUninitialize) then
    CoUninitialize;
end.

 

[Fr0sT.Brutal 900]

17 hours ago, David Schwartz said:

since you're familiar with it, maybe you can tell me if it would suffer from the same problem?

Actually I'm not as I use my own app launcher with STDIN/OUT redirection. I have an app running 24/7 for months that constantly launches external apps (archiver and some others) without any issue. Btw, your problem looks very alike to resource leakage. You can check if there are non-disposed resources with ProcessExplorer -> Opened handles

[David Schwartz 430]

For the situations where I need to launch and not wait for return, I create an instance dynamically and did some contortions so the OnFinished event handler kills the instance. But when you open a file in, say, Notepad++, it's really irrelevant. If you close the program before these instances have closed, they get freed anyway. The Windows API doesn't seem to care, so I could probably just launch them and forget them.

 

As an aside, I was also looking for some code to launch a command and get the STDOUT back. Someone pointed out that JVCL has something built-in, an Execute function. There are actually several variations. But I couldn't find one that lets me set the working directory, which seems rather odd for such a complicated bunch of code.

 

I found something else here that takes a working dir param, https://delphidabbler.github.io/delphi-tips/tips/61.html but it doesn't capture STDERR. Seems to always be something missing. 🙂

[Fr0sT.Brutal 900]

14 hours ago, David Schwartz said:

But I couldn't find one that lets me set the working directory, which seems rather odd for such a complicated bunch of code.

1-sec googling: https://wiki.delphi-jedi.org/wiki/JVCL_Help:TJvCreateProcess that claims to have CDir setting. I could suggest my implementation but it's somewhat tied to other util units. Anyway there's nothing hard in launching (code is NOT standalone - some additional utils required)

// Launch a process with I/O redirect.
//   @param ExecProps - requisites for launch
//   @param [OUT] Handles - in / out pipe handles, process handle
// @raises Exception on error
procedure ExecProcess(const ExecProps: TExecProps; out Handles: THandleArr);
var
  si: TStartupInfo;
  pi: TProcessInformation;
  sa: TSecurityAttributes;
  hStdOut, hStdIn, hStdErr: THandle;
  IntCmdLine, IntCurrDir, Env: string;
begin
  Handles := Default(THandleArr);
  hStdOut := 0; hStdIn := 0; hStdErr := 0;
  si := Default(TStartupInfo);
  pi := Default(TProcessInformation);

  try try
    // TSecurityAttributes для процесса и труб
    sa := Default(TSecurityAttributes);
    sa.nLength := SizeOf(sa);
    sa.lpSecurityDescriptor := nil;
    sa.bInheritHandle := True;
    // create pipes if needed
    // ! We can't simply override only some of handles - https://stackoverflow.com/questions/30494945
    // But assigning standard values with GetStdHandle results in weird behavior
    // (I/O error on ReadLn specifying standard STDIN, weird hangs etc).
    // As the situation when STDIN is required in executed process but not redirected
    // will unlikely happen, just set the handle to NULL.
    // As for output pipes, create and redirect them always to avoid bugs.
    // STDIN
    if pStdIn in ExecProps.RedirectPipes then
    begin
      if not CreatePipe(hStdIn, Handles[ehStdIn], @sa, PipeBufSize) then
        raise LastOSErr('CreatePipe');
      // Ensure the write handle to the pipe for STDIN is not inherited (from MSDN example)
      SetHandleInformation(Handles[ehStdIn], HANDLE_FLAG_INHERIT, 0);
    end;
    // STDOUT
    // if pStdOut in ExecProps.RedirectPipes then
    begin
      if not CreatePipe(Handles[ehStdOut], hStdOut, @sa, PipeBufSize) then
        raise LastOSErr('CreatePipe');
      // Ensure the read handle to the pipe for STDOUT is not inherited (from MSDN example)
      SetHandleInformation(Handles[ehStdOut], HANDLE_FLAG_INHERIT, 0);
    end;
    // STDERR
    // if pStdErr in ExecProps.RedirectPipes then
    begin
      if not CreatePipe(Handles[ehStdErr], hStdErr, @sa, PipeBufSize) then
        raise LastOSErr('CreatePipe');
      // Ensure the read handle to the pipe for STDERR is not inherited (from MSDN example)
      SetHandleInformation(Handles[ehStdErr], HANDLE_FLAG_INHERIT, 0);
    end;
    si.cb           := SizeOf(si);
    si.dwFlags      := STARTF_USESHOWWINDOW;
    if ExecProps.RedirectPipes <> [] then
      si.dwFlags    := si.dwFlags or STARTF_USESTDHANDLES;
    si.wShowWindow  := SW_HIDE;
    si.hStdInput  := hStdIn;
    si.hStdOutput := hStdOut;
    si.hStdError  := hStdErr;
    if ExecProps.CurrDir = '' then IntCurrDir := GetCurrentDir else IntCurrDir := ExecProps.CurrDir;

    // Construct a new env from an old one with addition of that given in parameters and
    // error signature.
    Env := StrArrToEnv(ExecProps.EnvVars) +
           GetEnv + #0;

    IntCmdLine := ExecProps.CmdLine; // command line MUST be modifyable - CreateProcessW requirement
    UniqueString(IntCmdLine);
    if not CreateProcess(nil, PChar(IntCmdLine), @sa, nil, True,
                         {} // show window
                         CREATE_NEW_CONSOLE{$IFDEF UNICODE} or CREATE_UNICODE_ENVIRONMENT{$ENDIF},
                         PChar(Env), PChar(IntCurrDir), si, pi) then
      raise LastOSErr('CreateProcess', GetLastError, '"'+IntCmdLine+'"');
    Handles[ehProcess] := pi.hProcess;

    // Set priority if not default
    if ExecProps.Priority <> NORMAL_PRIORITY_CLASS then
      SetPriorityClass(Handles[ehProcess], ExecProps.Priority);
  except
    CloseHandles(Handles);
    raise;
  end;
  finally
    // Free thread handles and unneeded pipe ends
    CloseAndZeroHandle(hStdIn);
    CloseAndZeroHandle(hStdOut);
    CloseAndZeroHandle(hStdErr);
    CloseAndZeroHandle(pi.hThread);
  end;
end;

 

[David Schwartz 430]

On 9/15/2020 at 1:36 AM, Fr0sT.Brutal said:

1-sec googling: https://wiki.delphi-jedi.org/wiki/JVCL_Help:TJvCreateProcess that claims to have CDir setting.

Thanks. I looked at the code, and the name CDir did not stand out to me as what I was looking for.