Einzelnen Beitrag anzeigen

DieDolly

Registriert seit: 22. Jun 2018
2.175 Beiträge
 
#21

AW: ShellExecute mit Leerzeichen

  Alt 11. Okt 2023, 17:14
Ich habe für sowas über die Jahre eine Unit zusammengebastelt. Da ist alles drin was ich brauche

Delphi-Quellcode:
Aufruf
TShellExecEx.ShellExecEx(Application.Handle, 'open', PChar(Datei), nil, nil, SW_NORMAL);
Delphi-Quellcode:
unit ShellExecEx;

interface

uses
 Winapi.Windows, Winapi.ShellAPI, Winapi.ShlObj, Winapi.TlHelp32, Vcl.Forms, System.SysUtils;

type
 TShellExecEx = record
 private
  class procedure seDelay(Milliseconds: Integer); static;
  class function FileExists(const aFileName: string): Boolean; static;
  class function IsDirectory(const aFileName: string): Boolean; static;
 public
  class function OpenFolderAndSelectFile(const FileName: string): Boolean; static;
  class function ShellExecEx(lphWnd: HWND; lpVerb, lpFile, lpParameters, lpDirectory: PChar; nShowCommand: Integer; bWaitForCompletion: Boolean = False;
   bProcessMessages: Boolean = False; bUseExeIsRunningCheck: Boolean = False): Boolean; static;
 end;

implementation

class procedure TShellExecEx.seDelay(Milliseconds: Integer);
const
 WM_QUIT = 18;
var
 Tick: DWord;
 Event: THandle;
 Msg: TMsg;
begin
 Event := CreateEvent(nil, False, False, nil);

 try
  Tick := GetTickCount + DWord(Milliseconds);

  while (Milliseconds > 0) and (MsgWaitForMultipleObjects(1, Event, False, Milliseconds, QS_ALLINPUT) <> WAIT_TIMEOUT) do
   begin
    if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then
     begin
      if Msg.message = WM_QUIT then
       begin
        PostQuitMessage(Msg.wParam);
        Break;
       end;

      TranslateMessage(Msg);
      DispatchMessage(Msg);
     end;

    Milliseconds := Tick - GetTickCount;
   end;
 finally
  CloseHandle(Event);
 end;
end;

class function TShellExecEx.FileExists(const aFileName: string): Boolean;
var
 i: Cardinal;
begin
 Result := False;
 i := GetFileAttributes(PChar(aFileName));
 if i <> INVALID_FILE_ATTRIBUTES then
  begin
   Result := True;
  end;
end;

class function TShellExecEx.IsDirectory(const aFileName: string): Boolean;
var
 R: DWord;
begin
 R := GetFileAttributes(PChar(aFileName));
 Result := (R <> DWord(-1)) and ((R and FILE_ATTRIBUTE_DIRECTORY) <> 0);
end;

class function TShellExecEx.OpenFolderAndSelectFile(const FileName: string): Boolean;
var
 IIDL: PItemIDList;
begin
 Result := False;
 IIDL := ILCreateFromPath(PChar(FileName));
 if IIDL <> nil then
  try
   Result := SHOpenFolderAndSelectItems(IIDL, 0, nil, 0) = S_OK;
  finally
   ILFree(IIDL);
  end;
end;

function IsExeRunning(const AExeName: string): Boolean;
var
 h: THandle;
 p: TProcessEntry32;
 bRes: Boolean;
begin
 p.dwSize := SizeOf(p);
 h := CreateToolHelp32Snapshot(TH32CS_SnapProcess, 0);

 try
  Process32First(h, p);

  repeat
   bRes := AnsiUpperCase(AExeName) = AnsiUpperCase(p.szExeFile);
  until bRes or (not Process32Next(h, p));
 finally
  CloseHandle(h);
 end;

 Result := bRes;
end;

class function TShellExecEx.ShellExecEx(lphWnd: HWND; lpVerb, lpFile, lpParameters, lpDirectory: PChar; nShowCommand: Integer; bWaitForCompletion: Boolean = False;
 bProcessMessages: Boolean = False; bUseExeIsRunningCheck: Boolean = False): Boolean;
var
 ShExecInfoW: ShellExecuteInfoW;
 lpExitCode: Cardinal;
 bIsHTTP, bIsCMD, bResShellExecEx: Boolean;
begin
 bIsHTTP := string(lpFile).StartsWith('http://') or string(lpFile).StartsWith('https://');
 if bIsHTTP then
  begin
   Result := ShellExecute(0, 'open', PChar(lpFile), nil, nil, SW_SHOWNORMAL) >= 32;
   Exit
  end;

 bIsCMD := AnsiSameText(lpFile, 'cmd') or AnsiSameText(lpFile, 'cmd.exe');
 if (not bIsCMD) and (not bIsHTTP) and (not TShellExecEx.IsDirectory(lpFile)) and (not TShellExecEx.FileExists(lpFile)) then
  begin
   Result := False;
   Exit;
  end;

 if bIsCMD and (not string(lpParameters).StartsWith('/C ')) then
  lpParameters := PChar('/C ' + lpParameters);

 ZeroMemory(@ShExecInfoW, SizeOf(ShExecInfoW));
 ShExecInfoW.Wnd := lphWnd;
 ShExecInfoW.cbSize := SizeOf(ShellExecuteInfoW);
 ShExecInfoW.fMask := SEE_MASK_NOCLOSEPROCESS;
 ShExecInfoW.lpVerb := lpVerb;
 ShExecInfoW.lpFile := PChar('"' + lpFile + '"');
 ShExecInfoW.lpParameters := lpParameters;
 ShExecInfoW.lpDirectory := lpDirectory;
 ShExecInfoW.nShow := nShowCommand;
 bResShellExecEx := ShellExecuteExW(@ShExecInfoW);
 Result := bResShellExecEx;

 try
  if (bResShellExecEx) and (bWaitForCompletion) then
   begin
    if not bUseExeIsRunningCheck then
     begin
      WaitForInputIdle(ShExecInfoW.hProcess, INFINITE);

      repeat
       TShellExecEx.seDelay(25);
       GetExitCodeProcess(ShExecInfoW.hProcess, lpExitCode);

       if bProcessMessages then
        Application.ProcessMessages;
      until (lpExitCode <> STILL_ACTIVE);
     end
    else
     begin
      while IsExeRunning(ExtractFileName(lpFile)) do
       begin
        TShellExecEx.seDelay(25);

        if bProcessMessages then
         Application.ProcessMessages;
       end;
     end;
   end;
 finally
  CloseHandle(ShExecInfoW.hProcess)
 end;
end;

end.
  Mit Zitat antworten Zitat