Форум «Всё о Паскале» _ Делфи _ Как определить откуда был запущен процесс?
Автор: Snake_B 7.08.2008 21:14
type TModuleArray = array of TModuleEntry32;
.............
function GetModulesListByProcessId(ProcessId : Cardinal) : TModuleArray; var hSnapshot : THandle; lpme : TModuleEntry32; procedure AddModuleToList; begin SetLength(Result,High(Result)+2); Result[high(Result)]:=lpme; end; begin SetLength(Result,0); hSnapshot:=CreateToolhelp32Snapshot(TH32CS_SNAPMODULE,ProcessId); if hSnapshot=-1 then RaiseLastWin32Error; lpme.dwSize:=SizeOf(lpme); if Module32First(hSnapshot,lpme) then begin AddModuleToList; while Module32Next(hSnapshot,lpme) do AddModuleToList; end; end;
function GetWindowPatch(Wnd: hWnd): string; // Нахождение пути к ехе по заголовку окна... var i: integer; modarr : TModuleArray; Pid: Cardinal; begin result:='Null'; GetWindowThreadProcessId(Wnd,@Pid); modarr:=GetModulesListByProcessId(Pid); result:='Null'; for i:=0 to High(modarr) do begin if Integer(modarr[i].modBaseAddr)=$400000 then begin result:=modarr[i].szExePath; break; end; end; end;
procedure TFormWinHide.SearchWindow; // Поиск окон... VAR searchTm: boolean; searchTmInt, i, OldWC, OldWCH: integer; name, TmpStr, Str: string; Tmp: TMenuItem; Wnd: hWnd; buff: ARRAY [0..127] OF Char; begin OldWC:=WinCount; WinCount:=0; OldWCH:=WinCountH; WinCountH:=0; // Считаем количество окон.. Wnd:= GetWindow(Handle, gw_HWndFirst); WHILE Wnd <> 0 DO BEGIN IF (Wnd <> Application.Handle) THEN BEGIN if IsWindowVisible(Wnd) then begin GetWindowText(Wnd, buff, sizeof(buff)); TmpStr:=StrPas(buff); if (GetWindowText(Wnd, buff, sizeof(buff)) = 0) then begin name:=GetWindowPatch(Wnd); if (name<>'Null') then TmpStr:=name; end;
if (TmpStr<>'') and (TmpStr<>paramStr(0)) then begin WinCount:=WinCount+1; END; end else begin WinCountH:=WinCountH+1; end; end; Wnd := GetWindow(Wnd, gw_hWndNext); END; }
1) вот... примерно так... procedure TFormWinHide.SearchWindow вызывается таймером каждые 100 мс... идет утечка памяти... не могу разабраться откуда...
2) а можно не по таймеру окна искать, а по системному сообщению (изменилось общее количество окон или одно из окон изменило статус с "IsWindowVisible(Wnd)" и наоборот)? если да, то как...
3) Ну это к другой теме, но спрошу здесь же... в контекстном меню задаю для пункта hint, ноль эмоций.. что надо сделать, чтобы он там отображался?
Автор: volvo 7.08.2008 22:30
Цитата
идет утечка памяти... не могу разабраться откуда...
Вопрос на засыпку: с чего ты решил про утечку? Запустил приложение, оно отработало больше 7 минут, после первых 10 секунд работы максимальный объем используемой памяти не увеличился.
Цитата
а можно не по таймеру окна искать, а по системному сообщению
По таймеру гораздо проще, но можно ставить хук на CreateProcess/ZwCreateProcess, если хочешь - спроси у Гугля...
Цитата
в контекстном меню задаю для пункта hint, ноль эмоций.. что надо сделать, чтобы он там отображался?
Вопрос на засыпку: с чего ты решил про утечку? Запустил приложение, оно отработало больше 7 минут, после первых 10 секунд работы максимальный объем используемой памяти не увеличился.
По таймеру гораздо проще, но можно ставить хук на CreateProcess/ZwCreateProcess, если хочешь - спроси у Гугля...
про утечку... диспечер задач, до запуска - выделение памяти - 842 мб через 10 секунд - 890 мб через 20 - 920 ну и так далее (в первый раз, пока сообразил, 1700 мб было )... но в процессах память не растет ни у bds, ни у программы... при запуске не из делфи, а просто программы таже фигня... при закрытии программы память падает до значения перед запуском...
// name:=GetWindowPatch(Wnd);
отключаю эту строку, всё нормально... Win XP sp2, delphi 2005...
проще, так проще...
англицкий будем учить :-)
Автор: Snake_B 8.08.2008 13:31
Цитата(Snake_B @ 8.08.2008 4:31)
англицкий будем учить :-)
там про главное меню... сделела не много по другому... может кому пригодится... ну и за одно может кто скажет де ошибки =)
procedure TForm1.AppHint(Sender: TObject); begin if Application.Hint = '' then begin hintwnd.releasehandle; exit; end; ActivateHintNOW(Mouse.CursorPos.X + 16, Mouse.CursorPos.Y + 16); end;
function GetModulesListByProcessId(ProcessId : Cardinal) : TModuleArray; var hSnapshot : THandle; lpme : TModuleEntry32; procedure AddModuleToList; begin SetLength(Result,High(Result)+2); Result[high(Result)]:=lpme; end; begin SetLength(Result,0); hSnapshot:=CreateToolhelp32Snapshot(TH32CS_SNAPMODULE,ProcessId);
if hSnapshot=-1 then RaiseLastWin32Error; lpme.dwSize:=SizeOf(lpme); if Module32First(hSnapshot,lpme) then begin AddModuleToList; while Module32Next(hSnapshot,lpme) do AddModuleToList; end;
CloseHandle(hSnapshot); // <--- Вот так, например ... end;
?
Кстати, в конце GetWindowPatch() можно было бы и SetLength(modarr, 0) добавить, на всякий случай.
Автор: Snake_B 8.08.2008 20:08
Цитата(volvo @ 8.08.2008 21:06)
Хэндлы освобождать не пробовал?
Кстати, в конце GetWindowPatch() можно было бы и SetLength(modarr, 0) добавить, на всякий случай.
спасиба... ввиду того что самоучка - не которые простые моменты для меня неизвестны...
а вот сама функция GetModulesListByProcessId(ProcessId : Cardinal) целиком скопирована из DRKB... там про хэндлы тоже видать не знали
Автор: volvo 8.08.2008 22:46
Цитата
а вот сама функция GetModulesListByProcessId(ProcessId : Cardinal) целиком скопирована из DRKB...
А в DRKB она была включена с одного из программерских форумов, там написано с какого... А запостил ее туда один из участников, который по какой-то причине пропустил эту строчку... А автор вопроса, на который он отвечал, не посмотрел сразу, что приложение "забирает" память, и не спросил, "почему", вот тебе и недочет... Все люди, все ошибаются...
Автор: Snake_B 8.08.2008 23:03
Цитата(volvo @ 9.08.2008 3:46)
А в DRKB она была включена с одного из программерских форумов, там написано с какого... А запостил ее туда один из участников, который по какой-то причине пропустил эту строчку... А автор вопроса, на который он отвечал, не посмотрел сразу, что приложение "забирает" память, и не спросил, "почему", вот тебе и недочет... Все люди, все ошибаются...
извиняюсь конечно за оффтоп... но в принципе я их понимаю... уже в парочке программ эту функцию использовал.. но там она один раз вызывалась...
Автор: Snake_B 20.08.2008 21:34
вот тут парочку вопросов появилось... по теме где то близко...
procedure WinExeToBMP(patch: string; Image: TbitMap); // Извлечение иконки из ехе файла... Var Icon:HICON; Begin if fileexists(patch) then begin Icon:=ExtractIcon(hInstance, pchar(patch), 0); If ICON > 0 then With Image do Begin Height:=32; Width:=32; Canvas.Brush.Color:=clBtnFace; Canvas.FillRect(Rect(0,0,32,32)); DrawIcon(Canvas.Handle, 0, 0, Icon); End; end; End;
вот примерно такая функция... иногда выдает ошибку "EOutOfResources" и сообщение - "Не хватает ресурсов для выполнения операции" (примерно, точно не помню).... через try except не ловится... т.е. он отрабатывает, но уже после системного сообщения... куда тут копать хоть?
Автор: volvo 21.08.2008 0:52
Цитата
куда тут копать хоть?
В MSDN: http://msdn.microsoft.com/en-us/library/ms648068(VS.85).aspx
Цитата
Remarks This function is not supported for icons in 16-bit executables and DLLs. You must destroy the icon handle returned by ExtractIcon by calling the DestroyIcon function.
У тебя этого не делается, вот тебе и утечка.
Автор: Snake_B 1.09.2008 4:49
Цитата(volvo @ 21.08.2008 5:52)
В MSDN: http://msdn.microsoft.com/en-us/library/ms648068(VS.85).aspx
У тебя этого не делается, вот тебе и утечка.
точно... из-за этого... спасибо...
Автор: Гость 12.03.2010 15:39
Как пользоваться этой функцией????
Цитата
function GetModulesListByProcessId(ProcessId : Cardinal) : TModuleArray; var hSnapshot : THandle; lpme : TModuleEntry32; procedure AddModuleToList; begin SetLength(Result,High(Result)+2); Result[high(Result)]:=lpme; end; begin SetLength(Result,0); hSnapshot:=CreateToolhelp32Snapshot(TH32CS_SNAPMODULE,ProcessId); if hSnapshot=-1 then RaiseLastWin32Error; lpme.dwSize:=SizeOf(lpme); if Module32First(hSnapshot,lpme) then begin AddModuleToList; while Module32Next(hSnapshot,lpme) do AddModuleToList; end; CloseHandle(hSnapshot); // <--- Вот так, например ... end;
Автор: volvo 13.03.2010 2:17
В самом первом сообщении темы был приведен пример использования.