得到了所有的进程名,并且得到他的全路进

Black爷 2003-01-09 12:34:20
谢谢了
...全文
61 7 打赏 收藏 转发到动态 举报
写回复
用AI写文章
7 条回复
切换为时间正序
请发表友善的回复…
发表回复
zsy_good 2003-01-23
  • 打赏
  • 举报
回复
function GetWin98ProcInfo(info: string): DWORD;
var
PE: TProcessEntry32;
PPE: PProcessEntry32;
ProcList: TList;
FSnap: integer;
begin
ProcList := TList.Create;
ProcList.Clear;
if FSnap > 0 then CloseHandle(FSnap);
FSnap := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS, 0);
if FSnap = INVALID_HANDLE_VALUE then
raise Exception.Create('CreateToolHelp32Snapshot failed');
PE.dwSize := SizeOf(PE);
if Process32First(FSnap, PE) then // get process
repeat
New(PPE); // create new PPE
PPE^ := PE; // fill it
ProcList.Add(PPE); // add it to list
if ReadInfo(PE.szExeFile,Info) then
begin
result := PE.th32ProcessID;
end;
until not Process32Next(FSnap, PE); // get next process
end;
zsy_good 2003-01-23
  • 打赏
  • 举报
回复
function GetWinNTProcInfo(info: string): DWORD;
var
Count: DWORD;
BigArray: array[0..$3FFF - 1] of DWORD;
ProcList: array of DWORD;
I: integer;
ProcHand: THandle;
ModHand: HModule;
ModName: array[0..MAX_PATH] of char;
ExitCode: DWORD;
begin
result := 0;
if not EnumProcesses(@BigArray, SizeOf(BigArray), Count) then exit;
SetLength(ProcList, Count div SizeOf(DWORD));
Move(BigArray, ProcList[0], Count);
for I := Low(ProcList) to High(ProcList) do
begin
ProcHand := OpenProcess(PROCESS_ALL_ACCESS, False,ProcList[I]);
if ProcHand > 0 then
try
form1.ListBox2.Items.Add(inttostr(ProcList[i]));
ModHand := 0;
EnumProcessModules(Prochand, @ModHand, 1, Count);
if GetModuleFileNameEx(ProcHand,ModHand, ModName, 255) > 0 then
begin
form1.ListBox1.items.Add(Modname);
if ReadInfo(ModName,Info) then
begin
result := ProcList[I];
exit;
end;
end;
finally
CloseHandle(ProcHand);
end;
end;
end;
diruser 2003-01-22
  • 打赏
  • 举报
回复
up
windstrom 2003-01-22
  • 打赏
  • 举报
回复
(注意uses TLHelp32)
然后
var lppe: TProcessEntry32;
found : boolean;
Hand : THandle;
begin
Hand := CreateToolhelp32Snapshot(TH32CS_SNAPALL,0);
found := Process32First(Hand,lppe);
while found do
begin
ListBox.Items.Add(StrPas(lppe.szExeFile));//列出所有进程。
found := Process32Next(Hand,lppe);
end;
end;

/////////////////////////////////////////////////////
uses ... TLHelp32, ...

type
TForm1 = class(TForm)
...
end;

var
Form1: TForm1;
l : Tlist; ////返回的东东在"L"这个TList中。

type
TProcessInfo = Record
ExeFile : String;
ProcessID : DWORD;
end;
pProcessInfo = ^TProcessInfo;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
var p : pProcessInfo;
i : integer;
ContinueLoop:BOOL;
var
FSnapshotHandle:THandle;
FProcessEntry32:TProcessEntry32;
begin
l := TList.Create;
l.Clear;
FSnapshotHandle:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
FProcessEntry32.dwSize:=Sizeof(FProcessEntry32);
ContinueLoop:=Process32First(FSnapshotHandle,FProcessEntry32);
while integer(ContinueLoop)<>0 do
begin
New(p);
p.ExeFile := FProcessEntry32.szExeFile;
p.ProcessID := FProcessEntry32.th32ProcessID;
l.Add(p);
ContinueLoop:=Process32Next(FSnapshotHandle,FProcessEntry32);
end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
var p : pProcessInfo;
i : integer;
begin
With l do
for i := Count - 1 DownTo 0 do
begin p := items[i]; Dispose(p); Delete(i); end;
end;

...
end.

Billy_Chen28 2003-01-22
  • 打赏
  • 举报
回复
function Kill_By_Pid(pid: Longint): Integer;
var
hProcess: THandle;
TermSucc: BOOL;
begin
hProcess := OpenProcess(PROCESS_ALL_ACCESS, True, pid);
if (hProcess = 0) then // v 1.2 : was =-1
begin
Result := KILL_ERR_OPENPROCESS;
end
else
begin
TermSucc := TerminateProcess(hProcess, 0);
if (TermSucc = False) then
Result := KILL_ERR_TERMINATEPROCESS
else
Result := KILL_NOERR;
end;
end;

procedure UpdateTreeView(Tree: TTreeView);
var
I: Integer;
MyNode: TTreeNode;
begin
with Tree.Items do
begin
Clear;
if MyNode <> nil then
MyNode := nil;

for I := 0 to FullNameList.Count - 1 do
begin
if (MyNode = nil) or (UpperCase(Copy(FullNameList[I], Length(FullNameList[I]) - 2, 3)) = 'EXE') then
MyNode := Add(nil, FullNameList[I])
else
AddChild(MyNode, FullNameList[I]);
end;
end;
end;

procedure PrintProcessNameAndID(ProcessId: DWORD);
var
// szProcessName:ARRAY[0..1024] OF CHAR;
szFullName: array[0..1024] of Char;
szModName: array[0..1024] of Char;
hProcess: THandle;
hMods: array[0..1024] of DWORD;
cbNeeded, cMod: DWORD;
I: Integer;
begin
// Get a handle to the process.
hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or
PROCESS_VM_READ,
False, ProcessId);
// Get the process name.
szModName := 'unknown';
szFullName := 'unknown';
if (hProcess <> 0) then
begin
if EnumProcessModules(hProcess, DWORD(@hMods), SizeOf(hMods), DWORD(@cbNeeded)) <> 0 then
begin
// GetModuleBaseNameA( hProcess, hMod, szProcessName,sizeof(szProcessName) );
// GetModuleFileNameExA(hProcess, hMod, szFullName,sizeof(szFullName));
cMod := cbNeeded div SizeOf(HMODULE);
for I := 0 to (cMod - 1) do
begin
// Get the full path to the module's file.
GetModuleBaseNameA(hProcess, hMods[I], szModName, SizeOf(szModName));
GetModuleFileNameExA(hProcess, hMods[I], szFullName, SizeOf(szModName));
ProcessNameList.Add(StrPas(szModName));
FullNameList.Add(StrPas(szFullName));
end;
end;
end;

// Print the process name and identifier.

//Form1.Memo1.Lines.Add (StrPas(szProcessName));
// ProcessNameList.Add (StrPas(szProcessName));
// FullNameList.Add (StrPas(szFullName));

CloseHandle(hProcess);

end;

procedure TFormMain.Button1Click(Sender: TObject);
var
cbNeeded, cProcesses: DWORD;
aProcesses: array[0..1024] of DWORD;
I: Cardinal;
begin
if EnumProcesses(DWORD(@aProcesses), SizeOf(aProcesses), DWORD(@cbNeeded)) <> 0 then
begin
cProcesses := cbNeeded div SizeOf(DWORD);
end
else
showmessage(IntToStr(GetLastError));

if ProcessIDList <> nil then
processidlist.Clear
else
ProcessIDList := TStringList.Create;

if ProcessNameList <> nil then
ProcessNameList.Clear
else
ProcessNameList := TStringList.Create;

if FullNameList <> nil then
FullNameList.Clear
else
FullNameList := TStringList.Create;

for I := 0 to cprocesses - 1 do
processidlist.Add(IntToStr(aProcesses[I]));

for I := 0 to cProcesses - 1 do
begin
PrintProcessNameAndID(StrToInt(ProcessIDList[I]));
end;
// Memo1.lines:=ProcessNameList;
UpdateTreeView(FormMain.TreeView1);
end;

procedure TFormMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if ProcessIDList <> nil then
ProcessIDList.Free;
if ProcessNameList <> nil then
ProcessNameList.Free;
if FullNameList <> nil then
FullNameList.Free;
end;

procedure TFormMain.TreeView1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
MyNode: TTreeNode;
begin
MyNode := TreeView1.GetNodeAt(X, Y);
if MyNode <> nil then
begin
MyNode.Selected := True;
if MyNode.HasChildren then
begin
Caption := '[' + ProcessIDList[MyNode.Index] + ']' + FullNameList[MyNode.AbsoluteIndex];
GetTokenInfo(StrToInt(ProcessIDList[MyNode.Index]));
end
else
Caption := FullNameList[MyNode.AbsoluteIndex];
end;
end;

procedure TFormMain.TreeView1DblClick(Sender: TObject);
var
MyNode: TTreeNode;
begin
MyNode := TreeView1.Selected;
if (MyNode <> nil) and (MyNode.HasChildren) then
begin
showmessage(IntToStr(Kill_By_Pid(StrToInt(ProcessIDList[MyNode.Index]))));
end;

end;

procedure TFormMain.FormCreate(Sender: TObject);
begin
EnableDebugPrivilegeNT;
end;

procedure TFormMain.Button2Click(Sender: TObject);
var
S: string;
P: PChar;
begin
P := StrAlloc(128);
StrCopy(P, 'aa');
//p:='aaa';
S := StrPas(P);
showmessage(S);

StrDispose(P);
end;

end.
Billy_Chen28 2003-01-22
  • 打赏
  • 举报
回复
给你一个完整的例子:
unit Main;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ComCtrls;

type
TFormMain = class(TForm)
Button1: TButton;
TreeView1: TTreeView;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure TreeView1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure TreeView1DblClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }

public
{ Public declarations }
end;

var
FormMain: TFormMain;

implementation

{$R *.DFM}
const
KILL_NOERR = 0;
KILL_NOTSUPPORTED = -1;
KILL_ERR_OPENPROCESS = -2;
KILL_ERR_TERMINATEPROCESS = -3;

ENUM_NOERR = 0;
ENUM_NOTSUPPORTED = -1;
ENUM_ERR_OPENPROCESSTOKEN = -2;
ENUM_ERR_LookupPrivilegeValue = -3;
ENUM_ERR_AdjustTokenPrivileges = -4;

SE_DEBUG_NAME = 'SeDebugPrivilege';

var
ProcessNameList, ProcessIDList, FullNameList: TStrings;

function EnumProcesses(lpidProcess, cb, cbNeeded: DWORD):
Integer; stdcall; external 'PSAPI.DLL';

function EnumProcessModules(hProcess: THandle; lphModule: HMODULE; cb, lpcbNeeded: DWORD):
Integer; stdcall; external 'PSAPI.DLL';

function GetModuleBaseNameA(hProcess: THandle; HMODULE: HMODULE; lpBaseName: PChar; nSize: DWORD):
Integer; stdcall; external 'PSAPI.DLL';

function GetModuleFileNameExA(hProcess: THandle; HMODULE: HMODULE; lpFileName: PChar; nSize: DWORD):
Integer; stdcall; external 'PSAPI.DLL';

procedure ErrorMessage;
var
MsgBuf: string;
begin
FormatMessage(
FORMAT_MESSAGE_ALLOCATE_BUFFER or
FORMAT_MESSAGE_FROM_SYSTEM or
FORMAT_MESSAGE_IGNORE_INSERTS,
nil,
GetLastError(),
LANG_NEUTRAL, //MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), // Default language
@MsgBuf,
SizeOf(MsgBuf),
nil
);
MessageBox(0, PChar(MsgBuf), '错误', MB_OK);
raise EAbort.Create('');
end;

