////////////////////////////////////////////////////////////////////////////////
// Copyright (c) 2001-2026 Alexey Kuryakin daqgroup@mail.ru under MIT license //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// This file is part of the CRW-DAQ project by DaqGroup - component CRWLIB.   //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// Purpose:                                                                   //
// Windows related routines for process manipulations.                        //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 20260311 - Created by A.K.                                                 //
////////////////////////////////////////////////////////////////////////////////

unit _crw_procws; //  Processes in Windows - helper unit.

{$I _crw_sysdef.inc}

{$I _crw_sysmode.inc}

interface

uses
 //////////////////////////////////////////////////////
 {$I _crw_uses_first.inc} // NB: MUST BE FIRST USES !!!
 //////////////////////////////////////////////////////
 {$IFDEF WINDOWS} JwaWinUser, JwaTlHelp32, JwaPsApi, JwaWinBase, {$ENDIF}
 sysutils, classes, math, lcltype, ctypes, lazfileutils,
 _crw_alloc, _crw_ef, _crw_str, _crw_procps;

 // Get process (by handle hProc) image file name.
 // Image file name got in kernel form (\Device\…\file.exe).
function winapi_GetProcessImageFileName(hProc:THandle):LongString;

 // Get process (by handle hProc) full exe file name.
function winapi_GetProcessExeFileName(hProc:THandle):LongString;

// Get process (by handle hProc) task name (filename without path).
function winapi_GetProcessTaskName(hProc:THandle):LongString;

 // Check if GetProcessTaskName is available.
 // GetProcessTaskName is not avail on old systems.
function winapi_CanGetProcessTaskName:Boolean;

 // Check if winapi_fast_pidstate can be used for (pid,ppid,comm)
function winapi_can_use_fast_pidstate(pid,ppid:TPid; const comm:LongString):Boolean;

 // Fast (optimized) version of PidState for WinApi.
 // Only can be used if winapi_can_fast_pidstate return True.
function winapi_fast_pidstate(pid:TPid; const comm:LongString):Char;

 ////////////////////////////////////////////////////
 // https://ru.stackoverflow.com/questions/40576
 // https://stackoverflow.com/questions/15597066
 // Get main ThreadID of process with PID (dwProcID).
 // Main thread is detected by minimal creation time.
 ////////////////////////////////////////////////////
function winapi_find_main_thread_by_pid(dwProcID:DWORD):DWORD;

 // Detect the window (Wnd) is main window.
 // https://stackoverflow.com/questions/1888863
function winapi_is_main_window(Wnd:HWND; Mode:Integer=0):Boolean;

 // Find main window handle by process ID (Pid).
 // https://stackoverflow.com/questions/1888863
function winapi_find_main_window_by_pid(Pid:TPid; Tid:DWORD=0):HWND;

 // Post message (Msg,W,L) to process (PID) main thread.
function winapi_PostMessageToProcessMainThread(Pid:TPid; Msg:UINT; W:WPARAM; L:LPARAM):Boolean;

 // Post message (Msg,W,L) to process (PID) main window.
function winapi_PostMessageToProcessMainWindow(Pid:TPid; Msg:UINT; W:WPARAM; L:LPARAM):Boolean;

 // Initialize procws.
procedure Init_UnitProcWs;

implementation

function winapi_GetProcessImageFileName(hProc:THandle):LongString;
{$IFDEF WINDOWS} var buf:TMaxPathBuffer; exe:LongString; {$ENDIF}
begin
 Result:='';
 {$IFDEF WINDOWS}
 if (hProc=0) then Exit;
 buf:=Default(TMaxPathBuffer);
 exe:=StringBuffer(@buf,GetProcessImageFileName(hProc,buf,SizeOf(buf)));
 exe:=Trim(exe);
 Result:=exe;
 {$ENDIF}
end;

