如果想高提高Delphi的技术进程相关操作显然是避不开的;
进程函数: 根据程序名(全路径)获得进程ID(PID)
/// <summary>
/// 根据程序名(全路径)获得进程ID(PID)
/// </summary>
/// <param name="APName">程序完整路径+文件名</param>
/// <returns></returns>
function GetPIDByProgramName(const APName: string): THandle;
var
isFound: boolean;
AHandle, AhProcess: THandle;
ProcessEntry32: TProcessEntry32;
APath: array[0..MAX_PATH] of char;
begin
try
Result := 0;
AHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
ProcessEntry32.dwSize := Sizeof(ProcessEntry32);
isFound := Process32First(AHandle, ProcessEntry32);
while isFound do
begin
AhProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ,
false, ProcessEntry32.th32ProcessID);
GetModuleFileNameEx(AhProcess, 0, @APath[0], sizeof(APath));
if (UpperCase(StrPas(APath)) = UpperCase(APName)) or
(UpperCase(StrPas(ProcessEntry32.szExeFile)) = UpperCase(APName)) then
begin
Result := ProcessEntry32.th32ProcessID;
break;
end;
isFound := Process32Next(AHandle, ProcessEntry32);
CloseHandle(AhProcess);
end;
finally
CloseHandle(AHandle);
end;
end;
进程函数: 获得CPU使用率
/// <summary>
/// 获得CPU使用率
/// </summary>
/// <param name="PID">进程PID</param>
/// <returns></returns>
function GetCpuUsage(PID: cardinal): single;
const
cWaitTime = 200;
var
h: Cardinal;
mCreationTime, mExitTime, mKernelTime, mUserTime: _FILETIME;
TotalTime1, TotalTime2: int64;
begin
Result := -1;
{We need to get a handle of the process with PROCESS_QUERY_INFORMATION privileges.}
h := OpenProcess(PROCESS_QUERY_INFORMATION, false, PID);
try
{We can use the GetProcessTimes() function to get the amount of time the process has spent in kernel mode and user mode.}
GetProcessTimes(h, mCreationTime, mExitTime, mKernelTime, mUserTime);
TotalTime1 := int64(mKernelTime.dwLowDateTime or (mKernelTime.dwHighDateTime shr 32)) + int64(mUserTime.dwLowDateTime or (mUserTime.dwHighDateTime shr 32));
{Wait a little}
Sleep(cWaitTime);
GetProcessTimes(h, mCreationTime, mExitTime, mKernelTime, mUserTime); TotalTime2 := int64(mKernelTime.dwLowDateTime or (mKernelTime.dwHighDateTime shr 32)) +
int64(mUserTime.dwLowDateTime or (mUserTime.dwHighDateTime shr 32));
{This should work out nicely, as there were approx. 250 ms between the calls
and the result will be a percentage between 0 and 100}
Result := ((TotalTime2 - TotalTime1) / cWaitTime) / 100;
finally
CloseHandle(h);
end;
end;
引用到两个单元
Uses TlHelp32, PsAPI;
这里有一些隐含用途,比如:
1、查询某个程序是否在使用,判断GetPIDByProgramName返回的PID是否大于零。
2、根据CPU使用率大小决定是否终止程序。频频使用这个函数时候,建议最好用一个Thread Timer执行,
可减低TTimer带来的CPU使用率。
暴力保护进程思路
program SmallExe;
uses
SysUtils,
Windows,
tlhelp32;
type
TWin = record
Msg:TMsg;
wClass:TWndClass;
hMain:integer;
end;
var
Win:TWin;
Msg: TMsg;
type
TDbgUiDebugActiveProcess = function(ProcessHandle: THANDLE): Cardinal; stdcall;
TDbgUiConnectToDbg = function:Cardinal; stdcall;
function findprocess(TheProcName: string): DWORD;
var
isOK: Boolean;
ProcessHandle: Thandle;
ProcessStruct: TProcessEntry32;
begin
ProcessHandle := createtoolhelp32snapshot(Th32cs_snapprocess, 0);
processStruct.dwSize := sizeof(ProcessStruct);
isOK := process32first(ProcessHandle, ProcessStruct);
Result := 0;
while isOK do
begin
if Trim(UpperCase(TheProcName)) = Trim(UpperCase(ProcessStruct.szExeFile)) then
begin
Result := ProcessStruct.th32ProcessID;
CloseHandle(ProcessHandle);
exit;
end;
isOK := process32next(ProcessHandle, ProcessStruct);
end;
CloseHandle(ProcessHandle);
end;
procedure SetPrivilege;
var
TPPrev, TP: TTokenPrivileges;
TokenHandle: THandle;
dwRetLen: DWORD;
lpLuid: TLargeInteger;
begin
OpenProcessToken(GetCurrentProcess, TOKEN_ALL_ACCESS, TokenHandle);
if (LookupPrivilegeValue(nil, 'SeDebugPrivilege', lpLuid)) then
begin
TP.PrivilegeCount := 1;
TP.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
TP.Privileges[0].Luid := lpLuid;
AdjustTokenPrivileges(TokenHandle, False, TP, SizeOf(TPPrev), TPPrev, dwRetLen);
end;
CloseHandle(TokenHandle);
end;
procedure protectme;
var
MyDbgUiDebugActiveProcess: TDbgUiDebugActiveProcess;
MyDbgUiConnectToDbg: TDbgUiConnectToDbg;
dllhandle: dword;
dwret:dword;
ProcessHandle: dword;
begin
dllhandle := L