Как получить активные процессы но компьютере, через Delphi? а именно их названия?
Из Drkb:
Вот недавно делал лабу, тут еще добавление в БД, можно удалить
procedure TfrmProcList.btnGetProcListClick(Sender: TObject);
var
N: DWORD;
i, Module: Byte;
_HANDLE: THandle;
Error: PChar;
s: array [byte] of Char;
ModuleID:array[1..1] of dword;
ProcessID:array[byte] of dword;
ProcName, UserName: String;
currentTime: TTime;
begin
M.Lines.Clear;
try
EnumProcesses(@ProcessID, 255, N);
except on E: Exception do begin
MessageDlg('Не удалось получить список процессов', mtError, [mbOk], 0);
Abort;
end;
end;
N := SizeOf(ProcessID) div SizeOf(DWORD);
FillChar(s, SizeOf(s), #0);
UserName := GetUserFromWindows;
currentTime := Now;
tblUser.Append;
tblUser.FieldByName('U_Name').AsString := UserName;
tblUser.FieldByName('U_Time').AsDateTime := currentTime;
tblUser.Post;
tblProc.MasterSource := dsUser;
tblProc.IndexName := 'idxP_UID';
for i := 0 to pred(N) do try
_HANDLE := OpenProcess(PROCESS_QUERY_INFORMATION+PROCESS_VM_READ
+SYNCHRONIZE, false, ProcessID[i]);
if _HANDLE > 0 then begin
EnumProcessModules(_HANDLE, @ModuleID, 4, N);
Module := GetModuleFileNameEx(_HANDLE, ModuleID[1], @s, SizeOf(s));
if Module > 0 then begin
ProcName := ExtractFileName(s);
if (edtMask.Text = '') or (Pos(edtMask.Text, ProcName) <> 0) then
M.Lines.Add(Format('%s : %d', [ ProcName , ProcessID[i] ]));
tblProc.Append;
tblProc.FieldByName('P_ProcName').AsString := ProcName;
tblProc.FieldByName('P_ProcID').AsInteger := ProcessID[i];
tblProc.Post;
end;
end;
CloseHandle(_Handle);
except on E: Exception do MessageDlg('Ошибка при обработке процесса: ' + E.Message, mtError, [mbOk], 0);
end;
end;
M.Lines.Add(Format('%s : %d', [ ProcName , ProcessID[i] ])); // M - Мемо
klem4, а ты не мог бы весь код приложить? Просто что-то скомпилить не могу
Если поможет, могу рассказать, как добраться до названий закладок (Tab-ов) в браузере Опера.
Volvo, очень поможет, буду благодарен. А как добраться до названия закладок в FireFox и названия окна IE, случайно не знаешь?
Но даже за оперу буду очень благодарен.
Положи на форму TreeView, кнопку, и на OnClick кнопки вызывай вот это:
procedure TForm1.Sys_Windows_Tree(Node: TTreeNode;© Rouse_
AHandle: HWND; ALevel: Integer);
type
TRootNodeData = record
Node: TTreeNode;
PID: Cardinal;
end;
var
szClassName, szCaption, szLayoutName: array[0..MAXCHAR - 1] of Char;
szFileName : array[0..MAX_PATH - 1] of Char;
Result: String;
PID, TID: Cardinal;
I: Integer;
RootItems: array of TRootNodeData;
IsNew: Boolean;
begin
while AHandle <> 0 do begin
GetClassName(AHandle, szClassName, MAXCHAR);
GetWindowText(AHandle, szCaption, MAXCHAR);
if GetWindowModuleFilename(AHandle, szFileName, SizeOf(szFileName)) = 0 then
FillChar(szFileName, 256, #0);
TID := GetWindowThreadProcessId(AHandle, PID);
AttachThreadInput(GetCurrentThreadId, TID, True);
VerLanguageName(GetKeyboardLayout(TID) and $FFFF, szLayoutName, MAXCHAR);
AttachThreadInput(GetCurrentThreadId, TID, False);
Result := Format('%s [%s] Caption = %s, Handle = %d, Layout = %s',
[String(szClassName), String(szFileName), String(szCaption),
AHandle, String(szLayoutName)]);
if ALevel in [0..1] then begin
IsNew := True;
for I := 0 to Length(RootItems) - 1 do
if RootItems[I].PID = PID then begin
Node := RootItems[I].Node;
IsNew := False;
Break;
end;
if IsNew then begin
SetLength(RootItems, Length(RootItems) + 1);
RootItems[Length(RootItems) - 1].PID := PID;
RootItems[Length(RootItems) - 1].Node :=
TreeView1.Items.AddChild(nil, 'PID: ' + IntToStr(PID));
Node := RootItems[Length(RootItems) - 1].Node;
end;
end;
Sys_Windows_Tree(TreeView1.Items.AddChild(Node, Result),
GetWindow(AHandle, GW_CHILD), ALevel + 1);
AHandle := GetNextWindow(AHandle, GW_HWNDNEXT);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Sys_Windows_Tree(nil, GetDesktopWindow, 0);
end;
Спасибо, помог. Буду дальше эксперементировать.