function winapi_GetProcessExeFileName(hProc:THandle):LongString;
{$IFDEF WINDOWS} var buf:TMaxPathBuffer; exe:LongString; {$ENDIF}
begin
 Result:='';
 {$IFDEF WINDOWS}
 if (hProc=0) then Exit;
 buf:=Default(TMaxPathBuffer);
 exe:=StringBuffer(@buf,GetModuleFileNameEx(hProc,0,buf,SizeOf(buf)));
 exe:=Trim(exe);
 Result:=exe;
 {$ENDIF}
end;

function winapi_GetProcessTaskName(hProc:THandle):LongString;
{$IFDEF WINDOWS} var exe:LongString; {$ENDIF}
begin
 Result:='';
 {$IFDEF WINDOWS}
 if (hProc=0) then Exit;
 exe:=winapi_GetProcessImageFileName(hProc);
 if (exe='') then exe:=winapi_GetProcessExeFileName(hProc);
 exe:=Trim(ExtractFileNameExt(Trim(exe)));
 Result:=exe;
 {$ENDIF}
end;

function winapi_CanGetProcessTaskName:Boolean;
{$IFDEF WINDOWS} var Task,Prog:LongString; const iCond:Integer=0; {$ENDIF}
begin
 Result:=False;
 {$IFDEF WINDOWS}
 if (iCond=0) then begin
  Task:=winapi_GetProcessTaskName(GetCurrentProcess);
  Prog:=Trim(ExtractFileNameExt(Trim(ParamStr(0))));
  if SameText(Task,Prog)
  then iCond:=+1
  else iCond:=-1;
 end;
 Result:=(iCond>0);
 {$ENDIF}
end;

function winapi_can_use_fast_pidstate(pid,ppid:TPid; const comm:LongString):Boolean;
begin
 Result:=False;
 {$IFDEF WINDOWS}
 if IsWindows and (pid<>0) and (ppid=0)
 then Result:=((comm='') or winapi_CanGetProcessTaskName)
 else Result:=False;
 {$ENDIF}
end;

function winapi_fast_pidstate(pid:TPid; const comm:LongString):Char;
{$IFDEF WINDOWS} var hProc:THandle; exe:LongString; {$ENDIF}
begin
 Result:=pps_Invalid;
 {$IFDEF WINDOWS}
 if (pid=0) then Exit;
 hProc:=OpenProcess(PROCESS_QUERY_INFORMATION or SYNCHRONIZE,False,pid);
 if (hProc<>0) then
 try
  if (comm<>'') then begin
   exe:=winapi_GetProcessTaskName(hProc);
   if not IsSameText(exe,comm) then Exit;
  end;
  if (WaitForSingleObject(hProc,0)=WAIT_TIMEOUT)
  then Result:=pps_Running
  else Result:=pps_Dead;
 finally
  CloseHandle(hProc);
 end;
 {$ENDIF}
end;

function winapi_find_main_thread_by_pid(dwProcID:DWORD):DWORD;
{$IFDEF WINDOWS}
var dwMainThreadID:DWORD; ullMinCreateTime,ullTest:QWORD;
var hThreadSnap,hThread:THandle; th32:THREADENTRY32;
var afTimes:array[0..3] of TFILETIME;
{$ENDIF}
begin
 Result:=0;
 {$IFDEF WINDOWS}
 if (dwProcID=0) then Exit;
 dwMainThreadID:=0; ullMinCreateTime:=High(QWORD);
 if (dwProcID=Windows.GetCurrentProcessId) then Exit(MainThreadId);
 hThreadSnap:=CreateToolhelp32Snapshot(TH32CS_SNAPTHREAD,0);
 if (hThreadSnap<>INVALID_HANDLE_VALUE) then
 try
  th32:=Default(THREADENTRY32);
  th32.dwSize:=SizeOf(THREADENTRY32);
  if Thread32First(hThreadSnap,th32) then
  repeat
   if (th32.th32OwnerProcessID=dwProcID) then begin
    hThread:=OpenThread(THREAD_QUERY_INFORMATION,True,th32.th32ThreadID);
    if (hThread<>0) then
    try
     SafeFillChar(afTimes,SizeOf(afTimes),0);
     if GetThreadTimes(hThread,afTimes[0],afTimes[1],afTimes[2],afTimes[3]) then begin
      ullTest:=QWORD(afTimes[0]);
      if (ullTest<>0) and (ullTest<ullMinCreateTime) then begin
       dwMainThreadID:=th32.th32ThreadID; // let it be main :)
       ullMinCreateTime:=ullTest;
      end;
     end;
    finally
     CloseHandle(hThread);
    end;
   end;
  until not Thread32Next(hThreadSnap,th32);
  if (dwMainThreadID<>0) then Result:=dwMainThreadID;
 finally
  CloseHandle(hThreadSnap);
 end;
 {$ENDIF}
