急急急,关于获取别的进程的EProcess

CCC的 2012-08-21 11:03:15
代码如下,如果是获取当前进程的已经可以实现,但是获取别的进程的跟XueTr里面不一致,请教
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, jwaNative, JwaWinType, ComCtrls, TLHelp32;

type
TForm1 = class(TForm)
Button1: TButton;
ListBox1: TListBox;
Memo1: TMemo;
Edit1: TEdit;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
procedure GetEProcess(pid: Cardinal);
public
{ Public declarations }
end;

TProcessInfo=Record
ExeFileName:String;
ProcessID:DWord;
end;

TQuerySystemInformation = class
private
fSysInfo : PVOID;
fSysInfoClass : SYSTEM_INFORMATION_CLASS;
procedure SetSysInfoClass(aVal: SYSTEM_INFORMATION_CLASS);
public
constructor Create;
destructor Destroy; override;
function RefreshSysInfo:PVOID;

property SysInfo : PVOID read fSysInfo;
property SysInfoClass : SYSTEM_INFORMATION_CLASS read fSysInfoClass write SetSysInfoClass;
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

{ TQuerySystemInformation }

{******************************************************************************}
constructor TQuerySystemInformation.Create;
begin
fSysInfoClass:=SystemBasicInformation;
end;

{******************************************************************************}
destructor TQuerySystemInformation.Destroy;
begin
ReallocMem (fSysInfo, 0);
inherited;
end;

{******************************************************************************}
function TQuerySystemInformation.RefreshSysInfo: PVOID;
const
STATUS_INFO_LENGTH_MISMATCH = NTSTATUS($C0000004);
var
rs,res : ULONG;
rv:NTSTATUS;
d:dword ; //fuck delphi
begin
rs := $10000;

repeat
ReallocMem (fSysInfo, rs);
rv := NtQuerySystemInformation (fSysInfoClass, fSysInfo, rs, @res);
rs := rs * 2;
until rv <> STATUS_INFO_LENGTH_MISMATCH;

if rv <> 0 then
begin
ReallocMem (fSysInfo, 0);
RaiseLastOSError
end;

Result := fSysInfo;
end;

{******************************************************************************}
procedure TQuerySystemInformation.SetSysInfoClass(aVal: SYSTEM_INFORMATION_CLASS);
begin
if aVal <> fSysInfoClass then
begin
fSysInfoClass := aVal;
RefreshSysInfo;
end;
end;

procedure TForm1.GetEProcess(pid: Cardinal);
type
HANDLE_INFORMATION = record
count : ULONG;
Handles : array [0..0] of SYSTEM_HANDLE_INFORMATION;
end;
var
FQuery : TQuerySystemInformation;
Info: ^HANDLE_INFORMATION;
I:integer;
hProcess, CPID: THandle;
begin
FQuery := TQuerySystemInformation.Create ;
FQuery.SysInfoClass := SystemHandleInformation;
FQuery.RefreshSysInfo ;
Info := FQuery.SysInfo ;
//EnableDebugPrivilege;
//hProcess := OpenProcess(PROCESS_QUERY_INFORMATION, TRUE, pid);
//CPID := GetCurrentProcessId;
for i:=0 to Info.count -1 do
begin
//采用Button1Click事件中注释部分可以取得EProcess
if (Info.Handles[i].ProcessId = pid) and (Info.Handles[i].ObjectTypeNumber = 5) then
begin
ListBox1.Items.Add( intTohex(Cardinal(Info.Handles[i].Object_ ),8));
Break;
end;
end;
FQuery.Free;
end;

function EnableDebugPrivilege: Boolean;
function EnablePrivilege(hToken: Cardinal; PrivName: string; bEnable: Boolean): Boolean;
var
TP: TOKEN_PRIVILEGES;
Dummy: Cardinal;
begin
TP.PrivilegeCount := 1;
LookupPrivilegevalue(nil, pchar(PrivName), TP.Privileges[0].Luid);
if bEnable then
TP.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED
else TP.Privileges[0].Attributes := 0;
AdjustTokenPrivileges(hToken, False, TP, SizeOf(TP), nil, Dummy);
Result := GetLastError = ERROR_SUCCESS;
end;
var
hToken: Cardinal;
begin
OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES, hToken);
//if EnablePrivilege(hToken, 'SeDebugPrivilege', True) then ShowMessage('OK');
EnablePrivilege(hToken, 'SeDebugPrivilege', True);
CloseHandle(hToken);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
p:TProcessInfo;
OK:Bool;
ProcessListHandle:THandle;
ProcessStruct:TProcessEntry32;
begin
EnableDebugPrivilege;
ProcessListHandle:=CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS,0);
ProcessStruct.dwSize:=SizeOf(ProcessStruct);
OK:=Process32First(ProcessListHandle,ProcessStruct);
while Integer(OK) <> 0 do
begin
p.ExeFileName:=ProcessStruct.szExeFile;
// if p.ExeFileName = 'Project1.exe' then
// begin
// //采用下面方式可以取得本进程的EProcess是正确的
// OpenProcess( PROCESS_ALL_ACCESS,FALSE,GetCurrentProcessId);
// GetEProcess(DWORD(GetCurrentProcessId));
// Break;
// end;
OK:=Process32Next(ProcessListHandle,ProcessStruct);
memo1.lines.add(p.ExeFileName);
end;
closehandle(ProcessListHandle);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
//这样就不行
GetEProcess(DWORD(EDIT1.TEXT));
end;

end.
...全文
272 4 打赏 收藏 转发到动态 举报
写回复
用AI写文章
4 条回复
切换为时间正序
请发表友善的回复…
发表回复
CCC的 2012-08-22
  • 打赏
  • 举报
回复
恩,本来找了楼上贴出链接的代码,但是运行了几次都通不过,结合原来的代码找到问题所在,现在可以了,结贴
hsfzxjy 2012-08-22
  • 打赏
  • 举报
回复
太深奥了。。
CCC的 2012-08-22
  • 打赏
  • 举报
回复
莫有人知道啵

1,183

社区成员

发帖
与我相关
我的任务
社区描述
Delphi Windows SDK/API
社区管理员
  • Windows SDK/API社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