IPB
ЛогинПароль:

> ВНИМАНИЕ!

Прежде чем задать вопрос, смотрите FAQ.
Рекомендуем загрузить DRKB.

Наладить общение поможет, если вы подпишитесь по почте на новые темы в этом форуме.

 
 Ответить  Открыть новую тему 
> Как определить откуда был запущен процесс?, Из drkb....
сообщение
Сообщение #1


Пионер
**

Группа: Пользователи
Сообщений: 72
Пол: Мужской

Репутация: -  0  +



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, ноль эмоций.. что надо сделать, чтобы он там отображался?
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Гость






Цитата
идет утечка памяти... не могу разабраться откуда...
Вопрос на засыпку: с чего ты решил про утечку? Запустил приложение, оно отработало больше 7 минут, после первых 10 секунд работы максимальный объем используемой памяти не увеличился.

Цитата
а можно не по таймеру окна искать, а по системному сообщению
По таймеру гораздо проще, но можно ставить хук на CreateProcess/ZwCreateProcess, если хочешь - спроси у Гугля...

Цитата
в контекстном меню задаю для пункта hint, ноль эмоций.. что надо сделать, чтобы он там отображался?
Читать здесь: http://delphi.about.com/od/vclusing/a/menuitemhints.htm

Сообщение отредактировано: volvo -
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Пионер
**

Группа: Пользователи
Сообщений: 72
Пол: Мужской

Репутация: -  0  +


Цитата(volvo @ 8.08.2008 3:30) *

Вопрос на засыпку: с чего ты решил про утечку? Запустил приложение, оно отработало больше 7 минут, после первых 10 секунд работы максимальный объем используемой памяти не увеличился.

По таймеру гораздо проще, но можно ставить хук на CreateProcess/ZwCreateProcess, если хочешь - спроси у Гугля...

Читать здесь: http://delphi.about.com/od/vclusing/a/menuitemhints.htm


про утечку... диспечер задач, до запуска - выделение памяти - 842 мб
через 10 секунд - 890 мб
через 20 - 920
ну и так далее (в первый раз, пока сообразил, 1700 мб было )...
но в процессах память не растет ни у bds, ни у программы...
при запуске не из делфи, а просто программы таже фигня...
при закрытии программы память падает до значения перед запуском...
// name:=GetWindowPatch(Wnd);

отключаю эту строку, всё нормально...
Win XP sp2, delphi 2005...

проще, так проще...

англицкий будем учить :-)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Пионер
**

Группа: Пользователи
Сообщений: 72
Пол: Мужской

Репутация: -  0  +


Цитата(Snake_B @ 8.08.2008 4:31) *

англицкий будем учить :-)


там про главное меню... сделела не много по другому... может кому пригодится...
ну и за одно может кто скажет де ошибки =)

unit main;

interface

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

type
TForm1 = class(TForm)
PopupMenu1: TPopupMenu;
nmuThis: TMenuItem;
mnuIs: TMenuItem;
mnuA: TMenuItem;
mnuTest: TMenuItem;
procedure FormCreate(Sender: TObject);
private
procedure ActivateHintNOW( x,y: Integer);
procedure AppHint(Sender: TObject);
public
end;

var
Form1: TForm1; var hintWnd: THintWindow;

implementation

{$R *.dfm}

procedure TForm1.ActivateHintNOW( x,y: Integer);
var
rect: TRect;
Hintlnfo: THintInfo;
begin
hintWnd.Color:=Application.HintColor;
rect := hintWnd.CalcHintRect( Screen.Width, Application.Hint, nil);
rect.Left := rect.Left+x;
rect.Right := rect.Right+x;
rect.Top := rect.Top + y;
rect.Bottom := rect.Bottom + y;
hintWnd.ActivateHint( rect, Application.Hint);
end;


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;


procedure TForm1.FormCreate(Sender: TObject);
begin
hintwnd:= THintWindow.create(self);
Application.OnHint := AppHint;
self.PopupMenu := PopupMenu1;
end;

end.


ну вопрос про память в силе..
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Гость






Хэндлы освобождать не пробовал?

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) добавить, на всякий случай.
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Пионер
**

Группа: Пользователи
Сообщений: 72
Пол: Мужской

Репутация: -  0  +


Цитата(volvo @ 8.08.2008 21:06) *

Хэндлы освобождать не пробовал?

Кстати, в конце GetWindowPatch() можно было бы и SetLength(modarr, 0) добавить, на всякий случай.


спасиба... ввиду того что самоучка - не которые простые моменты для меня неизвестны...

а вот сама функция GetModulesListByProcessId(ProcessId : Cardinal) целиком скопирована из DRKB...
там про хэндлы тоже видать не знали wacko.gif
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Гость






Цитата
а вот сама функция GetModulesListByProcessId(ProcessId : Cardinal) целиком скопирована из DRKB...
А в DRKB она была включена с одного из программерских форумов, там написано с какого... А запостил ее туда один из участников, который по какой-то причине пропустил эту строчку... А автор вопроса, на который он отвечал, не посмотрел сразу, что приложение "забирает" память, и не спросил, "почему", вот тебе и недочет... Все люди, все ошибаются...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8


Пионер
**

Группа: Пользователи
Сообщений: 72
Пол: Мужской

Репутация: -  0  +


Цитата(volvo @ 9.08.2008 3:46) *

А в DRKB она была включена с одного из программерских форумов, там написано с какого... А запостил ее туда один из участников, который по какой-то причине пропустил эту строчку... А автор вопроса, на который он отвечал, не посмотрел сразу, что приложение "забирает" память, и не спросил, "почему", вот тебе и недочет... Все люди, все ошибаются...


извиняюсь конечно за оффтоп...
но в принципе я их понимаю... уже в парочке программ эту функцию использовал..
но там она один раз вызывалась...
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #9


Пионер
**

Группа: Пользователи
Сообщений: 72
Пол: Мужской

Репутация: -  0  +


вот тут парочку вопросов появилось... по теме где то близко...

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 не ловится... т.е. он отрабатывает, но уже после системного сообщения...
куда тут копать хоть?
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #10


Гость






Цитата
куда тут копать хоть?
В MSDN: ExtractIcon Function

Цитата
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.
У тебя этого не делается, вот тебе и утечка.
 К началу страницы 
+ Ответить 
сообщение
Сообщение #11


Пионер
**

Группа: Пользователи
Сообщений: 72
Пол: Мужской

Репутация: -  0  +


Цитата(volvo @ 21.08.2008 5:52) *

В MSDN: ExtractIcon Function

У тебя этого не делается, вот тебе и утечка.


точно... из-за этого... спасибо...
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #12


Гость






Как пользоваться этой функцией????

Цитата
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;

 К началу страницы 
+ Ответить 
сообщение
Сообщение #13


Гость






В самом первом сообщении темы был приведен пример использования.
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 31.10.2020 15:52
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name