ShellExecute mit Leerzeichen

[DieDolly]

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.

[himitsu]

Zitat:

Delphi-Quellcode:

      while IsExeRunning(ExtractFileName(lpFile)) do
       begin
        TShellExecEx.seDelay(25);

        if bProcessMessages then
         Application.ProcessMessages;
       end;
     end;

bProcessMessages ?

Dein seDelay macht das doch bereits, nur dass dort viele Sachen falsch/garnicht behandelt werden.
z.B. HotKeys und Menü-Ereignisse sind falsch oder gehen verloren.

Da kannst'e genauso gut im seDelay direkt das Application.ProcessMessages oder Application.HandleMessage; benutzen.

Dieser Parameter ist so oder so sinnlos, da immer Messages behandelt werden.

Zitat:

Tick := GetTickCount + DWord(Milliseconds);

In neuen Delphi-Projekten ist jetzt die Index- und Bereichsprüfung standardmäßig aktiv.
Nach 49,7 Tagen gibt es einen Überlauf und wenn du Diesen gut triffst, dann knallt es.

PS: TFile.Exists und TDirectory.Exists

[DieDolly]

Zitat:

Dein seDelay macht das doch bereits, nur dass dort viele Sachen falsch/garnicht behandelt werden.
z.B. HotKeys und Menü-Ereignisse sind falsch oder gehen verloren.

Ich weiß nicht mehr von wem der Code ist.

Zitat:

In neuen Delphi-Projekten ist jetzt die Index- und Bereichsprüfung standardmäßig aktiv.
Nach 49,7 Tagen gibt es einen Überlauf und wenn du Diesen gut triffst, dann knallt es.

Alternative? Der Code ist schon sehr alt.

Zitat:

PS: Delphi-Referenz durchsuchenTFile.Exists und Delphi-Referenz durchsuchenTDirectory.Exists

Ich nutze lieber meine eigene Implementierung. Die bleibt immer gleich und ist nur für Windows.

Würde mich über ein aktuelleres/besseres Delay freuen.

[himitsu]

Ja, die Delay-Funktion ist von ihm und sie soll ja auch Messages verarbeiten, entgegen einem Sleep oder stumpfen WaitFor.

Delay, zusammen mit noch einem Application.ProcessMessages, ist so aber ganz bestimmt so nicht von ihm


Das seDelay ohne PeekMessage und Co. (bei Ereignis die Funktion abbrechen),
dann würde deine Funktion das machen, was das Parameter bProcessMessages verspricht.
Oder einfach ein Sleep anstatt seDelay (das ist so kurz, dass des auf Message warten nahezu keine bemerkbare Wirkung hat).

[DieDolly]

Ich verstehe.
Entweder Sleep und ProcessMessages oder nur das seDelay. TranslateMessage und DispatchMessage in seDelay entspricht quasi dem Abarbeiten der MessageQueue?

[H.Bothur]

Moin,

kurze Rückmeldung: Der größte Idiot sitzt doch immer vor dem Monitor

Der richtige Aufruf war

ShellExError := ShellExecute(Application.Handle,Nil,PChar('VLC.exe'),PChar('"' +FileName +'"'),Nil,SW_SHOW);
Das viel größere Problem war aber das ich beim Filename eine Verzeichnisebene vergessen habe

Oh Mann Trotzdem vielen, vielen Dank für die ganze Hilfe !!

Hans

[Rolf Frei]

Zitat von H.Bothur:

Moin,

kurze Rückmeldung: Der größte Idiot sitzt doch immer vor dem Monitor

Der richtige Aufruf war

ShellExError := ShellExecute(Application.Handle,Nil,PChar('VLC.exe'),PChar('"' +FileName +'"'),Nil,SW_SHOW);
Das viel größere Problem war aber das ich beim Filename eine Verzeichnisebene vergessen habe

Oh Mann Trotzdem vielen, vielen Dank für die ganze Hilfe !!

Hans

Wie ich geschrieben habe läuft auch dein Orginalcode aus Post 1, wenn du da keine " drum herum machst (Siehe mein Beispiel von Ende Seite 2). Mit diesem Aufruf, wird der Default Player für mp4 Dateien gestartet und das Video abgespielt. Mit deiner Lösung von heute, muss der VLC installiert sein, was meiner Meinung nach nicht zwingend sein sollte.