ShellExecute() >> WindowHandle

[taaktaak]

So, ich denke, ich habe es jetzt hinbekommen - die ersten Tests funktionieren zufriedenstellend. Zum besseren Verständnis zunächst die Aufgabenstellung etwas konkreter als bisher beschrieben:

In einem RichEdit sind Links auf beliebige Dateien placiert (Bilder, Texte o.ä.). Ein Klick auf die Links soll die Dateien mit dem verknüpften Programm anzeigen lassen. Damit kann man sich natürlich, ausreichend oft geklickt, auch große Bildschirme schnell "zumüllen" - aus diesem Grund soll optional der mehrfache Aufruf verhindert werden und stattdessen das bereits gestartete Programmfenster wieder in den Vordergrund geholt werden.

Beispielhaft habe ich das jetzt so gelöst:

Delphi-Quellcode:

uses ShellAPI;

type PEnumInfo    = ^TEnumInfo;
     TEnumInfo    = record
                      ProcessID : DWORD;
                      HWND      : THandle;
                      end;

     tCalledLinks = record
                      LinkText  : String;
                      WinHandle : DWord;
                      end;

var  CalledLinks  : tCalledLinks; // use array later on

procedure AddProcess(LnkText:String;WinHandle:HWnd);
begin
  CalledLinks.LinkText :=LnkText;
  CalledLinks.WinHandle:=WinHandle;
  (*
  add record to array
  *)
end;

function CanSetToForeGround(LnkText:String):Boolean;
begin
  Result:=SetForeGroundWindow(CalledLinks.WinHandle);
  (*
  if not(Result) then begin
   // remove record from array
   end
  *)
end;

function GetAssociatedApp(FName:String):String;
begin
  SetLength(Result,MAX_PATH);
  if FindExecutable(PChar(FName),
                    nil,
                    PChar(Result))>32 then SetLength(Result,StrLen(PChar(Result)))
                                      else Result:=''
end;

function RunProcess(FName:String;ShowCmd:DWORD;Wait:Boolean;var ProcID:DWord):LongWord;
var StartupInfo : TStartupInfo;
    ProcessInfo : TProcessInformation;
begin
  FillChar(StartupInfo,SizeOf(StartupInfo),#0);
  StartupInfo.cb         :=SizeOf(StartupInfo);
  StartupInfo.dwFlags    :=STARTF_USESHOWWINDOW or STARTF_FORCEONFEEDBACK;
  StartupInfo.wShowWindow:=ShowCmd;
  if not(CreateProcess(nil,
                       @FName[1],
                       nil,
                       nil,
                       False,
                       CREATE_NEW_CONSOLE or
                       NORMAL_PRIORITY_CLASS,
                       nil,
                       nil,
                       StartupInfo,
                       ProcessInfo)) then Result:=WAIT_FAILED
                                     else begin
    if not(Wait) then begin
      WaitForInputIdle(ProcessInfo.hProcess,INFINITE);
      ProcID:=ProcessInfo.dwProcessId;
      exit
      end;
 
    WaitForSingleObject(ProcessInfo.hProcess,INFINITE);
    GetExitCodeProcess (ProcessInfo.hProcess,Result)
    end;

  if ProcessInfo.hProcess<>0 then CloseHandle(ProcessInfo.hProcess);
  if ProcessInfo.hThread <>0 then CloseHandle(ProcessInfo.hThread)
end;

function EnumWindowsProc(Wnd:DWORD;var EI:TEnumInfo):Boolean; stdcall;
var PID : DWORD;
begin
  GetWindowThreadProcessID(Wnd,@PID);
  Result:=(PID<>EI.ProcessID) or (not IsWindowVisible(WND)) or (not IsWindowEnabled(WND));
  if not(Result) then EI.HWND:=WND
end;

function FindAppWindow(PID:DWORD):DWORD;
var EI : TEnumInfo;
begin
  EI.ProcessID:=PID;
  EI.HWND     :=0;
  EnumWindows(@EnumWindowsProc,Integer(@EI));
  Result:=EI.HWND
end;

procedure CallLink(DataFile:String;AdmitMultipleCalls:Boolean);
var AppName,
    ProcessPara : String;
    ProcID      : Cardinal;
begin
  AppName    :=GetAssociatedApp(DataFile);
  ProcessPara:=AppName+' '+DataFile;

  if AdmitMultipleCalls or
     not(CanSetToForeGround(DataFile)) then
 
  if RunProcess(ProcessPara,
                SW_SHOWNORMAL,
                false,
                ProcID)=WAIT_FAILED then ShowMessage('Create process error')
                                    else

    if not(AdmitMultipleCalls) then AddProcess(DataFile,FindAppWindow(ProcID))

end;

procedure TfoTest15.buShowLinkClick(Sender:TObject);
begin
  CallLink('d:\data_p\delphi\delphiguide\bitmaps\Edit_0000_Save.bmp',
           cbAdmitMultipleCalls.Checked)
end;