Гость
Войти | Профиль | Очистить
Целевая тема:
Создать новую тему:
Автор:
Действия ...
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Помогите найти утечку / 25 сообщений из 29, страница 1 из 2
  1  все
21.10.2019, 17:59
    #39879527
garun
garun
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите найти утечку
Добрый вечер! Прошу помочь понять в чем проблема. Нижеприведенная функция крутится в таймере с интервалом 1сек и достает текущий адрес папки из проводника. Если смотреть в диспетчере, то с каждой секундой потребляемая память увеличивается на 50-60Кб. Почему так происходит и как это предотвратить?

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
uses 
 Winapi.ActiveX, SHDocVw, System.Win.ComObj, ShLWAPI;

function ExtractDirAddress(Wnd: HWND): string;
var
  I: Integer;
  WndIface: IDispatch;
  ShellWindows: IShellWindows;
  WebBrowserApp: IWebBrowserApp;
  ResultSize: DWORD;
begin
  if Succeeded(CoCreateInstance(CLASS_ShellWindows, nil, CLSCTX_LOCAL_SERVER,  IID_IShellWindows, ShellWindows))
  then
  begin
    for I := 0 to ShellWindows.Count - 1 do
    begin
      if (Wnd <> HWND_TOPMOST)
      then WndIface:= ShellWindows.Item(VarAsType(I, VT_I4))
      else WndIface:= ShellWindows.Item(VarAsType(SWC_EXPLORER, VT_UI4));
      if Succeeded(WndIface.QueryInterface(IID_IWebBrowserApp, WebBrowserApp))
      then
      begin
        if (Wnd = HWND_TOPMOST) or (WebBrowserApp.HWnd = Wnd) then
        begin
         Result:=  WebBrowserApp.LocationURL;
          Break;
        end;
      end;
    end;
  end;
end;

procedure TForm1.tmr1Timer(Sender: TObject);
var
 S: string;
begin
  S:= ExtractDirAddress(GetForegroundWindow);
  if S > ''
  then mmo1.Text:= '[' + TimeToStr(Now) + ']: ' + S;
end;
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
21.10.2019, 19:11
    #39879553
ma1tus
ma1tus
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите найти утечку
garun
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
      if Succeeded(WndIface.QueryInterface(IID_IWebBrowserApp, WebBrowserApp))
      then
      begin
        if (Wnd = HWND_TOPMOST) or (WebBrowserApp.HWnd = Wnd) then
        begin
         Result:=  WebBrowserApp.LocationURL;
          Break;
        end;
      end;


Освобождай WebBrowserApp на каждой итерации.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
21.10.2019, 19:19
    #39879556
garun
garun
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите найти утечку
ma1tusgarun
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
      if Succeeded(WndIface.QueryInterface(IID_IWebBrowserApp, WebBrowserApp))
      then
      begin
        if (Wnd = HWND_TOPMOST) or (WebBrowserApp.HWnd = Wnd) then
        begin
         Result:=  WebBrowserApp.LocationURL;
          Break;
        end;
      end;


Освобождай WebBrowserApp на каждой итерации.

Проблема не в этом. Если убрать всё, оставив только вот эту конструкцию, то утечка всё равно продолжается:

Код: pascal
1.
2.
3.
4.
5.
6.
if Succeeded(CoCreateInstance(CLASS_ShellWindows, nil, CLSCTX_LOCAL_SERVER,  IID_IShellWindows, ShellWindows))
then

 //do nothing

end;
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
21.10.2019, 19:33
    #39879560
rgreat
rgreat
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите найти утечку
Как я понимаю ShellWindows:=nil не помогает?
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
21.10.2019, 19:51
    #39879567
Ghost Writer
Ghost Writer
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите найти утечку
garunкрутится в таймере с интервалом 1секобязательно создавать ежесекундно ? один раз создать и использовать - не вариант ?
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
21.10.2019, 19:52
    #39879568
garun
garun
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите найти утечку
rgreatКак я понимаю ShellWindows:=nil не помогает?

