Как определить откуда был запущен процесс?, Из drkb.... Опции

[Snake_B]

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 минут, после первых 10 секунд работы максимальный объем используемой памяти не увеличился.

а можно не по таймеру окна искать, а по системному сообщению

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

в контекстном меню задаю для пункта hint, ноль эмоций.. что надо сделать, чтобы он там отображался?

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

Сообщение отредактировано: volvo - 7.08.2008 18:30

[Snake_B]

Вопрос на засыпку: с чего ты решил про утечку? Запустил приложение, оно отработало больше 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...

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

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

[Snake_B]

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

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

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.

ну вопрос про память в силе..

[volvo]

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

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]

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

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

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

а вот сама функция GetModulesListByProcessId(ProcessId : Cardinal) целиком скопирована из DRKB...
там про хэндлы тоже видать не знали

[volvo]

а вот сама функция GetModulesListByProcessId(ProcessId : Cardinal) целиком скопирована из DRKB...

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

[Snake_B]

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

извиняюсь конечно за оффтоп...
но в принципе я их понимаю... уже в парочке программ эту функцию использовал..
но там она один раз вызывалась...

[Snake_B]

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

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]

куда тут копать хоть?

В 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.

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

[Snake_B]

В MSDN: ExtractIcon Function

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

точно... из-за этого... спасибо...

[Гость]

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

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]

В самом первом сообщении темы был приведен пример использования.