BSOne.SFC/Tocsg.Lib/VCL/Tocsg.Process.pas

1979 lines
56 KiB
Plaintext

{*******************************************************}
{ }
{ 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<ULONGLONG>;
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<PProcessEntInfo>)
private
bDetailInfo_: Boolean;
DcProcInfo_: TDictionary<DWORD,PProcessEntInfo>;
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<DWORD,PPwEnt>;
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<DWORD,PProcessEntInfo>.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<PProcessEntInfo>;
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<PProcessEntInfo>;
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<TProcessEntInfo>(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<PPwEnt>;
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
OutputDebugString(Pchar(Format('[MGKIM] TerminateProcess .. OpenProcess fail : %d, %d', [dwPid, GetLastError])));
// 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);
OutputDebugString(Pchar(Format('[MGKIM] TerminateProcessByPid .. taskkill : %s', [sData])));
// end;
exit;
end
else
begin
try
Result := TerminateProcess(hProcess, 0);
if not Result then
OutputDebugString(Pchar(Format('[MGKIM] TerminateProcess .. fail : %d', [GetLastError])));
finally
CloseHandle(hProcess);
end;
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
begin
OutputDebugString(Pchar(Format('[MGKIM] TerminateProcessByName .. CreateToolhelp32Snapshot fail : %d', [GetLastError])));
exit;
end;
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.