-
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
public
end;
var
Form1: TForm1;
StringList: TStringList;
implementation
procedure TForm1.Button1Click(Sender: TObject);
var
i: Integer;
S: String;
begin
S := StringList.Text;
i := 1;
while i < Length(S) do begin
Inc(i);
S := '!';
Application.ProcessMessages;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
StringList := TStringList.Create;
StringList.LoadFromFile('1.txt');
end;
end. Достаточно загрузить в StringList 10-20Mb файл покликать по кнопке и вскоре получим Out of Memory. Вопрос задаю не из интереса. В одном из моих проектов есть подобная ошибка, если ее можно так назвать, а примерчик просто для иллюстрации механизма
-
А кто и где будет делать StringList.Free?
-
Ситуация не воспроизводится, память не утекает, кроме выделенной под StringList и потроха файла.
-
> Игорь Шевченко © (13.04.17 20:57) [2] > > Ситуация не воспроизводится, память не утекает, кроме выделенной > под StringList и потроха файла.
Ошибся от руки написал
while i < Length(S) do begin Inc(i); S := '!'; S[i] := '!'; //или вообще можно закоментировать дабы не обнулять S; Application.ProcessMessages; end;
-
так не бегит:
var Form1: TForm1; StringList: TStringList; S: String;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject); var i: Integer; begin i := 1; while i < Length(S) do begin Inc(i); Application.ProcessMessages; end; end;
procedure TForm1.FormCreate(Sender: TObject); begin StringList := TStringList.Create; StringList.LoadFromFile('1.txt'); S := StringList.Text; end;
Но это нужно делать S глобальной, и не делать S := StringList.Text; внутри Button1Click, что не удовлетворяет нужным требованиям
-
> Но это нужно делать S глобальной, и не делать S := StringList. > Text; внутри Button1Click, что не удовлетворяет нужным требованиям
S нужно по каждому новому запросу (в данном случае по клику) обновлять из S := StringList.Text;
-
В этом коде нет утечек. Вставлять Application.processmessages в каждую итерацию цикла как то не очень. Не лучше ли оформить все в доп потоке? Что этот код вообще делать должен. Он странный.
-
> а примерчик просто для иллюстрации механизма
В твоем примере нет места, где может возникать out of memory. Вызов Application.ProcessMessages к утечкам не приводит, присвоение символам строки восклицательного знака тоже не приводит.
Скачай FastMM, вставь его первым юнитом в проекте, включи отчет об утечках в файл и все косяки сразу станут видны.
-
fics, пришло время познакомится с тёмной стороной Application.ProcessMessages;
> DVM © (13.04.17 22:06) [6] > В этом коде нет утечек. +1
> Игорь Шевченко © (13.04.17 22:40) [7] >В твоем примере нет места, где может возникать out of memory. -1
procedure TForm1.Button1Click(Sender: TObject); const L = 20*1024*1024*SizeOf(Char); // 20M File.txt var i : Integer; M : Int64; begin Tag := Tag + 1; // Alloc
M := Int64(Tag) * L; if ( M > MaxInt ) then Halt;
Caption := IntToStr(M);
for i:=1 to L div SizeOf(Char) do Application.ProcessMessages; // -> Button1Click x 50 == out of memory // !
Tag := Tag - 1; // Free end;
P.S. ... , в какие города, И где найти нам средство, Чтоб вновь попасть туда. ))
-
NoUser © (13.04.17 23:33) [8]
А где утечка-то ?
-
Как таковой утечки нет. Но если Button1Click полностью не отработает до следующего нажатия пользователем Button1, то из внутренностей Application.ProcessMessages (которая находится в этом же Button1Click) будет произведён ёще один вызов Button1Click. И так далее, что при неблагоприятном стечении обстоятельств (быстрый пользователь или длинный цикл/большой файл обработки ) приведёт к исчерпанию доступной памяти, выделенной процессу.
Ранее ТСу было предложено как не допустить подобного, при решении его задачи (раскраска редактируемого текста), через использование примитивных флажков. Но этот приём не был принят на вооружение.
-
Флажки тут не помогут, помогут только сократить процессорное время до времени обработки. с момента последнего нажатия клавиши, т.е. если по одному нажатию текст обрабатывается до конца 1-сек и нажали подряд 10 раз то уйдет не (10 сек минус время сколько ушло на нажатие), а именно 1-сек, а вот память все равно накидываетя. Так что прием был учтен.
Р.S ТСу - как расшифровывается?
-
> [11] fics © (14.04.17 21:01) > Р.S ТСу - как расшифровывается?
Топик стартеру - автору темы на форуме.
-
> fics © (14.04.17 21:01) [11] Флажки тут не помогут
Ну, расcкажи циклу, что уже новое нажатие, как-то по-другому, может тогда он не будет и память 'накидывать'.
-
Нет здесь утечки, обычная дефрагментация. Sha показывал кусок кода, которым еще быстрее можно на неё выйти Зы: хотя именно вот этот пример не должен так дробить страницы менеджера
-
> Rouse_ © (15.04.17 11:09) [14]
Что Делать ? :)
-
> Что Делать ? :)
Не копировать строки по 30 мегабайт по сто раз.
-
> Что Делать :
procedure TForm1.Button1Click(Sender: TObject); // точка Ы var i : Integer; S : String; begin if ( Tag <> 0) // косвенная рекурсия ? (сработал телепорт ?) then begin // да ! Tag := 0; // скажем что есть новые данные Exit; // и свалим end;
i := 1; // загрузка S := StringList.Text; // данных Tag := 1; // погнали
while (i <= Length(S)) do begin Application.ProcessMessages; // если повезёт, нас телепортируют в точку Ы
if ( Tag = 0 ) // новые данные ? then begin // да ! i := 1; // загрузка S := StringList.Text; // данных Tag := 1; // погнали Continue; // дальше end;
// ... // ночью в поле негры пашут
Inc(i); end;
Tag := 0; // хух! end;
-
> Но если Button1Click полностью не отработает до следующего нажатия procedure TForm1.Button1Click(Sender: TObject);
begin
TButton(Sender).Enabled:= false;
try
...
finally
TButton(Sender).Enabled:= true;
end;
end;
|