AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Programmieren allgemein Delphi ShellExecute mit Leerzeichen
Thema durchsuchen
Ansicht
Themen-Optionen

ShellExecute mit Leerzeichen

Ein Thema von H.Bothur · begonnen am 10. Okt 2023 · letzter Beitrag vom 16. Okt 2023
 
DieDolly

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

AW: ShellExecute mit Leerzeichen

  Alt 11. Okt 2023, 16: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
 


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 12:50 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz