Так, есть зацепка: http://msdn2.microsoft.com/en-us/library/ms683237.aspx
Делаю так:| Код |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, TLHelp32;
type
TForm1 = class(TForm)
Button1: TButton;
ListBox1: TListBox;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
procedure LoadProcessID(Str:TStrings);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
const
THREAD_SUSPEND_RESUME = $00000002;
function OpenThread(dwDesiredAccess: DWord; bInheritHandle: Bool; dwThreadId: DWord): DWord; stdcall; external 'kernel32.dll';
{$R *.dfm}
function FileTimeToDateTime(ftFileTime : _FILETIME):TDateTime;
var
SysTime : _SYSTEMTIME;
begin
FileTimeToLocalFileTime(ftFileTime,ftFileTime);
FileTimeToSystemTime(ftFileTime, SysTime);
Result := EncodeDate(SysTime.wYear, SysTime.wMonth, SysTime.wDay)+
EncodeTime(SysTime.wHour, SysTime.wMinute, SysTime.wSecond, SysTime.wMilliseconds);
end;
function NTSetPrivilege(sPrivilege: string; bEnabled: Boolean): Boolean;
var
hToken: THandle;
TokenPriv: TOKEN_PRIVILEGES;
PrevTokenPriv: TOKEN_PRIVILEGES;
ReturnLength: Cardinal;
begin
Result := True;
// Only for Windows NT/2000/XP and later.
if not (Win32Platform = VER_PLATFORM_WIN32_NT) then Exit;
Result := False;
// obtain the processes token
if OpenProcessToken(GetCurrentProcess(),
TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then
begin
try
// Get the locally unique identifier (LUID) .
if LookupPrivilegeValue(nil, PChar(sPrivilege),
TokenPriv.Privileges[0].Luid) then
begin
TokenPriv.PrivilegeCount := 1; // one privilege to set
case bEnabled of
True: TokenPriv.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
False: TokenPriv.Privileges[0].Attributes := 0;
end;
ReturnLength := 0; // replaces a var parameter
PrevTokenPriv := TokenPriv;
// enable or disable the privilege
AdjustTokenPrivileges(hToken, False, TokenPriv, SizeOf(PrevTokenPriv),
PrevTokenPriv, ReturnLength);
end;
finally
CloseHandle(hToken);
end;
end;
// test the return value of AdjustTokenPrivileges.
Result := GetLastError = ERROR_SUCCESS;
if not Result then
raise Exception.Create(SysErrorMessage(GetLastError));
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Listbox1.Items.Clear;
LoadProcessID(ListBox1.Items);
end;
procedure TForm1.LoadProcessID(Str: TStrings);
var
HProcess, H: THandle;
Process32: TProcessEntry32;
Next: BOOL;
HThread: THandle;
Thread32: TThreadEntry32;
Next2: BOOL;
i: Integer;
TempS: String;
tm1, tm2, tm3, tm4: TFileTime;
begin
Process32.dwSize:=SizeOf(TProcessEntry32);
HProcess:=CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS,0);
Thread32.dwSize:=SizeOf(TThreadEntry32);
HThread:=CreateToolHelp32Snapshot(TH32CS_SNAPTHREAD,0);
if not (Process32First(HProcess,Process32) and Thread32First(HThread,Thread32)) then
begin
ShowMessage('Error Operation!');
Exit;
end;
Repeat
TempS:='Èìÿ ïðîöåññà: '+String(Process32.szExeFile)+' - PID: '+IntToStr(Process32.th32ProcessID);
Str.Add(TempS);
i:=0;
Repeat
if Thread32.th32OwnerProcessID=Process32.th32ProcessID then
begin
Inc(i);
NTSetPrivilege('SeDebugPrivilege', True);
H := OpenThread(THREAD_SUSPEND_RESUME, False, Thread32.th32ThreadID);
if H = 0 then
ShowMessage(SysErrorMessage(GetLastError));
GetThreadTimes(H, tm1, tm2, tm3, tm4);
TempS:=' Ïîòîê'+IntToStr(i)+' - TID: '+IntToStr(Thread32.th32ThreadID) + ' time=' + TimeToStr(FileTimeToDateTime(tm3));
Str.Add(TempS);
end;
Next2:=Thread32Next(HThread,Thread32);
Until not Next2;
Thread32First(HThread,Thread32);
Next:=Process32Next(HProcess,Process32);
Until not Next;
CloseHandle(HThread);
CloseHandle(HProcess);
end;
end.
|
К сожалению tm1, tm2, tm3, tm4 для всех(!!!) потоков одинаковы. Почему??? |