Неа :(
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
21.10.2019, 19:55
    #39879571
rgreat
rgreat
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите найти утечку
Вызови .Release явно.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
21.10.2019, 19:56
    #39879572
garun
garun
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите найти утечку
Ghost Writergarunкрутится в таймере с интервалом 1секобязательно создавать ежесекундно ? один раз создать и использовать - не вариант ?

Обязательно.

Кстати, если заменить это:
Код: pascal
1.
if Succeeded(CoCreateInstance(CLASS_ShellWindows, nil, CLSCTX_LOCAL_SERVER,  IID_IShellWindows, ShellWindows)) then


На это:
Код: pascal
1.
ShellWindows:= CoShellWindows.Create;


То код будет тоже работать, но утечка никуда не девается.

Отсюда вопрос - как освободить ShellWindows?
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
21.10.2019, 19:58
    #39879573
Ghost Writer
Ghost Writer
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите найти утечку
garunОбязательнои почему же ?
создать экземпляр и использовать.
только если вдруг будет завершен процесс explorer.exe, то придется отлавливать исключения.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
21.10.2019, 20:01
    #39879575
rgreat
rgreat
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите найти утечку
Кстати, может раз ShellWindows это список, то оно так криво реализовано что элементы надо поштучно освобождать?
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
21.10.2019, 20:06
    #39879578
garun
garun
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите найти утечку
rgreatВызови .Release явно.

Как? у IShellWindows нет метода Release
Вернее есть ._Release, но он не помогает, ни так WndIface._Release, ни так ShellWindows._Release

Ghost Writerи почему же ?
создать экземпляр и использовать.
только если вдруг будет завершен процесс explorer.exe, то придется отлавливать исключения.
Потому что мне постоянно нужна актуальная информация о том какая папка открыта в проводнике.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
21.10.2019, 20:08
    #39879579
Ghost Writer
Ghost Writer
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите найти утечку
garun,

уговаривать тебя ?
Код: pascal
1.
2.
3.
4.
5.
6.
procedure TForm1.Timer2Timer(Sender: TObject);
begin
  if not Assigned(ShellWindow) then
    ShellWindow := CoShellWindows.Create;
  Edit1.Text := IntToStr(ShellWindow.Count);
end;
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
21.10.2019, 20:25
    #39879587
garun
garun
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите найти утечку
Ghost Writergarun,

уговаривать тебя ?
Код: pascal
1.
2.
3.
4.
5.
6.
procedure TForm1.Timer2Timer(Sender: TObject);
begin
  if not Assigned(ShellWindow) then
    ShellWindow := CoShellWindows.Create;
  Edit1.Text := IntToStr(ShellWindow.Count);
end;



Сделал так, утечка осталась
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
21.10.2019, 20:40
    #39879592
garun
garun
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите найти утечку
garunGhost Writergarun,

уговаривать тебя ?
Код: pascal
1.
2.
3.
4.
5.
6.
procedure TForm1.Timer2Timer(Sender: TObject);
begin
  if not Assigned(ShellWindow) then
    ShellWindow := CoShellWindows.Create;
  Edit1.Text := IntToStr(ShellWindow.Count);
end;



Сделал так, утечка осталась


Хотя изменения всё же есть! Теперь память увеличивается только если активно окно проводника. Если нет - то не увеличивается
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
21.10.2019, 20:50
    #39879593
Ghost Writer
Ghost Writer
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите найти утечку
протестировал твой код ...
в делфи 7 потребляемая память практически не росла. если и увеличивалась, то через минуту освобождалась.
в Delphi 10.2 в целом также, за 15 минут в итоге выросла примерно на 150 Кб.
особенно прирост заметил когда запускал IE.
но никаких 50-60 Кб в секунду не наблюдаю. а много у тебя окон открыто ?
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
21.10.2019, 21:01
    #39879595
garun
garun
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите найти утечку
Ghost Writerпротестировал твой код ...
в делфи 7 потребляемая память практически не росла. если и увеличивалась, то через минуту освобождалась.
в Delphi 10.2 в целом также, за 15 минут в итоге выросла примерно на 150 Кб.
особенно прирост заметил когда запускал IE.
но никаких 50-60 Кб в секунду не наблюдаю. а много у тебя окон открыто ?

У меня вот так: https://c.radikal.ru/c23/1910/2f/7d41d0a21f49.gif
Windows 10 x64, Delphi 10.3 Rio
Открыто одно окно проводника, браузер, Delphi и всё.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
21.10.2019, 23:03
    #39879620
X-Cite
X-Cite
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите найти утечку
Windows 10 x64, Delphi 10.3.2 Rio
 
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, System.Win.InternetExplorer, Vcl.ExtCtrls, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    Memo1: TMemo;
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    function ExtractDirAddress(const aWnd: HWND): string;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function TForm1.ExtractDirAddress(const aWnd: HWND): string;
begin
  var Shell := TShellWindows.Create(nil);
  try
    Shell.Connect();
    for var k := 0 to Shell.Count - 1 do
    begin
      var WndIface: IDispatch;
      if aWnd <> HWND_TOPMOST then
        WndIface := Shell.Item(k)
      else
        WndIface := Shell.Item(SWC_EXPLORER);
      var WebBrowserApp: IWebBrowserApp;
      if WndIface.QueryInterface(IID_IWebBrowserApp, WebBrowserApp) = S_OK then
        Exit(WebBrowserApp.LocationURL);
    end;
  finally
    Shell.Free();
  end;
  Exit(string.Empty);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ReportMemoryLeaksOnShutdown := True;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  var s := ExtractDirAddress(GetForegroundWindow());
  if not s.IsEmpty() then
    Memo1.Lines.Text := '[' + TimeToStr(Now()) + ']: ' + S;
end;

end.



Таймер поставил 50 мс
Скакал по папкам секунд 30. Память стабильна и выше 3556 (Выделенная память) не поднимается
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
22.10.2019, 09:40
    #39879684
garun
garun
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите найти утечку
X-Cite,

Спасибо, я затестил ваш код, но проблема осталась. За минуту с 3.5Мб постепенно наросло +15Мб и продолжает расти. Что я делаю не так?
Создал уже новый проект, скопировал ваш код в точности.

 
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
22.10.2019, 09:46
    #39879691
wadman
wadman
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите найти утечку
В проекте ReportMemoryLeaksOnShutdown включить и посмотреть, что по выходу напишет?
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
22.10.2019, 09:49
    #39879693
garun
garun
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите найти утечку
Сейчас проверил на виртуалке с Windows 7 - код от X-Cite отрабатывает превосходно, память в диспетчере стоит на месте.. что за ерунда....
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
22.10.2019, 09:54
    #39879699
alekcvp
alekcvp
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите найти утечку
garunСейчас проверил на виртуалке с Windows 7 - код от X-Cite отрабатывает превосходно, память в диспетчере стоит на месте.. что за ерунда....
Вирусы? Или какие-нибудь сторонние dll-ки?..
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
22.10.2019, 09:56
    #39879701
X-Cite
X-Cite
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите найти утечку
Протестировал на win7 / win10 полет нормальный.
Если у вас приложение с нуля и только этот код, то смотрите следующие варианты
1) Версия Delphi на которой тестировал 26.0.34749.6593
2) Версия ОС Win10 Pro 1903 Сборка 18362.356
3) Установленные в Delphi различные эксперты, FastMM не из коробки, Jedi и прочее...
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
22.10.2019, 10:03
    #39879704
