{*******************************************************} { } { Tocsg.Process } { } { Copyright (C) 2022 kkuzil } { } {*******************************************************} unit Tocsg.Process; interface uses Winapi.Windows, System.SysUtils, Tocsg.Obj, Tocsg.Files, System.Classes, Winapi.TlHelp32, superobject, Tocsg.Thread, System.Generics.Collections, Tocsg.FileInfo; const PROC_FULL_ACCESS = PROCESS_ALL_ACCESS or SYNCHRONIZE; PROC_SAFE_ACCESS = PROCESS_QUERY_INFORMATION or PROCESS_VM_READ or SYNCHRONIZE or PROCESS_VM_WRITE; type TProcessIdList = TList; TTgProcessInfo = class(TTgObject) protected dwPID_: DWORD; sProcPath_, sProcName_: String; dtCreate_: TDateTime; FileInfo_: TTgFileInfo; public Constructor Create(dwPid: DWORD); Destructor Destroy; override; property PID: DWORD read dwPID_; property ModulePath: String read sProcPath_; property ModuleName: String read sProcName_; property FileInfo: TTgFileInfo read FileInfo_; property CreateDT: TDateTime read dtCreate_; end; TExeArchitectKind = (eakNoExe, eak32, eak64); PProcessEntInfo = ^TProcessEntInfo; TProcessEntInfo = record sOwner, sCompany, sVersion, sCopyright, sDescription, sModuleBaseName, sModuleFileName : String; nPriority: Integer; dtStart, dtExit, dtKernelMode, dtUserMode: TDateTime; dwPid, dwPPid: DWORD; end; TProcessEntList = class(TList) private bDetailInfo_: Boolean; DcProcInfo_: TDictionary; protected procedure AddProcess(aProcEnt: TProcessEntry32); procedure Notify(const Item: PProcessEntInfo; Action: TCollectionNotification); override; public Constructor Create(bUpdate: Boolean = false); Destructor Destroy; override; procedure UpdateProcessList; procedure DeleteProcInfoByPid(dwPid: DWORD); function GetProcInfoByPath(sPath: String): PProcessEntInfo; function GetProcInfoByPid(dwPid: DWORD): PProcessEntInfo; function GetProcInfoByName(sPName: String): PProcessEntInfo; function GetProcPathByName(sPName: String): String; function GetProcPathByPid(dwPid: DWORD): String; function ToJsonObj: ISuperObject; function ToJsonObjHE: ISuperObject; property DetailInfo: Boolean write bDetailInfo_; end; TProcessString = reference to procedure(sText: String; var bWorkStop: Boolean); PPwEnt = ^TPwEnt; TPwEnt = record dwPid, dwPPid: DWORD; sPName: String; end; TPwEntDic = TDictionary; TThdProcessWatch = class; TProcessWatchKind = (pwkUnknown, pwkInit, pwkExecute, pwkTerminated); TEvProcessWatchNotify = procedure(aSender: TThdProcessWatch; pEnt: PPwEnt; aKind: TProcessWatchKind) of object; TThdProcessWatch = class(TTgThread) protected bSync_, bCoInit_: Boolean; RctEnt_: PPwEnt; RctKind_: TProcessWatchKind; evWatchNotify_: TEvProcessWatchNotify; procedure OnPwEntNotify(Sender: TObject; const Item: PPwEnt; Action: TCollectionNotification); procedure ProcessNotify; procedure Execute; override; public Constructor Create(bSync: Boolean = true; bCoInit: Boolean = false); property OnProcessWatchNotify: TEvProcessWatchNotify write evWatchNotify_; end; function PriorityStrByClass(nClass: Integer): String; function TerminateProcessByPid(dwPid: DWORD; bForce: Boolean = false): Boolean; function TerminateProcessByName(sPName: String; dwIgrPid: DWORD = 0): Boolean; procedure TerminateProcessFromList(aList: TStringList; aIgrList: TStringList = nil); function CheckProcessNameDeadOrTerminate(sPName: String): Boolean; function GetProcessOwner(hProcess: THandle): String; function GetProcessNameToList(aList: TStringList): Integer; function GetProcessPidByName(sModuleName: String; dwIgnPid: DWORD = 0): DWORD; function GetProcessPidsByName(sModuleName: String; aPIDList: TProcessIdList = nil): Integer; function GetProcessNameByPid(dwPid: DWORD): String; function GetProcessPPidByPid(dwPid: DWORD): DWORD; function GetProcessPathByPid(dwPid: DWORD): String; function GetProcessPIDFromWndHandle(hWndHandle: THandle): DWORD; function GetProcessNameFromWndHandle(hWndHandle: THandle): String; function GetProcessPathFromWndHandle(hWndHandle: THandle): String; function GetWndHandleFromPID(dwPid: DWORD; sIfWndCaption: String = ''): HWND; function GetWndHandleFromPidEx(dwPid: DWORD; sClassName: String): HWND; function GetWndHandlesFromPID(dwPid: DWORD; HandleList: TStrings): Integer; function GetProcesssUserSidFromPID(dwPid: DWORD): String; function GetProcesssUserSidFromName(sPName: String): String; function GetExeFileArchitectFromeStream(aStream: TStream): TExeArchitectKind; function GetExeFileArchitectFromePath(sPath: String): TExeArchitectKind; procedure ReadPipeFromCmd(sCommand, sParam: String; nShow: Integer; ProcessString: TProcessString; dwExitTimeout: DWORD = 0); function GetCmdTextToStream(sCommand, sParam: String; aStream: TStream; dwTimeMilSec: DWORD = 0): Boolean; function ExecuteApp(const sPath, sParam: String; wVisible: WORD; dwFlag: DWORD = STARTF_USESHOWWINDOW or STARTF_USEPOSITION; nX: Integer = 0; nY: Integer = 0): TProcessInformation; function ExecuteAppAsUser(dwFollowPID: DWORD; sPath, sParam: String; dwVisible: DWORD): TProcessInformation; overload; function ExecuteAppAsUser(sModuleName, sPath, sParam: String; dwVisible: DWORD): TProcessInformation; overload; function ExecuteAppWaitUntilTerminate(sPath, sParam: String; dwVisible: DWORD; nTimeOutMilSec: Integer = -1): Boolean; function InjectModule(dwPid: DWORD; sDllPath: String; pbIsWow64: PBoolean = nil): Integer; function EjectModuleFromPath(sDllPaths: String; dwIgrPid: DWORD = 0): Integer; function EjectModuleFromPath2(sDllPath: String; sIgrPNames: String): Integer; function EjectModuleFromPathUntilZero(sDllPath: String; dwIgrPid: DWORD = 0): Integer; function EjectModuleFromName(sName: String; dwIgrPid: DWORD = 0): Integer; function EjectModuleByPName(dwPid: DWORD; sDllName: String): Boolean; implementation uses Winapi.PsAPI, Tocsg.Kernel32, Tocsg.Exception, Tocsg.Trace, Tocsg.DateTime, Tocsg.Safe, Tocsg.WndUtil, Tocsg.Json, Tocsg.Strings, Tocsg.WinInfo, Winapi.ActiveX; type TOKEN_MANDATORY_LABEL = record Label_: SID_AND_ATTRIBUTES; end; PTOKEN_USER = ^TOKEN_USER; TOKEN_USER = record User: TSidAndAttributes; end; function CreateEnvironmentBlock(var lpEnvironment: Pointer; hToken: THandle; bInherit: BOOL): BOOL; stdcall; external 'userenv.dll'; { TTgProcessInfo } Constructor TTgProcessInfo.Create(dwPid: DWORD); procedure ExtractProcessInfo; var hProcess: THandle; ftCreate, ftExit, ftKernel, ftUser: TFileTime; nDosTime: Integer; dwLen: DWORD; sPath: array [0..512] of Char; begin hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, false, dwPID); if hProcess <> 0 then begin try if GetProcessTimes(hProcess, ftCreate, ftExit, ftKernel, ftUser) then begin if FileTimeToLocalFileTime(ftCreate, ftCreate) then if FileTimeToDosDateTime(ftCreate, LongRec(nDosTime).Hi, LongRec(nDosTime).Lo) then dtCreate_ := FileDateToDateTime(nDosTime); end; dwLen := 512; ZeroMemory(@sPath, SizeOf(sPath)); if GetModuleFileNameEx(hProcess, 0, sPath, dwLen) = 0 then begin CloseHandle(hProcess); hProcess := OpenProcess(PROCESS_QUERY_LIMITED_INFORMATION, false, dwPID); if hProcess <> 0 then QueryFullProcessImageName(hProcess, 0, sPath, dwLen); end; sProcPath_ := sPath; finally if hProcess <> 0 then CloseHandle(hProcess); end; end; if sProcPath_ = '' then sProcPath_ := GetProcessNameByPid(dwPID); sProcName_ := ExtractFileName(sProcPath_); end; begin Inherited Create; dwPid_ := dwPid; sProcPath_ := ''; sProcName_ := ''; FileInfo_ := nil; ExtractProcessInfo; if FileExists(sProcPath_) then FileInfo_ := TTgFileInfo.Create(sProcPath_); end; Destructor TTgProcessInfo.Destroy; begin if FileInfo_ <> nil then FreeAndNil(FileInfo_); Inherited; end; { TProcessEntList } Constructor TProcessEntList.Create(bUpdate: Boolean = false); begin DcProcInfo_ := TDictionary.Create; Inherited Create; bDetailInfo_ := true; if bUpdate then UpdateProcessList; end; Destructor TProcessEntList.Destroy; begin Inherited; FreeAndNil(DcProcInfo_); end; procedure TProcessEntList.Notify(const Item: PProcessEntInfo; Action: TCollectionNotification); begin case Action of cnAdded : if not DcProcInfo_.ContainsKey(Item.dwPid) then DcProcInfo_.Add(Item.dwPid, Item); cnRemoved : begin DcProcInfo_.Remove(Item.dwPid); Dispose(Item); end; end; end; procedure TProcessEntList.AddProcess(aProcEnt: TProcessEntry32); var h: THandle; pEnt: PProcessEntInfo; arrTemp: array [0..260] of Char; ftStart, ftExit, ftKernel, ftUser: TFileTime; FileInfo: TTgFileInfo; begin h := 0; try h := OpenProcess(PROC_FULL_ACCESS, false, aProcEnt.th32ProcessID); if h = 0 then begin h := OpenProcess(PROC_SAFE_ACCESS, false, aProcEnt.th32ProcessID); if h = 0 then exit; end; New(pEnt); ZeroMemory(pEnt, SizeOf(TProcessEntInfo)); pEnt.dwPid := aProcEnt.th32ProcessID; pEnt.dwPPid := aProcEnt.th32ParentProcessID; pEnt.sModuleBaseName := aProcEnt.szExeFile; if GetModuleFileNameEx(h, 0, arrTemp, 260) = 0 then pEnt.sModuleFileName := aProcEnt.szExeFile else pEnt.sModuleFileName := arrTemp; if bDetailInfo_ then begin if GetModuleBaseName(h, 0, arrTemp, 260) = 0 then pEnt.sModuleBaseName := aProcEnt.szExeFile else pEnt.sModuleBaseName := arrTemp; pEnt.nPriority := GetPriorityClass(h); if GetProcessTimes(h, ftStart, ftExit, ftKernel, ftUser) then begin pEnt.dtStart := ConvFileTimeToDateTime_Local(ftStart); pEnt.dtExit := ConvFileTimeToDateTime_Local(ftExit); pEnt.dtKernelMode := ConvFileTimeToDateTime_Local(ftKernel); pEnt.dtUserMode := ConvFileTimeToDateTime_Local(ftUser); end; pEnt.sOwner := GetProcessOwner(h); if FileExists(pEnt.sModuleFileName) then begin Guard(FileInfo, TTgFileInfo.Create(pEnt.sModuleFileName)); pEnt.sCompany := FileInfo.Company; pEnt.sVersion := FileInfo.Version; pEnt.sCopyright := FileInfo.LegalCopyright; pEnt.sDescription := FileInfo.Description; if pEnt.sDescription = '' then pEnt.sDescription := aProcEnt.szExeFile; end else pEnt.sDescription := aProcEnt.szExeFile; end; finally if h <> 0 then CloseHandle(h); end; Add(pEnt); end; procedure TProcessEntList.UpdateProcessList; var h: THandle; ProcEnt: TProcessEntry32; begin Clear; h := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); if h = INVALID_HANDLE_VALUE then exit; try ProcEnt.dwSize := SizeOf(ProcEnt); Process32First(h, ProcEnt); // system while Process32Next(h, ProcEnt) do begin AddProcess(ProcEnt); end; finally CloseHandle(h); end; end; procedure TProcessEntList.DeleteProcInfoByPid(dwPid: DWORD); var pEnt: PProcessEntInfo; i: Integer; begin pEnt := GetProcInfoByPid(dwPid); if pEnt <> nil then begin i := IndexOf(pEnt); if i <> -1 then Delete(i); end; end; function TProcessEntList.GetProcInfoByPath(sPath: String): PProcessEntInfo; var enum: TEnumerator; begin Result := nil; Guard(enum, DcProcInfo_.Values.GetEnumerator); while enum.MoveNext do if CompareText(sPath, enum.Current.sModuleFileName) = 0 then begin Result := enum.Current; exit; end; end; function TProcessEntList.GetProcInfoByPid(dwPid: DWORD): PProcessEntInfo; begin if DcProcInfo_.ContainsKey(dwPid) then Result := DcProcInfo_[dwPid] else Result := nil; end; function TProcessEntList.GetProcInfoByName(sPName: String): PProcessEntInfo; var enum: TEnumerator; begin Result := nil; Guard(enum, DcProcInfo_.Values.GetEnumerator); while enum.MoveNext do if CompareText(sPName, enum.Current.sModuleBaseName) = 0 then begin Result := enum.Current; exit; end; end; function TProcessEntList.GetProcPathByName(sPName: String): String; var pEnt: PProcessEntInfo; begin Result := ''; pEnt := GetProcInfoByName(sPName); if pEnt <> nil then begin case pEnt.dwPid of 0 : Result := 'System Idle'; // System Idle Process 고정 4 : Result := 'System'; // System Process 고정 else Result := pEnt.sModuleFileName; end; end; end; function TProcessEntList.GetProcPathByPid(dwPid: DWORD): String; var pInfo: PProcessEntInfo; begin try if DcProcInfo_.ContainsKey(dwPid) then begin pInfo := DcProcInfo_[dwPid]; if pInfo <> nil then Result := pInfo.sModuleFileName; end else Result := ''; except Result := ''; end; end; function TProcessEntList.ToJsonObj: ISuperObject; var i: Integer; begin Result := TSuperObject.Create(stArray); for i := 0 to Count - 1 do Result.AsArray.Add(TTgJson.ValueToJsonObject(Items[i]^)); end; function TProcessEntList.ToJsonObjHE: ISuperObject; var i: Integer; pEnt: PProcessEntInfo; O: ISuperObject; begin Result := TSuperObject.Create(stArray); for i := 0 to Count - 1 do begin pEnt := Items[i]; O := SO; with pEnt^ do begin O.S['Owner'] := sOwner; O.S['Company'] := sCompany; O.S['Version'] := sVersion; O.S['Copyright'] := sCopyright; O.S['Description'] := sDescription; if sModuleFileName <> '' then O.S['PPath'] := sModuleFileName else O.S['PPath'] := sModuleBaseName; O.I['StartDT'] := DelphiToJavaDateTime(dtStart); O.S['Time'] := ConvSecBetweenToProgTime(dtStart, Now); end; Result.AsArray.Add(O); end; end; { TThdProcessWatch } Constructor TThdProcessWatch.Create(bSync: Boolean = true; bCoInit: Boolean = false); begin Inherited Create; @evWatchNotify_ := nil; RctKind_ := pwkUnknown; bSync_ := bSync; bCoInit_ := bCoInit; end; procedure TThdProcessWatch.OnPwEntNotify(Sender: TObject; const Item: PPwEnt; Action: TCollectionNotification); begin if (Action = cnRemoved) and (Item <> nil) then Dispose(Item); end; procedure TThdProcessWatch.ProcessNotify; begin if Assigned(evWatchNotify_) then evWatchNotify_(Self, RctEnt_, RctKind_); end; procedure TThdProcessWatch.Execute; var DcPwEnts: TPwEntDic; hSnapProc: THandle; ProcEnt: TProcessEntry32; pEnt: PPwEnt; enum: TEnumerator; bInit: Boolean; NewPidList: TProcessIdList; begin Guard(DcPwEnts, TPwEntDic.Create); DcPwEnts.OnValueNotify := OnPwEntNotify; Guard(NewPidList, TProcessIdList.Create); if bCoInit_ then CoInitialize(nil); while not Terminated and not GetWorkStop do begin try bInit := DcPwEnts.Count = 0; hSnapProc := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); if hSnapProc = INVALID_HANDLE_VALUE then begin Sleep(3000); exit; end; try NewPidList.Clear; ProcEnt.dwSize := SizeOf(TProcessEntry32); Process32First(hSnapProc, ProcEnt); // first = "system" while Process32Next(hSnapProc, ProcEnt) do begin if not DcPwEnts.ContainsKey(ProcEnt.th32ProcessID) then begin New(pEnt); pEnt.dwPid := ProcEnt.th32ProcessID; pEnt.dwPPid := ProcEnt.th32ParentProcessID; pEnt.sPName := ProcEnt.szExeFile; DcPwEnts.Add(pEnt.dwPid, pEnt); RctEnt_ := pEnt; if bInit then RctKind_ := pwkInit else RctKind_ := pwkExecute; if bSync_ then Synchronize(ProcessNotify) else ProcessNotify; end; NewPidList.Add(ProcEnt.th32ProcessID); end; if NewPidList.Count > 0 then begin enum := DcPwEnts.Values.GetEnumerator; try while enum.MoveNext do if NewPidList.IndexOf(enum.Current.dwPid) = -1 then begin RctEnt_ := enum.Current; RctKind_ := pwkTerminated; if bSync_ then Synchronize(ProcessNotify) else ProcessNotify; DcPwEnts.Remove(RctEnt_.dwPid); end; finally enum.Free; end; end; finally CloseHandle(hSnapProc); end; except on E: Exception do ETgException.TraceException(Self, E, 'Execute() .. Fail'); end; Sleep(300); end; if bCoInit_ then CoUninitialize; end; { Function } function PriorityStrByClass(nClass: Integer): String; begin case nClass of NORMAL_PRIORITY_CLASS : Result := 'Normal'; ABOVE_NORMAL_PRIORITY_CLASS : Result := 'ABOVE Normal'; BELOW_NORMAL_PRIORITY_CLASS : Result := 'Below Normal'; HIGH_PRIORITY_CLASS : Result := 'High'; REALTIME_PRIORITY_CLASS : Result := 'Realtime'; IDLE_PRIORITY_CLASS : Result := 'Idle'; else Result := 'Unknown'; end; end; function TerminateProcessByPid(dwPid: DWORD; bForce: Boolean = false): Boolean; var hProcess: THandle; begin Result := false; // hProcess := OpenProcess(PROC_FULL_ACCESS, false, dwPid); // if hProcess = 0 then // begin // hProcess := OpenProcess(PROCESS_TERMINATE, false, dwPid); // if hProcess = 0 then // exit; // end; hProcess := OpenProcess(PROCESS_TERMINATE, false, dwPid); if hProcess = 0 then begin if bForce then begin // 윈도우 11에서는 관리자 권한이 있어도 OpenProcess(PROCESS_TERMINATE...) 권한 획득에 실패하는 경우가 있다. (서비스) // 이 경우 아래처럼 하면 해결되어서 추가함 22_1208 09:39:42 kku var ss: TStringStream; Guard(ss, TStringStream.Create('', TEncoding.UTF8)); GetCmdTextToStream(Format('taskkill.exe /f /pid %d', [dwPid]), '', ss, 5000); var sData: String := UpperCase(ss.DataString); Result := (Pos('성공', sData) > 0) or (Pos('SUCCESS', sData) > 0); end; exit; end; try Result := TerminateProcess(hProcess, 0); finally CloseHandle(hProcess); end; end; function TerminateProcessByName(sPName: String; dwIgrPid: DWORD = 0): Boolean; var hSnapProc: THandle; ProcEnt: TProcessEntry32; nTmCnt: Integer; begin Result := false; if sPName = '' then exit; hSnapProc := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); if hSnapProc = INVALID_HANDLE_VALUE then exit; sPName := UpperCase(sPName); nTmCnt := 0; try ProcEnt.dwSize := SizeOf(TProcessEntry32); Process32First(hSnapProc, ProcEnt); // first = "system" while Process32Next(hSnapProc, ProcEnt) do begin if (UpperCase(ProcEnt.szExeFile) = sPName) and (ProcEnt.th32ProcessID <> dwIgrPid) then begin if TerminateProcessByPid(ProcEnt.th32ProcessID) then Inc(nTmCnt); end; end; finally CloseHandle(hSnapProc); end; Result := nTmCnt > 0; end; procedure TerminateProcessFromList(aList: TStringList; aIgrList: TStringList = nil); var hSnapProc: THandle; ProcEnt: TProcessEntry32; begin if aList.CaseSensitive then aList.CaseSensitive := false; hSnapProc := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); if hSnapProc = INVALID_HANDLE_VALUE then exit; try ProcEnt.dwSize := SizeOf(TProcessEntry32); Process32First(hSnapProc, ProcEnt); // first = "system" while Process32Next(hSnapProc, ProcEnt) do begin if aList.IndexOf(ProcEnt.szExeFile) <> -1 then begin if (aIgrList <> nil) and (aIgrList.IndexOf(ProcEnt.szExeFile) <> -1) then continue; TerminateProcessByPid(ProcEnt.th32ProcessID); end; end; finally CloseHandle(hSnapProc); end; end; // 프로세스 실행 안되어있는지 확인하고, 실행 되어 있으면 죽임 20_1119 22:03:27 kku function CheckProcessNameDeadOrTerminate(sPName: String): Boolean; begin Result := GetProcessPidByName(sPName) = 0; if not Result then begin TerminateProcessByName(sPName); Sleep(1000); Result := GetProcessPidByName(sPName) = 0; end; end; function GetProcessOwner(hProcess: THandle): String; var hToken: THandle; dwSize, dwUserLen, dwDomainLen: DWORD; pUserToken: PTOKEN_USER; sUser, sDomain: String; sidName: SID_NAME_USE; begin Result := ''; pUserToken := nil; hToken := 0; if not OpenProcessToken(hProcess, TOKEN_READ, hToken) then exit; try dwSize := 0; GetTokenInformation(hToken, TokenUser, nil, 0, dwSize); if GetLastError = ERROR_INSUFFICIENT_BUFFER then begin GetMem(pUserToken, dwSize); if GetTokenInformation(hToken, TokenUser, pUserToken, dwSize, dwSize) then begin dwUserLen := 256; dwDomainLen := 256; SetLength(sUser, dwUserLen); SetLength(sDomain, dwDomainLen); if LookupAccountSid(nil, pUserToken.User.Sid, @sUser[1], dwUserLen, @sDomain[1], dwDomainLen, sidName) then Result := Format('%s\%s', [DeleteNullTail(sDomain), DeleteNullTail(sUser)]); end; end; finally if hToken <> 0 then CloseHandle(hToken); if pUserToken <> nil then FreeMem(pUserToken); end; end; function GetProcessNameToList(aList: TStringList): Integer; var hSnapProc: THandle; ProcEnt: TProcessEntry32; begin if aList = nil then begin Result := 0; exit; end; aList.Clear; hSnapProc := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); if hSnapProc = INVALID_HANDLE_VALUE then exit; try ProcEnt.dwSize := SizeOf(TProcessEntry32); Process32First(hSnapProc, ProcEnt); // first = "system" while Process32Next(hSnapProc, ProcEnt) do aList.Add(ProcEnt.szExeFile); finally CloseHandle(hSnapProc); end; Result := aLIst.Count; end; function GetProcessPidByName(sModuleName: String; dwIgnPid: DWORD = 0): DWORD; var hSnapProc: THandle; ProcEnt: TProcessEntry32; begin Result := 0; hSnapProc := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); if hSnapProc = INVALID_HANDLE_VALUE then exit; sModuleName := UpperCase(sModuleName); try ProcEnt.dwSize := SizeOf(TProcessEntry32); Process32First(hSnapProc, ProcEnt); // first = "system" while Process32Next(hSnapProc, ProcEnt) do begin if (dwIgnPid <> ProcEnt.th32ProcessID) and (UpperCase(ProcEnt.szExeFile) = sModuleName) then begin Result := ProcEnt.th32ProcessID; exit; end; end; finally CloseHandle(hSnapProc); end; end; function GetProcessPidsByName(sModuleName: String; aPIDList: TProcessIdList = nil): Integer; var hSnapProc: THandle; ProcEnt: TProcessEntry32; begin Result := 0; if aPIDList <> nil then aPIDList.Clear; hSnapProc := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); if hSnapProc = INVALID_HANDLE_VALUE then exit; sModuleName := UpperCase(sModuleName); try ProcEnt.dwSize := SizeOf(TProcessEntry32); Process32First(hSnapProc, ProcEnt); // first = "system" while Process32Next(hSnapProc, ProcEnt) do begin if UpperCase(ProcEnt.szExeFile) = sModuleName then begin Inc(Result); if aPIDList <> nil then aPIDList.Add(ProcEnt.th32ProcessID); end; end; finally CloseHandle(hSnapProc); end; end; function GetProcessNameByPid(dwPid: DWORD): String; var hSnapProc: THandle; ProcEnt: TProcessEntry32; begin Result := ''; if dwPid = 0 then exit; hSnapProc := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); if hSnapProc = INVALID_HANDLE_VALUE then exit; try ProcEnt.dwSize := SizeOf(TProcessEntry32); Process32First(hSnapProc, ProcEnt); // first = "system" while Process32Next(hSnapProc, ProcEnt) do begin if ProcEnt.th32ProcessID = dwPid then begin Result := StrPas(ProcEnt.szExeFile); exit; end; end; finally CloseHandle(hSnapProc); end; end; function GetProcessPPidByPid(dwPid: DWORD): DWORD; var hSnapProc: THandle; ProcEnt: TProcessEntry32; begin Result := 0; if dwPid = 0 then exit; hSnapProc := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); if hSnapProc = INVALID_HANDLE_VALUE then exit; try ProcEnt.dwSize := SizeOf(TProcessEntry32); Process32First(hSnapProc, ProcEnt); // first = "system" while Process32Next(hSnapProc, ProcEnt) do begin if ProcEnt.th32ProcessID = dwPid then begin Result := ProcEnt.th32ParentProcessID; exit; end; end; finally CloseHandle(hSnapProc); end; end; function GetProcessPathByPid(dwPid: DWORD): String; var PList: TProcessEntList; // TTgProcessList; begin Result := ''; if dwPid = 0 then exit; Guard(PList, TProcessEntList.Create); PList.UpdateProcessList; Result := PList.GetProcPathByPid(dwPid); end; function GetProcessPIDFromWndHandle(hWndHandle: THandle): DWORD; begin Result := 0; if hWndHandle <> 0 then GetWindowThreadProcessId(hWndHandle, Result); end; function GetProcessNameFromWndHandle(hWndHandle: THandle): String; var dwPid: DWORD; begin Result := ''; if hWndHandle = 0 then exit; dwPid := GetProcessPIDFromWndHandle(hWndHandle); if dwPid <> 0 then Result := GetProcessNameByPid(dwPid); end; function GetProcessPathFromWndHandle(hWndHandle: THandle): String; var dwPid: DWORD; begin Result := ''; if hWndHandle = 0 then exit; dwPid := GetProcessPIDFromWndHandle(hWndHandle); if dwPid <> 0 then Result := GetProcessPathByPid(dwPid); end; function GetWndHandleFromPID(dwPid: DWORD; sIfWndCaption: String = ''): HWND; var h: HWND; dwCheckPID: DWORD; begin Result := 0; h := FindWindow(nil, nil); while h <> 0 do begin if GetParent(h) = 0 then begin // 최상위 핸들 체크 (컨트롤 무시) GetWindowThreadProcessId(h, @dwCheckPID); if dwCheckPID = dwPid then begin // 윈도우7에서는 메인 윈도우 핸들이 구해 지지 않아서 윈도우 캡션 조건을 하나 더 추가 if (sIfWndCaption <> '') and (GetWindowCaption(h) <> sIfWndCaption) then begin h := GetWindow(h, GW_HWNDNEXT); continue; end; Result := h; exit; end; end; h := GetWindow(h, GW_HWNDNEXT); end; end; function GetWndHandleFromPidEx(dwPid: DWORD; sClassName: String): HWND; var h: HWND; dwCheckPID: DWORD; begin Result := 0; h := FindWindow(nil, nil); while h <> 0 do begin if GetParent(h) = 0 then begin // 최상위 핸들 체크 (컨트롤 무시) GetWindowThreadProcessId(h, @dwCheckPID); if (dwCheckPID = dwPid) and (GetWndClassName(h) = sClassName) then begin Result := h; exit; end; end; h := GetWindow(h, GW_HWNDNEXT); end; end; //function _FindWindow_GetWndHandlesFromPID(h: HWND; lParam: NativeInt): BOOL; stdcall; //var // dwPid, // dwCurPid: DWORD; //begin // dwCurPid := 0; // GetWindowThreadProcessId(h, dwCurPid); // if dwCurPid = StrToInt(TStrings(lParam)[0]) then // begin // TStrings(lParam).Add(IntToStr(h)); // end; // Result := TRUE; //end; // //function GetWndHandlesFromPID(dwPid: DWORD; HandleList: TStrings): Integer; //begin // HandleList.Clear; // HandleList.Add(IntToStr(dwPid)); // EnumWindows(@_FindWindow_GetWndHandlesFromPID, NativeInt(HandleList)); // HandleList.Delete(0); //end; function GetWndHandlesFromPID(dwPid: DWORD; HandleList: TStrings): Integer; var h: HWND; dwCheckPID: DWORD; begin Result := 0; HandleList.Clear; h := FindWindow(nil, nil); while h <> 0 do begin if GetParent(h) = 0 then begin // 최상위 핸들 체크 (컨트롤 무시) GetWindowThreadProcessId(h, @dwCheckPID); if dwCheckPID = dwPid then begin HandleList.Add(IntToStr(h)); Inc(Result); end; end; h := GetWindow(h, GW_HWNDNEXT); end; end; function GetProcesssUserSidFromPID(dwPid: DWORD): String; var hProcess, hToken: THandle; dwSize: DWORD; pUserToken: PTOKEN_USER; sUserSid: PChar; begin Result := ''; if dwPid = 0 then exit; hToken := 0; try hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, FALSE, dwPid); if hProcess = 0 then exit; try if not OpenProcessToken(hProcess, TOKEN_QUERY, hToken) then exit; GetTokenInformation(hToken, TokenUser, nil, 0, dwSize); if GetLastError = ERROR_INSUFFICIENT_BUFFER then begin GetMem(pUserToken, dwSize); if GetTokenInformation(hToken, TokenUser, pUserToken, dwSize, dwSize) then begin if ConvertSidToStringSid(pUserToken.User.Sid, sUserSid) then Result := StrPas(sUserSid); end; end; finally if pUserToken <> nil then FreeMem(pUserToken); if hToken <> 0 then CloseHandle(hToken); CloseHandle(hProcess); end; except on E: Exception do ETgException.TraceException(E, 'Fail .. GetProcesssUserSidFromPID()'); end; end; function GetProcesssUserSidFromName(sPName: String): String; begin Result := GetProcesssUserSidFromPID(GetProcessPidByName(sPName)); end; function GetExeFileArchitectFromeStream(aStream: TStream): TExeArchitectKind; const IMAGE_FILE_MACHINE_I386 = $014C; // Intel x86 IMAGE_FILE_MACHINE_IA64 = $0200; // Intel Itanium Processor Family (IPF) IMAGE_FILE_MACHINE_AMD64 = $8664; // x64 (AMD64 or EM64T) // You'll unlikely encounter the things below: IMAGE_FILE_MACHINE_R3000_BE = $160; // MIPS big-endian IMAGE_FILE_MACHINE_R3000 = $162; // MIPS little-endian, 0x160 big-endian IMAGE_FILE_MACHINE_R4000 = $166; // MIPS little-endian IMAGE_FILE_MACHINE_R10000 = $168; // MIPS little-endian IMAGE_FILE_MACHINE_ALPHA = $184; // Alpha_AXP } IMAGE_FILE_MACHINE_POWERPC = $1F0; // IBM PowerPC Little-Endian var Header: TImageDosHeader; ImgHeader: TImageNtHeaders; begin Result := eakNoExe; aStream.ReadBuffer(Header, SizeOf(Header)); if (Header.e_magic <> IMAGE_DOS_SIGNATURE) or (Header._lfanew = 0) then exit; aStream.Position := Header._lfanew; aStream.ReadBuffer(ImgHeader, SizeOf(ImgHeader)); if ImgHeader.Signature <> IMAGE_NT_SIGNATURE then exit; if ImgHeader.FileHeader.Machine = IMAGE_FILE_MACHINE_I386 then Result := eak32 else Result := eak64; end; function GetExeFileArchitectFromePath(sPath: String): TExeArchitectKind; var fs: TFileStream; begin Guard(fs, TFileStream.Create(sPath, fmOpenRead or fmShareDenyNone)); Result := GetExeFileArchitectFromeStream(fs); end; function ExecuteApp(const sPath, sParam: String; wVisible: WORD; dwFlag: DWORD; nX: Integer; nY: Integer): TProcessInformation; var StartupInfo: TStartupInfo; sDir, sName: String; begin ZeroMemory(@Result, SizeOf(Result)); ZeroMemory(@StartupInfo, SizeOf(StartupInfo)); StartupInfo.cb := Sizeof(StartupInfo); StartupInfo.dwFlags := dwFlag; StartupInfo.wShowWindow := wVisible; // StartupInfo.lpDesktop := PWideChar(WideString('WinSta0\Default')); StartupInfo.dwX := nX; StartupInfo.dwY := nY; sDir := ExtractFilePath(sPath); sName := ExtractFileName(sPath); // CreateProcess(PChar(sName), // PChar(Format('%s %s', [sPath, sParam])), { pointer to command line string } // nil, { pointer to process security attributes } // nil, { pointer to thread security attributes } // false, { handle inheritance flag } //// CREATE_NEW_PROCESS_GROUP, // CREATE_NEW_CONSOLE or { creation flags } // NORMAL_PRIORITY_CLASS, // nil, { pointer to new environment block } // PChar(sDir), { pointer to current directory name } // StartupInfo, { pointer to STARTUPINFO } // Result); { pointer to PROCESS_INF } CreateProcess(nil, PChar(Format('%s %s', [sPath, sParam])), { pointer to command line string } nil, { pointer to process security attributes } nil, { pointer to thread security attributes } false, { handle inheritance flag } // CREATE_NEW_PROCESS_GROUP, CREATE_NEW_CONSOLE or { creation flags } NORMAL_PRIORITY_CLASS, nil, { pointer to new environment block } nil, { pointer to current directory name } StartupInfo, { pointer to STARTUPINFO } Result); { pointer to PROCESS_INF } end; procedure ReadPipeFromCmd(sCommand, sParam: String; nShow: Integer; ProcessString: TProcessString; dwExitTimeout: DWORD = 0); var hReadOutPipe, hWriteOutPipe: THandle; SI: TStartUpInfo; PI: TProcessInformation; SA: TSecurityAttributes; SD: TSecurityDescriptor; dwBytesRead: DWORD; sDest: AnsiString; dwAvail, dwExitCode, dwWaitResult, dwExecuteTick: DWORD; bWorkStop: Boolean; function IsNT: Boolean; var OS: TOSVersionInfo; begin OS.dwOSVersionInfoSize := Sizeof(OS); GetVersionEx(OS); if OS.dwPlatformId = VER_PLATFORM_WIN32_NT then Result:= true else Result:= false; end; begin hReadOutPipe := 0; hWriteOutPipe := 0; if IsNT then begin InitializeSecurityDescriptor(@SD, SECURITY_DESCRIPTOR_REVISION); SetSecurityDescriptorDacl(@SD, True, nil, False); SA.nLength := SizeOf(SA); SA.lpSecurityDescriptor := @SD; SA.bInheritHandle := true; CreatePipe(hReadOutPipe, hWriteOutPipe, @SA, 1024); end else CreatePipe(hReadOutPipe, hWriteOutPipe, nil, 1024); ZeroMemory(@PI, SizeOf(PI)); ZeroMemory(@SI, SizeOf(SI)); SI.cb := SizeOf(SI); SI.wShowWindow := nShow; SI.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES; SI.hStdOutput := hWriteOutPipe; SI.hStdError := hWriteOutPipe; dwExecuteTick := GetTickCount; bWorkStop := false; if CreateProcess(nil,//PChar(sCommand), PChar(sCommand + ' ' + sParam), nil, nil, true, NORMAL_PRIORITY_CLASS, nil, nil, SI, PI) then begin try dwExitCode := 0; while dwExitCode = 0 do begin dwWaitResult := WaitForSingleObject(PI.hProcess, 50); if PeekNamedPipe(hReadOutPipe, nil, 0, nil, @dwAvail, nil) then begin if dwAvail > 0 then begin SetLength(sDest, dwAvail); ReadFile(hReadOutPipe, sDest[1], dwAvail, dwBytesRead, nil); ProcessString(sDest, bWorkStop); if bWorkStop then exit; end; end; if dwWaitResult <> WAIT_TIMEOUT then dwExitCode := 1; // 메세지 없이 계속 돌아가는 상황을 위해서 빠져나오는 타임아웃을 추가함 (tcptunnel.exe 관련을 위해 추가) if (dwExitTimeout > 0) and ((GetTickCount - dwExecuteTick) > dwExitTimeout) then exit; end; GetExitCodeProcess(PI.hProcess, dwExitCode); finally CloseHandle(PI.hProcess); CloseHandle(PI.hThread); if hReadOutPipe <> 0 then CloseHandle(hReadOutPipe); if hWriteOutPipe <> 0 then CloseHandle(hWriteOutPipe); end; end; end; function GetCmdTextToStream(sCommand, sParam: String; aStream: TStream; dwTimeMilSec: DWORD = 0): Boolean; begin Result := false; try ReadPipeFromCmd(sCommand, sParam, SW_HIDE, procedure(sText: String; var bWorkStop: Boolean) var sData: UTF8String; begin sData := sText; aStream.Write(PAnsiChar(sData)^, Length(sData)); end, dwTimeMilSec); Result := true; except on E: Exception do ETgException.TraceException(E, 'Fail .. GetCmdTextToStream()'); end; end; function ExecuteAppAsUser(dwFollowPID: DWORD; sPath, sParam: String; dwVisible: DWORD): TProcessInformation; const DEFWINSTATION = 'WinSta0'; DEFDESKTOP = 'Default'; WINLOGON = 'Winlogon'; SCREENSAVER = 'Screen-Saver'; WHITESPACE = ' '{SPACE}+chr(9){TAB}+chr(10){LF}; DOMUSERSEP = '\'; var StartupInfo: TStartupInfo; ProcessInfo: TProcessInformation; dwCreateFlag: DWORD; pEnvBlock: Pointer; hProc, hToken, hNewToken: THandle; TIL: TOKEN_MANDATORY_LABEL; begin ZeroMemory(@Result, SizeOf(Result)); ZeroMemory(@ProcessInfo, SizeOf(TProcessInformation)); ZeroMemory(@TIL, SizeOf(TIL)); hToken := 0; hNewToken := 0; if dwFollowPID = 0 then begin TTgTrace.T('ExecuteAppAsUser() .. FollowPID is null..'); exit; end; // hProc := OpenProcess(PROCESS_ALL_ACCESS, false, dwFollowPID); hProc := OpenProcess(MAXIMUM_ALLOWED, false, dwFollowPID); if hProc = 0 then begin TTgTrace.T('ExecuteAppAsUser() .. OpenProcess() - Fail... Error=%d', [GetLastError]); exit; end; try // if OpenProcessToken(hProc, TOKEN_ASSIGN_PRIMARY or TOKEN_DUPLICATE, hToken) then if OpenProcessToken(hProc, MAXIMUM_ALLOWED, hToken) then begin // if DuplicateTokenEx(hToken, TOKEN_ASSIGN_PRIMARY or TOKEN_ALL_ACCESS, nil, if DuplicateTokenEx(hToken, MAXIMUM_ALLOWED, nil, SecurityImpersonation, TokenPrimary, hNewToken) then begin {$IF false} pIntSid := nil; copy_str(sIntSid, 's-1-16-4096'); if ConvertSidToStringSid(@sIntSid, pIntSid) then begin TIL.Label_.Attributes := SE_GROUP_INTEGRITY; TIL.Label_.Sid := pIntSid; if SetTokenInformation(hNewToken, TokenIntegrityLevel, @TIL, SizeOf(TIL)+GetLengthSid(pIntSid)) then begin ZeroMemory(@StartupInfo, SizeOf(TStartupInfo)); StartupInfo.cb := Sizeof(TStartupInfoW); StartupInfo.lpDesktop := DEFWINSTATION + '\' + DEFDESKTOP; // StartupInfo.lpDesktop := DEFWINSTATION + '\' + WINLOGON; StartupInfo.wShowWindow := dwVisible; // StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USEPOSITION; // SW_HIDE등을 적용 시키려면 이걸 활성화 시켜줘야 한다 dwCreateFlag := NORMAL_PRIORITY_CLASS or CREATE_NEW_CONSOLE; pEnvBlock := nil; CreateEnvironmentBlock(pEnvBlock, hNewToken, true); if pEnvBlock <> nil then dwCreateFlag := dwCreateFlag or CREATE_UNICODE_ENVIRONMENT; if CreateProcessAsUserW(hNewToken, nil,//PWideChar(ExtractFileName(sPath)), PWideChar(Format('"%s" %s', [sPath, sParam])), nil, nil, false, dwCreateFlag, pEnvBlock, nil,//PWideChar(ExtractFilePath(sPath)), StartupInfo, ProcessInfo) then begin Result := ProcessInfo; end else TTgTrace.T('ExecuteAppAsUser() .. CreateProcessAsUserW() - Fail... Error=%d', [GetLastError]); end; // LocalFree(pIntSid); end; {$ELSE} // ImpersonateLoggedOnUser(hToken); // if GetLastError <> ERROR_SUCCESS then // exit; ZeroMemory(@StartupInfo, SizeOf(StartupInfo)); StartupInfo.cb := Sizeof(StartupInfo); StartupInfo.lpDesktop := DEFWINSTATION + '\' + DEFDESKTOP; // StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USEPOSITION; // SW_HIDE등을 적용 시키려면 이걸 활성화 시켜줘야 한다 StartupInfo.wShowWindow := dwVisible; dwCreateFlag := NORMAL_PRIORITY_CLASS or CREATE_NEW_CONSOLE; pEnvBlock := nil; CreateEnvironmentBlock(pEnvBlock, hNewToken, true); if pEnvBlock <> nil then dwCreateFlag := dwCreateFlag or CREATE_UNICODE_ENVIRONMENT; if CreateProcessAsUserW(hNewToken, nil,//PWideChar(ExtractFileName(sPath)), PWideChar(Format('"%s" %s', [sPath, sParam])), nil, nil, false, dwCreateFlag, pEnvBlock, nil,//PWideChar(ExtractFilePath(sPath)), StartupInfo, ProcessInfo) then begin Result := ProcessInfo; end else TTgTrace.T('ExecuteAppAsUser() .. CreateProcessAsUserW() - Fail... Error=%d', [GetLastError]); {$IFEND} end; end else TTgTrace.T('ExecuteAppAsUser() .. OpenProcessToken() - Fail... Error=%d', [GetLastError]); finally if hToken <> 0 then CLoseHandle(hToken); if hNewToken <> 0 then CloseHandle(hNewToken); if hProc <> 0 then CloseHandle(hProc); end; end; function ExecuteAppAsUser(sModuleName, sPath, sParam: String; dwVisible: DWORD): TProcessInformation; begin Result := ExecuteAppAsUser(GetProcessPidByName(sModuleName), sPath, sParam, dwVisible); end; function ExecuteAppWaitUntilTerminate(sPath, sParam: String; dwVisible: DWORD; nTimeOutMilSec: Integer = -1): Boolean; var PI: TProcessInformation; StartupInfo: TStartupInfo; sDir, sName: String; // dwExitCode, dwWaitResult, dwExecuteTick: DWORD; begin ZeroMemory(@PI, SizeOf(PI)); ZeroMemory(@StartupInfo, SizeOf(StartupInfo)); StartupInfo.cb := Sizeof(StartupInfo); StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USEPOSITION; StartupInfo.wShowWindow := dwVisible; sDir := ExtractFilePath(sPath); sName := ExtractFileName(sPath); Result := CreateProcess(nil, PChar(Format('%s %s', [sPath, sParam])), { pointer to command line string } nil, { pointer to process security attributes } nil, { pointer to thread security attributes } false, { handle inheritance flag } CREATE_NEW_CONSOLE or { creation flags } NORMAL_PRIORITY_CLASS, nil, { pointer to new environment block } nil, { pointer to current directory name } StartupInfo, { pointer to STARTUPINFO } PI); { pointer to PROCESS_INF } if Result then begin dwExecuteTick := GetTickCount; while true do begin dwWaitResult := WaitForSingleObject(PI.hProcess, 50); if dwWaitResult <> WAIT_TIMEOUT then break; // 메세지 없이 계속 돌아가는 상황을 위해서 빠져나오는 타임아웃을 추가함 (tcptunnel.exe 관련을 위해 추가) if (nTimeOutMilSec > 0) and ((GetTickCount - dwExecuteTick) > nTimeOutMilSec) then begin TerminateProcess(PI.hProcess, 999); exit; end; end; // GetExitCodeProcess(PI.hProcess, dwExitCode); end; end; // 0 이하 : 실패, 1 : 성공, 2 : 이미 사용중 function InjectModule(dwPid: DWORD; sDllPath: String; pbIsWow64: PBoolean = nil): Integer; var dwThdID: DWORD; dwBufSize, dwWritten: NativeUInt; hProcess, hModuleThread: THandle; pRemoteBuf: Pointer; bWow64: BOOL; hModuleSht: THandle; MdEnt32: TModuleEntry32; begin Result := 0; if dwPid = 0 then exit; hProcess := OpenProcess(PROCESS_ALL_ACCESS, False, dwPID); if pbIsWow64 <> nil then begin if not IsWow64Process(hProcess, bWow64) then begin Result := -1; TTgTrace.T('Fail .. InjectModule(0) .. IsWow64Process()'); exit; end; if ((pbIsWow64^ = true) and not bWow64) or ((pbIsWow64^ = false) and bWow64) then exit; end; if hProcess = 0 then begin Result := -2; TTgTrace.T('Fail .. InjectModule(0) .. OpenProcess()'); exit; end; try // 이미 사용중인 모듈인지 체크 22_1028 13:35:00 kku hModuleSht := CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, dwPid); try if hModuleSht <> INVALID_HANDLE_VALUE then begin ZeroMemory(@MdEnt32, SizeOf(MdEnt32)); MdEnt32.dwSize := SizeOf(MdEnt32); if Module32First(hModuleSht, MdEnt32) then Repeat if CompareText(sDllPath, String(MdEnt32.szExePath)) = 0 then begin // 이미 로드됨 Result := 2; exit; end; Until not Module32Next(hModuleSht, MdEnt32); end; finally if (hModuleSht <> 0) and (hModuleSht <> INVALID_HANDLE_VALUE) then CloseHandle(hModuleSht); end; dwBufSize := Length(sDllPath) * 2; pRemoteBuf := VirtualAllocEx(hProcess, nil, dwBufSize, MEM_COMMIT, PAGE_READWRITE); if pRemoteBuf = nil then begin Result := -3; TTgTrace.T('Fail .. InjectModule(0) .. VirtualAllocEx()'); exit; end; if not WriteProcessMemory(hProcess, pRemoteBuf, PChar(sDllPath), dwBufSize, dwWritten) then begin Result := -4; TTgTrace.T('Fail .. InjectModule(0) .. WriteProcessMemory()'); exit; end; // DLL Injection hModuleThread := CreateRemoteThread(hProcess, nil, 0, GetProcAddress(LoadLibrary('kernel32.dll'), 'LoadLibraryW'), pRemoteBuf, 0, dwThdID); if hModuleThread <> 0 then begin try if WaitForSingleObject(hModuleThread, 20000{INFINITE}) = WAIT_FAILED then Sleep(500); finally CloseHandle(hModuleThread); end; Result := 1; end else begin Result := GetLastError * -1; if Result = 0 then Result := -999; TTgTrace.T('Fail .. InjectModule(0) .. CreateRemoteThread()'); end; finally if pRemoteBuf <> nil then VirtualFreeEx(hProcess, pRemoteBuf, dwBufSize, MEM_RELEASE); CloseHandle(hProcess); end; end; function EjectModule(hProcess: THandle; pModBaseAddr: Pointer; hKernel32: HMODULE = 0): Boolean; var hModuleThread: THandle; dwThreadId: DWORD; begin Result := false; if pModBaseAddr = nil then exit; if hKernel32 = 0 then begin hKernel32 := GetModuleHandle(kernel32); if hKernel32 = 0 then exit; end; try hModuleThread := CreateRemoteThread(hProcess, nil, 0, GetProcAddress(hKernel32, 'FreeLibrary'), pModBaseAddr, 0, dwThreadId); // hModuleThread := CreateRemoteThread(hProcess, nil, 0, // GetProcAddress(hKernel32, 'FreeLibraryAndExitThread'), pModBaseAddr, 0, dwThreadId); if hModuleThread <> 0 then begin try if WaitForSingleObject(hModuleThread, 20000{INFINITE}) = WAIT_FAILED then Sleep(500); // if WaitForSingleObject(hModuleThread, INFINITE) = WAIT_FAILED then // Sleep(500); finally CloseHandle(hModuleThread); end; Result := true; end; except on E: Exception do ETgException.TraceException(E, 'EjectModule() .. Fail .. hModuleThread'); end; end; function EjectModuleFromPath(sDllPaths: String; dwIgrPid: DWORD = 0): Integer; var DllList: TStringList; hProcess, hModuleSht: THandle; MdEnt32: TModuleEntry32; hKernel32: HMODULE; h: THandle; ProcEnt: TProcessEntry32; i: Integer; begin Result := 0; hKernel32 := GetModuleHandle(kernel32); if hKernel32 = 0 then exit; Result := 0; h := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); if h = INVALID_HANDLE_VALUE then exit; try Guard(DllList, TStringList.Create); SplitString(sDllPaths, '|', DllList); try ProcEnt.dwSize := SizeOf(ProcEnt); Process32First(h, ProcEnt); // system while Process32Next(h, ProcEnt) do begin hModuleSht := 0; if ProcEnt.th32ProcessID = dwIgrPid then continue; hProcess := OpenProcess(PROC_FULL_ACCESS, false, ProcEnt.th32ProcessID); if hProcess <> 0 then hModuleSht := CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, ProcEnt.th32ProcessID); try if hModuleSht <> INVALID_HANDLE_VALUE then begin ZeroMemory(@MdEnt32, SizeOf(MdEnt32)); MdEnt32.dwSize := SizeOf(MdEnt32); if Module32First(hModuleSht, MdEnt32) then Repeat for i := 0 to DllList.Count - 1 do begin if CompareText(DllList[i], String(MdEnt32.szExePath)) = 0 then begin if EjectModule(hProcess, MdEnt32.modBaseAddr, hKernel32) then Inc(Result); end; end; Until not Module32Next(hModuleSht, MdEnt32); end; finally if hProcess <> 0 then CloseHandle(hProcess); if (hModuleSht <> 0) and (hModuleSht <> INVALID_HANDLE_VALUE) then CloseHandle(hModuleSht); end; end; finally CloseHandle(h); end; except on E: Exception do ETgException.TraceException(E, 'Fail .. EjectModuleFromPath()'); end; end; function EjectModuleFromPath2(sDllPath: String; sIgrPNames: String): Integer; var hProcess, hModuleSht: THandle; MdEnt32: TModuleEntry32; hKernel32: HMODULE; h: THandle; ProcEnt: TProcessEntry32; IgrList: TStringList; begin Result := 0; hKernel32 := GetModuleHandle(kernel32); if hKernel32 = 0 then exit; Result := 0; h := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); if h = INVALID_HANDLE_VALUE then exit; try Guard(IgrList, TStringList.Create); IgrList.CaseSensitive := false; SplitString(sIgrPNames, '|', IgrList); try ProcEnt.dwSize := SizeOf(ProcEnt); Process32First(h, ProcEnt); // system while Process32Next(h, ProcEnt) do begin hModuleSht := 0; if IgrList.IndexOf(String(ProcEnt.szExeFile)) <> -1 then continue; hProcess := OpenProcess(PROC_FULL_ACCESS, false, ProcEnt.th32ProcessID); if hProcess <> 0 then hModuleSht := CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, ProcEnt.th32ProcessID); try if hModuleSht <> INVALID_HANDLE_VALUE then begin ZeroMemory(@MdEnt32, SizeOf(MdEnt32)); MdEnt32.dwSize := SizeOf(MdEnt32); if Module32First(hModuleSht, MdEnt32) then Repeat if CompareText(sDllPath, String(MdEnt32.szExePath)) = 0 then begin if EjectModule(hProcess, MdEnt32.modBaseAddr, hKernel32) then Inc(Result); end; Until not Module32Next(hModuleSht, MdEnt32); end; finally if hProcess <> 0 then CloseHandle(hProcess); if (hModuleSht <> 0) and (hModuleSht <> INVALID_HANDLE_VALUE) then CloseHandle(hModuleSht); end; end; finally CloseHandle(h); end; except on E: Exception do ETgException.TraceException(E, 'Fail .. EjectModuleFromPath()'); end; end; function EjectModuleFromPathUntilZero(sDllPath: String; dwIgrPid: DWORD = 0): Integer; begin Result := 0; while EjectModuleFromPath(sDllPath, dwIgrPid) <> 0 do begin Inc(Result); if Result > 50 then exit; Sleep(300); end; end; function EjectModuleFromName(sName: String; dwIgrPid: DWORD = 0): Integer; var hProcess, hModuleSht: THandle; MdEnt32: TModuleEntry32; hKernel32: HMODULE; h: THandle; ProcEnt: TProcessEntry32; begin Result := 0; hKernel32 := GetModuleHandle(kernel32); if hKernel32 = 0 then exit; Result := 0; h := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); if h = INVALID_HANDLE_VALUE then exit; try try ProcEnt.dwSize := SizeOf(ProcEnt); Process32First(h, ProcEnt); // system while Process32Next(h, ProcEnt) do begin hModuleSht := 0; if ProcEnt.th32ProcessID = dwIgrPid then continue; hProcess := OpenProcess(PROC_FULL_ACCESS, false, ProcEnt.th32ProcessID); if hProcess <> 0 then hModuleSht := CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, ProcEnt.th32ProcessID); try if hModuleSht <> INVALID_HANDLE_VALUE then begin ZeroMemory(@MdEnt32, SizeOf(MdEnt32)); MdEnt32.dwSize := SizeOf(MdEnt32); if Module32First(hModuleSht, MdEnt32) then Repeat if CompareText(sName, ExtractFileName(String(MdEnt32.szExePath))) = 0 then begin if EjectModule(hProcess, MdEnt32.modBaseAddr, hKernel32) then Inc(Result); end; Until not Module32Next(hModuleSht, MdEnt32); end; finally if hProcess <> 0 then CloseHandle(hProcess); if (hModuleSht <> 0) and (hModuleSht <> INVALID_HANDLE_VALUE) then CloseHandle(hModuleSht); end; end; finally CloseHandle(h); end; except on E: Exception do ETgException.TraceException(E, 'Fail .. EjectModuleFromPath()'); end; end; function EjectModuleByPName(dwPid: DWORD; sDllName: String): Boolean; var hProcess, hModuleSht: THandle; MdEnt32: TModuleEntry32; hKernel32: HMODULE; h: THandle; ProcEnt: TProcessEntry32; begin Result := false; hKernel32 := GetModuleHandle(kernel32); if hKernel32 = 0 then exit; h := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); if h = INVALID_HANDLE_VALUE then exit; try try ProcEnt.dwSize := SizeOf(ProcEnt); Process32First(h, ProcEnt); // system while Process32Next(h, ProcEnt) do begin hModuleSht := 0; if dwPid = ProcEnt.th32ProcessID then begin hProcess := OpenProcess(PROC_FULL_ACCESS, false, ProcEnt.th32ProcessID); if hProcess <> 0 then hModuleSht := CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, ProcEnt.th32ProcessID); try if hModuleSht <> INVALID_HANDLE_VALUE then begin ZeroMemory(@MdEnt32, SizeOf(MdEnt32)); MdEnt32.dwSize := SizeOf(MdEnt32); if Module32First(hModuleSht, MdEnt32) then Repeat if CompareText(sDllName, ExtractFileName(String(MdEnt32.szExePath))) = 0 then begin if EjectModule(hProcess, MdEnt32.modBaseAddr, hKernel32) then begin Result := true; exit; end; end; Until not Module32Next(hModuleSht, MdEnt32); end; finally if hProcess <> 0 then CloseHandle(hProcess); if (hModuleSht <> 0) and (hModuleSht <> INVALID_HANDLE_VALUE) then CloseHandle(hModuleSht); end; end; end; finally CloseHandle(h); end; except on E: Exception do ETgException.TraceException(E, 'Fail .. EjectModuleFromPath()'); end; end; end.