ReSQL.ru
     
powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Помогите найти утечку
25 сообщений из 29, страница 1 из 2
  1  все
Помогите найти утечку
    #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, 17:59
| Ответить | Цитировать | Написать  
Помогите найти утечку
    #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:11
| Ответить | Цитировать | Написать  
Помогите найти утечку
    #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:19
| Ответить | Цитировать | Написать  
Помогите найти утечку
    #39879560
rgreat
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
rgreat
Участник
Как я понимаю ShellWindows:=nil не помогает?
...
Рейтинг: 0 / 0
21.10.2019, 19:33
| Ответить | Цитировать | Написать  
Помогите найти утечку
    #39879567
Ghost Writer
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Ghost Writer
Участник
garunкрутится в таймере с интервалом 1секобязательно создавать ежесекундно ? один раз создать и использовать - не вариант ?
...
Рейтинг: 0 / 0
21.10.2019, 19:51
| Ответить | Цитировать | Написать  
Помогите найти утечку
    #39879568
Фотография garun
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
garun
Участник
rgreatКак я понимаю ShellWindows:=nil не помогает?

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

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

Ghost Writerи почему же ?
создать экземпляр и использовать.
только если вдруг будет завершен процесс explorer.exe, то придется отлавливать исключения.
Потому что мне постоянно нужна актуальная информация о том какая папка открыта в проводнике.
...
Рейтинг: 0 / 0
21.10.2019, 20:06
| Ответить | Цитировать | Написать  
Помогите найти утечку
    #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:08
| Ответить | Цитировать | Написать  
Помогите найти утечку
    #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:25
| Ответить | Цитировать | Написать  
Помогите найти утечку
    #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:40
| Ответить | Цитировать | Написать  
Помогите найти утечку
    #39879593
Ghost Writer
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Ghost Writer
Участник
протестировал твой код ...
в делфи 7 потребляемая память практически не росла. если и увеличивалась, то через минуту освобождалась.
в Delphi 10.2 в целом также, за 15 минут в итоге выросла примерно на 150 Кб.
особенно прирост заметил когда запускал IE.
но никаких 50-60 Кб в секунду не наблюдаю. а много у тебя окон открыто ?
...
Рейтинг: 0 / 0
21.10.2019, 20:50
| Ответить | Цитировать | Написать  
Помогите найти утечку
    #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, 21:01
| Ответить | Цитировать | Написать  
Помогите найти утечку
    #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
21.10.2019, 23:03
| Ответить | Цитировать | Написать  
Помогите найти утечку
    #39879684
Фотография garun
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
garun
Участник
X-Cite,

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

 
...
Рейтинг: 0 / 0
22.10.2019, 09:40
| Ответить | Цитировать | Написать  
Помогите найти утечку
    #39879691
Фотография wadman
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
wadman
Участник
В проекте ReportMemoryLeaksOnShutdown включить и посмотреть, что по выходу напишет?
...
Рейтинг: 0 / 0
22.10.2019, 09:46
| Ответить | Цитировать | Написать  
Помогите найти утечку
    #39879693
Фотография garun
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
garun
Участник
Сейчас проверил на виртуалке с Windows 7 - код от X-Cite отрабатывает превосходно, память в диспетчере стоит на месте.. что за ерунда....
...
Рейтинг: 0 / 0
22.10.2019, 09:49
| Ответить | Цитировать | Написать  
Помогите найти утечку
    #39879699
alekcvp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
alekcvp
Участник
garunСейчас проверил на виртуалке с Windows 7 - код от X-Cite отрабатывает превосходно, память в диспетчере стоит на месте.. что за ерунда....
Вирусы? Или какие-нибудь сторонние dll-ки?..
...
Рейтинг: 0 / 0
22.10.2019, 09:54
| Ответить | Цитировать | Написать  
Помогите найти утечку
    #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, 09:56
| Ответить | Цитировать | Написать  
Помогите найти утечку
    #39879704
ёёёёё
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
ёёёёё
Участник
garun,

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


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