ёёёёё
ёёёёё
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите найти утечку
garun,

а с чем ты вообще борешься? Приложение через сутки непрерывной работы падает, система виснет - что за беда у тебя, конкретно?
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
22.10.2019, 10:10
    #39879712
Василий 2
Василий 2
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите найти утечку
Не, я понимаю, можно исследовать методом тыка, когда других способов просто нет, но утечку-то диагностировать элементарно! Инженеры блин, технари, аналитическое мышление...
ReportMemoryLeaksOnShutdown
или подключить FastMM в режиме FullDebugMode
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
22.10.2019, 10:24
    #39879726
vavan
vavan
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите найти утечку
когда дело касается шелла в игру могут вступать всяческие сторонние икстеншны к нему
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
  1  все
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Помогите найти утечку / 25 сообщений из 29, страница 1 из 2
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение  
Полит. конфиден.  
созд. / загр.: 444ms
Закрыть
start [/forum/topic.php?fid=58&mobile=1&tid=2038930]:
 0ms
get settings:
 8ms
get forum list:
 13ms
check forum access:
 3ms
check topic access:
 3ms
track hit:
 154ms
get topic data:
 8ms
get forum data:
 2ms
get page messages:
 54ms
get tp. blocked users:
 1ms
others: 198ms
total:  444ms
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]