end;

function winapi_is_main_window(Wnd:HWND; Mode:Integer=0):Boolean;
begin
 Result:=False;
 {$IFDEF WINDOWS}
 if (Wnd=0) then Exit;
 if not IsWindow(Wnd) then Exit;
 if (GetWindow(Wnd,GW_OWNER)<>0) then Exit;
 if HasFlags(Mode,1) and not IsWindowVisible(Wnd) then Exit;
 Result:=True;
 {$ENDIF}
end;

{$IFDEF WINDOWS}
type
 PFmwbpRec=^TFmwbpRec;
 TFmwbpRec=record Pid,Tid:DWORD; Wnd:HWND; end;

function EnumFmwbpProc(Wnd:HWND; Param:LPARAM):BOOL; stdcall;
var R:PFmwbpRec absolute Param; Pid,Tid:DWORD;
begin
 Result:=True;
 if Assigned(R) then
 try
  Pid:=0;
  Tid:=GetWindowThreadProcessId(Wnd,@Pid);
  if (Tid<>0) and ((R.Tid=0) or (R.Tid=Tid)) then
  if (Pid=R.Pid) and winapi_is_main_window(Wnd) then begin
   Result:=False;
   R.Wnd:=Wnd;
  end;
 except
  on E:Exception do BugReport(E,nil,'EnumFmwbpProc');
 end;
end;
{$ENDIF}

function winapi_find_main_window_by_pid(Pid:TPid; Tid:DWORD=0):HWND;
{$IFDEF WINDOWS} var R:TFmwbpRec; {$ENDIF}
begin
 Result:=0;
 {$IFDEF WINDOWS}
 R.Pid:=Pid; R.Tid:=Tid; R.Wnd:=0;
 EnumWindows(EnumFmwbpProc,LPARAM(PointerToPtrInt(@R)));
 Result:=R.Wnd;
 {$ENDIF}
end;

function winapi_PostMessageToProcessMainThread(Pid:TPid; Msg:UINT; W:WPARAM; L:LPARAM):Boolean;
{$IFDEF WINDOWS} var Tid:DWORD; {$ENDIF}
begin
 Result:=False;
 {$IFDEF WINDOWS}
 if (Pid=0) then Exit;
 Tid:=winapi_find_main_thread_by_pid(Pid);
 if (Tid<>0) then Result:=PostThreadMessage(Tid,Msg,W,L);
 {$ENDIF}
end;

function winapi_PostMessageToProcessMainWindow(Pid:TPid; Msg:UINT; W:WPARAM; L:LPARAM):Boolean;
{$IFDEF WINDOWS} var Tid:DWORD; Wnd:HWND; {$ENDIF}
begin
 Result:=False;
 {$IFDEF WINDOWS}
 if (Pid=0) then Exit;
 Tid:=winapi_find_main_thread_by_pid(Pid);
 Wnd:=winapi_find_main_window_by_pid(Pid,Tid);
 if (Wnd<>0) then Result:=PostMessage(Wnd,Msg,W,L);
 {$ENDIF}
end;

procedure Init_UnitProcWs;
begin
 if IsWindows then winapi_CanGetProcessTaskName;
end;

///////////////////////////////////////
// Unit initialization and finalization
///////////////////////////////////////

procedure Init_crw_procws;
begin
end;

procedure Free_crw_procws;
begin
end;

initialization

 Init_crw_procws;

finalization

 Free_crw_procws;

end.

//////////////
// END OF FILE
//////////////