procedure GetTokenInfo(ProcessId: THandle);
var
InfoBuffer: TTokenPrivileges;
I: Integer;
ucPrivilegeName: string;
dwPrivilegeNameSize, dwInfoBufferSize: DWORD;
PrivilegesList: TStrings;
hToken, hProcess: THandle;
S: string;
P: PChar;
begin
Exit;
//get process handle from process id
hProcess := OpenProcess(PROCESS_ALL_ACCESS,
True, ProcessId);
try
if hProcess = 0 then
ErrorMessage;
//get token handle from process handle
if not OpenProcessToken(hProcess,
TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY or TOKEN_READ, hToken) then
begin
ErrorMessage;
end;

dwInfoBufferSize := 0;
if not GetTokenInformation(hToken, TokenPrivileges, @InfoBuffer,
1024 {SizeOf(TTokenPrivileges)}, dwInfoBufferSize) then
begin
ErrorMessage;
end;

dwPrivilegeNameSize := 255;
SetLength(ucPrivilegeName, 255);
// for I := 0 to InfoBuffer.PrivilegeCount - 1 do
begin
if LookupPrivilegeName(nil, InfoBuffer.Privileges[0].Luid,
PChar(ucPrivilegeName), dwPrivilegeNameSize) then
ShowMessage(Copy(ucPrivilegeName, 1, dwPrivilegeNameSize))
else
ErrorMessage;
end;
finally
CloseHandle(hProcess);
end;
end;

function EnableDebugPrivilegeNT: Integer;
var
hToken: THandle;
DebugValue: TLargeInteger;
tkp: TTokenPrivileges;
ReturnLength: DWORD;
PreviousState: TTokenPrivileges;
begin
if (OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY or TOKEN_READ, hToken) = False) then
Result := ENUM_ERR_OPENPROCESSTOKEN
else
begin
if (LookupPrivilegeValue(nil, SE_DEBUG_NAME, DebugValue) = False) then
Result := ENUM_ERR_LookupPrivilegeValue
else
begin
ReturnLength := 0;
tkp.PrivilegeCount := 1;
tkp.Privileges[0].Luid := DebugValue;
tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
AdjustTokenPrivileges(hToken, False, tkp, SizeOf(TTokenPrivileges), PreviousState, ReturnLength);
if (GetLastError <> ERROR_SUCCESS) then
Result := ENUM_ERR_AdjustTokenPrivileges
else
Result := ENUM_NOERR;
end;
end;
end;


bluemeteor 2003-01-22
  • 打赏
  • 举报
回复
转帖 进程列表
(注意uses TLHelp32)
然后
var lppe: TProcessEntry32;
found : boolean;
Hand : THandle;
begin
Hand := CreateToolhelp32Snapshot(TH32CS_SNAPALL,0);
found := Process32First(Hand,lppe);
while found do
begin
ListBox.Items.Add(StrPas(lppe.szExeFile));//列出所有进程。
found := Process32Next(Hand,lppe);
end;
end;

/////////////////////////////////////////////////////
uses ... TLHelp32, ...

type
TForm1 = class(TForm)
...
end;

var
Form1: TForm1;
l : Tlist; ////返回的东东在"L"这个TList中。

type
TProcessInfo = Record
ExeFile : String;
ProcessID : DWORD;
end;
pProcessInfo = ^TProcessInfo;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
var p : pProcessInfo;
i : integer;
ContinueLoop:BOOL;
var
FSnapshotHandle:THandle;
FProcessEntry32:TProcessEntry32;
begin
l := TList.Create;
l.Clear;
FSnapshotHandle:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
FProcessEntry32.dwSize:=Sizeof(FProcessEntry32);
ContinueLoop:=Process32First(FSnapshotHandle,FProcessEntry32);
while integer(ContinueLoop)<>0 do
begin
New(p);
p.ExeFile := FProcessEntry32.szExeFile;
p.ProcessID := FProcessEntry32.th32ProcessID;
l.Add(p);
ContinueLoop:=Process32Next(FSnapshotHandle,FProcessEntry32);
end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
var p : pProcessInfo;
i : integer;
begin
With l do
for i := Count - 1 DownTo 0 do
begin p := items[i]; Dispose(p); Delete(i); end;
end;

...
end.

5,388

社区成员

发帖
与我相关
我的任务
社区描述
Delphi 开发及应用
社区管理员
  • VCL组件开发及应用社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

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