Форум: "Прочее";
Текущий архив: 2008.07.20;
Скачать: [xml.tar.bz2];

Вниз

Помогите пожалуйста   Найти похожие ветки 

← →
Style ©   (2008-06-01 21:57) [0]

Есть программка которая постоянно опрашивает некоторые устройства через виртуальный COM порт. Состояния устройств фиксируются в базе, а также в текстовом виде записываются в журналы. Есть 3 журнала куда в зависимости от полученного состояния пишется информация. Эти журналы мне необходимо показывать пользователю. положил 3 TMemo на PageControl и в них пишется текстовая информация. Данные пишутся как в файлы так и добавляются в Memo. Так вот показывать нужно последние 1000 строк в каждом журнале. Столкнулся с некоторыми проблемами.

Если я веду запись в журнал следующим образом:

const MAX_LOG = 1000;
...
   if memo <> nil then
   with Memo do
   begin
      Lines.BeginUpdate;
      try
       Lines.Add(Str);
       if(Lines.Count > MAX_LOG) then
         Lines.Delete(0);
      finally
        Lines.EndUpdate;
        Memo.InnerControl.Perform(WM_VSCROLL, SB_BOTTOM ,0);
      end;
   end; //with


то Lines.Delete(0); довольно серьезно затормаживает работу программы. Что не приемлемо и поэтому решил сделать подругому


const MAX_LOG = 1000;
const MAX_LOGCUT = 1200;
...
   if memo <> nil then
   with Memo do
   begin
      Lines.BeginUpdate;
      try
       Lines.Add(Str);
       if(Lines.Count > MAX_CUTLOG) then
         Lines.Text := CropLog(Lines.Text);
      finally
        Lines.EndUpdate;
        Memo.InnerControl.Perform(WM_VSCROLL, SB_BOTTOM ,0);
      end;
   end; //with

 function CropLog(const Log: string): string;
   var crlfCount: integer;
      i: integer;
 begin
    crlfCount := 0;
    for i := Length(Log)-1 downto 1 do
    begin
      if (Log[i] = #13) and (Log[i+1] = #10) then
         inc(crlfCount);
      if crlfCount >= MAX_LOG then
        break;
    end;

    result := copy(Log, i, Length(Log)-i);

 end;



Грубо говоря у журнала отсекаются лишние записи раз в 200 записей.
Так вот теперь программа начала пожирать память. Причем довольно неплохо. По мегабайту в минуту. Пологаю что это из-за дефрагментации памяти. В итоге на слабых компах с 256 оперативки - дело доходит до Out of memory.

Сначала думал, что утечки памяти в программе. Поставил FastMM - никаких утечек не обнаружил. Память не пожирает - как только я отключаю запись в Memo.

Что делать?

---

← →
tesseract ©   (2008-06-01 22:06) [1]

Ты примерно представляешь механизм записи файлов ? Так вот если удаляешь верхнии строчки, ты перезаписываешь ВЕСЬ файл. Используй БД или просто начинай новый лог с последними строчками из старого. Как например в *nix сделано.

Да к тому же через memo лог вести... Это 5 класс церковно-приходской школы.


>  if (Log[i] = #13) and (Log[i+1] = #10) then          inc(crlfCount);
>        if crlfCount >= MAX_LOG then         break;


Жесть. Просто жесть. Сделал в разы хуже.

---

← →
Style ©   (2008-06-01 22:36) [2]

> Ты примерно представляешь механизм записи файлов ? Так вот
> если удаляешь верхнии строчки, ты перезаписываешь ВЕСЬ файл.
>  Используй БД или просто начинай новый лог с последними
> строчками из старого. Как например в *nix сделано.


В файлы как раз все пишется как *nix. Как только размер файла выходит за рамки положенного он, переименовывается  в *.N и создается новый пустой файл и лог уже пишется туда. Проблема в том как мне показывать последние 1000 записей журнала пользователю? Нужен компонент на подобие TMemo.


> Да к тому же через memo лог вести... Это 5 класс церковно-
> приходской школы.


да ни кто его не ведет через memo - вникнуть в суть вопроса сначала надо. Memo нужен лишь для отображения последних записей.

---

← →
Умище-01112   (2008-06-01 22:39) [3]

> то Lines.Delete(0); довольно серьезно затормаживает работу
> программы. Что не приемлемо и поэтому решил сделать подругому


Как ты определил, что именно этот код затормаживает работу программы?

---

← →
Умище-01112   (2008-06-01 22:40) [4]

Кстати, TListBox не удобнее будет?

---

← →
Игорь Шевченко ©   (2008-06-01 22:49) [5]

> Проблема в том как мне показывать последние 1000 записей
> журнала пользователю? Нужен компонент на подобие TMemo.


А надо, чтобы оно также вверх прокручивалось при добавлении новой строки ?

Как минимум, могу дать совет - не удалять нулевую строчку каждый раз, а удалять через 10-100 строк.

---

← →
Style ©   (2008-06-01 22:53) [6]

>
> Как ты определил, что именно этот код затормаживает работу
> программы?


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


> Кстати, TListBox не удобнее будет?


все таки желательно что-то на подобие TMemo чтобы разом можно было выделить нужный текст и скопировать в буфер обмена.
Меня бы и мой вариант по скорости устроил бы. Если бы только память не отжирал. Похоже что Delete(0) удаляет запись, а затем смещает все записи по одной вверх - он реально дольше думает. Быстрее весь memo перезаписать вызвав SetText. Но только вот что происходит с памятью?  Я пытался заранее выделить область памяти и отсекать следующим образом, опять же раз в 200 записей:

const
LOGSIZE = 200000

    if(Lines.Count > MAX_CUTLOG) then
    begin
         Lines[Lines.Count - MAX_LOG] := "[@]";
         i := LOGSIZE-1;
         if i > Length(Lines.Text) then i := Length(Lines.Text);
         copyMemory(Mem,pchar(Lines.Text),i+1);
         Mem[i+1] := #0;
         i := Pos("[@]",Mem);
         if (i > 0) then
         begin
           Lines.Text := pchar(integer(Mem)+i+5);
         end;
    end;
    Lines.Append(Str);

initialization
 getMem(Mem, LOGSIZE);
finalization
 freeMem(Mem, LOGSIZE);
end.

---

← →
Style ©   (2008-06-01 22:55) [7]

> Как минимум, могу дать совет - не удалять нулевую строчку
> каждый раз, а удалять через 10-100 строк.


Игорь - я так и сделал. см. выше. Только вот начались проблемы с памятью. Реально программа отжирает память. Утечек нет.

---

← →
Reindeer Moss Eater ©   (2008-06-01 22:55) [8]

не надо смешивать в кучу две задачи:
ведение лога и ведение лога так, чтобы легко было показать юзеру последние 1000 записей.
лог отдельно - последние n событий (и только n) - отдельно.

---

← →
Умище-01113   (2008-06-01 22:58) [9]

Удалено модератором
Примечание: п5

---

← →
Style ©   (2008-06-01 23:28) [10]

> Ты лог показываешь непрерывно пользователю?
> Если да, то какой смысл в такой большой скорости обновления?


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

---

← →
Умище-00113   (2008-06-01 23:44) [11]

Удалено модератором
Примечание: п5

---

← →
Style ©   (2008-06-01 23:53) [12]

> В один TMemo пишется или в разные?


в разные.

 MAX_LOG = 1000;
 MAX_LOGCUT = 1200;
 LOG_MEM_SIZE = 200000;


procedure Log_AddStr(Str: string; const LogFile: string);

 var
   LogIndex: integer;
   Handle  : THandle;
   TabSheet: TTabSheet;
   Memo    : TMemo;
   i       : integer;

 procedure LocRenameFile;
 var
   i: integer;
 begin
   DeleteFile(GetArcName(dataCommon.MaxArc, LogFile));
   for i := dataCommon.MaxArc-1 downto 1  do
   begin
     if FileExists(GetArcName(i, LogFile)) then
       RenameFile(GetArcName(i, LogFile), GetArcName(i+1, LogFile));
   end;
   RenameFile(GetClientDir + LogFile, GetArcName(1, LogFile));
 end;

 procedure InitLog;
 begin
   TabSheet := nil;
   memo     := nil;
   Handle   := 0;

   if( LogFile = DefPubLogFile )   then begin
    if Application.MainForm <> nil then begin
      TabSheet := TFrm_Main(Application.MainForm).tabJournal;
      Memo :=TFrm_Main(Application.MainForm).memoLog;
    end;
    LogIndex := LOG_NORMAL;
   end;

   if( LogFile = DefERRORLogFile ) then begin
    sndPlaySound(SOUND_DIR + "\error.wav",  SND_ASYNC or SND_NOSTOP);
    if Application.MainForm <> nil then begin
      TabSheet := TFrm_Main(Application.MainForm).tabJournalERROR;
      Memo :=TFrm_Main(Application.MainForm).memoLogERROR;
    end;
    LogIndex := LOG_ERROR;
   end;

   if( LogFile = DefALERTLogFile )   then begin
    sndPlaySound(SOUND_DIR + "\alert.wav",  SND_ASYNC);
    if Application.MainForm <> nil then begin
      TabSheet := TFrm_Main(Application.MainForm).tabJournalALERT;
      Memo :=TFrm_Main(Application.MainForm).memoLogALERT;
    end;
    LogIndex := LOG_ALERT;
   end;

   if( LogFile = DefErrorLogFile )   then begin
    LogIndex := LOG_ERROR;
   end;

   Handle := DataCommon.Log_Files[LogIndex];
 end;

begin
   Str := FormatDateTime("[dd.mm.yyyy hh:mm:ss]: ", Now ) + Str;

   InitLog;

   if Tabsheet <> nil then TabSheet.Tag := 1;
   FileSeek(Handle,0, 2);

   StrPCopy(pBuffer,Str+CRLF);
   FileWrite(Handle, pBuffer^, Length(Str)+2);

   if getFileSize(GetClientDir + LogFile) >= dataCommon.MaxLog then
   begin
     FileClose(Handle);
     LocRenameFile;
     FileClose(FileCreate(GetClientDir + LogFile));
     DataCommon.Log_Files[LogIndex]    := FileOpen(GetClientDir + LogFile, fmOpenWrite or fmShareDenyNone);
   end; //size

   if TFrm_Main(Application.MainForm) = nil then
   begin
      dataCommon.LoadStr := dataCommon.LoadStr + Str + #13#10;
      Exit;
   end;

   if memo <> nil then
   with Memo do
   begin
      Lines.BeginUpdate;
      try
       if (Lines.Count > MAX_LOGCUT) then
       begin
         Lines[Lines.Count - MAX_LOG] := "[@]";
         i := LOG_MEM_SIZE-1;
         if i > Length(Lines.Text) then i := Length(Lines.Text);
         copyMemory(Mem,pchar(Lines.Text),i+1);
         Mem[i+1] := #0;
         i := Pos("[@]",Mem);
         if (i > 0) then
         begin
           Lines.Text := pchar(integer(Mem)+i+5);
         end;
       end;
       Lines.Append(Str);
      finally
        Lines.EndUpdate;
       if Application.MainForm <> nil then begin
            Memo.InnerControl.Perform(WM_VSCROLL, SB_BOTTOM ,0);
        end;
      end;
   end; //with
end;


initialization
 getMem(pBuffer, 4096);
 getMem(Mem, LOG_MEM_SIZE);
finalization
 freeMem(pBuffer, 4096);
 freeMem(Mem, LOG_MEM_SIZE);

---

← →
Умище-00013   (2008-06-02 00:03) [13]

Удалено модератором

---

← →
Style ©   (2008-06-02 12:08) [14]

Наверное все-таки где-то в программе косяк.

Создал новый проект - delete действительно удаляет довольно быстро.  


unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls, ComCtrls, ExtCtrls, cxControls, cxContainer, cxEdit,
 cxTextEdit, cxMemo, cxPC, cxTreeView;

type
 TForm1 = class(TForm)
   Panel1: TPanel;
   Button1: TButton;
   cxPageControl1: TcxPageControl;
   cxTabSheet1: TcxTabSheet;
   cxTabSheet2: TcxTabSheet;
   cxTabSheet3: TcxTabSheet;
   cxMemo1: TcxMemo;
   cxMemo2: TcxMemo;
   cxMemo3: TcxMemo;
   cxTreeView1: TcxTreeView;
   procedure FormCreate(Sender: TObject);
   procedure Button1Click(Sender: TObject);
   procedure cxMemo1PropertiesEditValueChanged(Sender: TObject);
 private
   procedure DoCalc(var Msg: TMessage); message WM_USER;
   procedure AddToLog(m: TCxMemo; s: string);
   function GetMsg: string;
   function CropLog(const Log: string): string;
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

const Msg = "This is a test log message. {Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms}, Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms}";

const Msg2 =
       "This is a test log message."#13#10 +
       "{Windows, Messages, SysUtils, Variants, "#13#10 +
       "Classes, Graphics, Controls, Forms}, Windows,"#13#10 +
       "Messages, SysUtils, Variants,"#13#10 +
       "This is a test log message."#13#10 +
       "{Windows, Messages, SysUtils, Variants, "#13#10 +
       "Classes, Graphics, Controls, Forms}, Windows,"#13#10 +
       "Messages, SysUtils, Variants,"#13#10 +
       "This is a test log message."#13#10 +
       "{Windows, Messages, SysUtils, Variants, "#13#10 +
       "Classes, Graphics, Controls, Forms}, Windows,"#13#10 +
       "Messages, SysUtils, Variants,"#13#10 +
       "This is a test log message."#13#10 +
       ""#13#10 +
       "{Windows, Messages, SysUtils, Variants, "#13#10 +
       "Classes, Graphics, Controls, Forms}, Windows,"#13#10 +
       "Messages, SysUtils, Variants,"#13#10 +
       "Classes, Graphics, Controls, Forms}"#13#10;

     MAX_LOG = 1000;

procedure TForm1.FormCreate(Sender: TObject);
var
i: integer;
s: string;
begin
 cxMemo1.Properties.WordWrap := false;
 cxMemo2.Properties.WordWrap := false;
 cxMemo3.Properties.WordWrap := false;

 for i := 1 to MAX_LOG do
 begin
   s := s + GetMsg + #13#10;
 end;

 cxMemo1.Text := CropLog(s);
 cxMemo2.Text := CropLog(s);
 cxMemo3.Text := CropLog(s);
end;

function TForm1.CropLog(const Log: string): string;
var crlfCount: integer;
     i: integer;
begin
   crlfCount := 0;
   for i := Length(Log)-1 downto 1 do
   begin
     if (Log[i] = #13) and (Log[i+1] = #10) then
        inc(crlfCount);
     if crlfCount >= MAX_LOG then
       break;
   end;

   result := copy(Log, i, Length(Log)-i);

end;

function TForm1.GetMsg: string;
begin
if Random(20) = 10 then
   result := Msg2  else
   result := Msg
end;

procedure TForm1.AddToLog(m: TCxMemo; s: string);
begin
 s := FormatDateTime("[dd.mm.yyyy hh:mm:ss]: ", Now ) + s;
 with m do
 begin
   Lines.BeginUpdate;
   try
     while (Lines.Count > MAX_LOG) do
        Lines.Delete(0);
     Lines.Append(s);
   finally
     Lines.EndUpdate;
     m.InnerControl.Perform(WM_VSCROLL, SB_BOTTOM ,0);
   end;
 end; //with
end;

procedure TForm1.Button1Click(Sender: TObject);
var
 c: cardinal;
begin

 c := GetTickCount();
 while true do
 begin
   if (GetTickCount()-c > 2000) then
   begin
     c := GetTickCount();
     PostMessage(Handle, WM_USER, 0,0);
   end; //if
      Application.ProcessMessages;
 end; //while

end;

procedure TForm1.cxMemo1PropertiesEditValueChanged(Sender: TObject);
begin
 Caption := Format("%d %d %d",
  [cxMemo1.Lines.Count,
   cxMemo2.Lines.Count,
   cxMemo3.Lines.Count]);
end;

procedure TForm1.DoCalc(var Msg: TMessage);
var
 i: integer;
 s: string;
begin
     for i := 1 to 54 do
     begin
       s := getMsg;

        case random(3) of
        0:
          AddToLog(cxMemo1, copy(s,1, Length(s) - random(50)));
        1:
          AddToLog(cxMemo2, copy(s,1, Length(s) - random(80)));
        2:
          AddToLog(cxMemo3, copy(s,1, Length(s) - random(90)));
        end; //case;

     end; //for
end;

end.


А у меня в проекте реально думает довольно долго - ставлю брякпоинт на строчке Delete(0); жму F8 - почти секунду думает. Причем все в основном потоке. Комментировал лишние действия, вырубал все другие таймеры, потоки. Все равно долго удаляет строчку. Буду разбираться в общем.

---

← →
ketmar ©   (2008-06-02 12:16) [15]

>[14] Style © (2008-06-02 12:08:00)
>ставлю брякпоинт на строчке Delete(0); жму F8 — почти секунду думает
удивись — все бряки долго думают. потому что tracing до нужного адреса.

---
All Your Base Are Belong to Us

---

← →
ketmar ©   (2008-06-02 12:17) [16]

>[15] ketmar © (2008-06-02 12:16:00)
в смысле — все послебряковые F8, извиняюсь.

---
All Your Base Are Belong to Us

---

← →
Style ©   (2008-06-02 12:47) [17]

> в смысле — все послебряковые F8, извиняюсь.


Ну в этом случае и F7 тоже.
другое дело что после отключения этой строчки все работает как надо. Никаких событий на Memo не висит. В общем где-то зарылась злая бага.

---

← →
tesseract ©   (2008-06-02 13:02) [18]

>  В общем где-то зарылась злая бага.


Не зарылась бага, а недокапался профайлер.
Посмотри на реализацию Delete(0). В ТMemoryStrings. Как вариант накатать своего наследника с фиксированной длиной строки и через Move уже смещать твои строки.

---

← →
ketmar ©   (2008-06-02 14:09) [19]

>[17] Style © (2008-06-02 12:47:00)
ога. а если из кода убрать всё ероме being и end — бдет вообще молниеносно.

---
Understanding is not required. Only obedience.

---

← →
Style ©   (2008-06-02 15:27) [20]

> Посмотри на реализацию Delete(0). В ТMemoryStrings

Это что за зверь такой?


> Как вариант накатать своего наследника с фиксированной длиной
> строки и через Move уже смещать твои строки.


Не могу представить как быстро накатать наследника TMemo с такими свойствами.


> >[17] Style © (2008-06-02 12:47:00)
> ога. а если из кода убрать всё ероме being и end — бдет
> вообще молниеносно.


только вот нафига она нужна такая программа?

Читайте Style ©   (02.06.08 12:08) [14]

delete - нормально отрабатывает.
Значит у меня проблема не в этом.

---

← →
tesseract ©   (2008-06-02 15:56) [21]

> Это что за зверь такой?


Это такой класс, в котором tMemo строки держит. Т.Е если по одной удалять (как у тебя сейчас происходит) То очень медленно получаеться. Или как вариант накатать свой "Tmemo" - только без вомзодности редактирования. День пторатишь, но зато уберёшь тормоза.


> Значит у меня проблема не в этом.


Профайлером глянь. И предмет утечки сразу увидишь и где стопор.

---

← →
Умищ   (2008-06-02 16:05) [22]

Вот блин. и тут АП поработал - все полезные постинги удалил.
Слов нет. Не хочется вслух говорить, что сказать о нём можно.
Слово "Дебилизм" - это самое мягкое из всех.

---

← →
Style ©   (2008-06-02 16:10) [23]

>
> Это такой класс, в котором tMemo строки держит. Т.Е если
> по одной удалять (как у тебя сейчас происходит) То очень
> медленно получаеться. Или как вариант накатать свой "Tmemo"
> - только без вомзодности редактирования. День пторатишь,
>  но зато уберёшь тормоза.


Ну класс-то называется TMemoStrings а не TMemoryStrings -  а удаление первой строчки осуществляется - заменой выделенного фрагмента - посылкой сообщения EM_REPLACESEL. Все же пока не вижу необходимости писать свой вьювер. К тому же мне нужно чтобы можно было текст выделить, и скопировать в буфер обмена. А это уже не день работы. Поищу причину тормозов при удалении.

---

← →
Умищ   (2008-06-02 16:13) [24]

> Style ©   (02.06.08 16:10) [23]

На всякий сучай попробуй без with memo do ;)

---

← →
tesseract ©   (2008-06-02 16:19) [25]

> А это уже не день работы. Поищу причину тормозов при удалении.


Нашёл таки, у  тебя когда ты строчки удаляешь - они удаляються по одной. Попробуй выделить оптом 100 первых и удалить :-D

Есть вариант, что происходит блокирование добавление Tmemo при считывании с порта ( Synchronize  например ждёт свой очереди)  И тд и тп.

---

← →
wicked ©   (2008-06-02 16:19) [26]

TListBox + виртуальные строки
а выделять мышкой можно и так - ставим multiselect и рядом кнопку "копировать в буффер"

---

← →
Style ©   (2008-06-02 16:41) [27]

>
> Нашёл таки, у  тебя когда ты строчки удаляешь - они удаляються
> по одной. Попробуй выделить оптом 100 первых и удалить :
> -D


В Style ©   (02.06.08 12:08) [14] тоже удаляется по одной
- но не тормозит.

Хотя мысль - что если переписать
TMemoStrings.Delete на Delete(Index, Count: Integer); И раз в 200 записей вызывать ее.


> Есть вариант, что происходит блокирование добавление Tmemo
> при считывании с порта ( Synchronize  например ждёт свой
> очереди)  И тд и тп.

 Чтение и журналы в одном потоке. Никто своей очереди не ждет - отдельным потоком идет только таймер (откуда уже посылаются основному потому сообщения ) PostMessage, что мол пора опрашивать устройства.


> TListBox + виртуальные строки
> а выделять мышкой можно и так - ставим multiselect и рядом
> кнопку "копировать в буффер"


Не совсем удобно. т.к. запись в журнале не однострочная - может быть и многострочная . Придется бить на строки при добавлении в List.Items
Но если с memo ничего не получится - попробую и этот вариант.

---

← →
tesseract ©   (2008-06-02 20:25) [28]

> PostMessage, что мол пора опрашивать устройства.


Очень тупиковый путь. Это на асинхронку не тянет. Асинхронный всегда слушает / записывает - а вывод, он потом сам обработаеться.

---

← →
Loginov Dmitry.   (2008-06-03 00:03) [29]

> > Есть вариант, что происходит блокирование добавление Tmemo
> > при считывании с порта ( Synchronize  например ждёт свой
> > очереди)  И тд и тп.
>
>  Чтение и журналы в одном потоке. Никто своей очереди не
> ждет - отдельным потоком идет только таймер (откуда уже
> посылаются основному потому сообщения ) PostMessage, что
> мол пора опрашивать устройства.


Я че-та так и не постиг твоего способа ведения логов. Логи что, ведутся только в основном потоке? Опрос тучи устройство тоже в нем же? О какой тогда скорости разговор может быть?

---

← →
Style ©   (2008-06-03 00:43) [30]

Так вот о чем и речь. Что никакой асинхронности сейчас нет. Поэтому записать в TMemo строчку и удалить лишние  ничего процессу не мешает. Я специально все другие потоки отключил и разбираюсь с Memo. И устройств сейчас никаких нет - просто написал свою функцию


function _ReadFile(hFile: THandle; var fBuf; nNumberOfBytesToRead: DWORD;
   var lpNumberOfBytesRead: DWORD; lpOverlapped: POverlapped): BOOL;
type
TBuf = array[1..4] of byte;
PBuf = ^TBuf;
var
 a: shortint;
 b: byte;
begin
     if random(100) = 1 then
     begin
      TBuf(fbuf)[1] := random(255);
      TBuf(fbuf)[2] := random(255);
     end else
     begin
      TBuf(fbuf)[1] := 255;
      TBuf(fbuf)[2] := 241;
     end;

     a := trunc((dataCommon.RandMin) + random(trunc((dataCommon.RandMax-dataCommon.RandMin))));
     b := random(255);
     TBuf(fbuf)[3] := (a);
     TBuf(fbuf)[4] := (b);

     lpNumberOfBytesRead := 4;
     result := true;
end;


и имитирую работу устройств.

В общем теперь сделал я отсечение лишнего следующим образом.



MAX_LOG = 1000;
MAX_LOGCUT = 1200;

procedure DeleteLinesFrom(Control: TWinControl;Index, Count: integer);
const
 Empty: PChar = "";
var
 SelStart, SelEnd: Integer;
begin
 SelStart := SendMessage(Control.Handle, EM_LINEINDEX, Index, 0);
 if SelStart >= 0 then
 begin
   SelEnd := SendMessage(Control.Handle, EM_LINEINDEX, Index + Count, 0);
   if SelEnd < 0 then SelEnd := SelStart +
     SendMessage(Control.Handle, EM_LINELENGTH, SelStart, 0);
   SendMessage(Control.Handle, EM_SETSEL, SelStart, SelEnd);
   SendMessage(Control.Handle, EM_REPLACESEL, 0, Longint(Empty));
 end;
end;

   if memo <> nil then
   with Memo do
   begin
      Lines.BeginUpdate;
      try
       if (Lines.Count > MAX_LOGCUT) then
          DeleteLinesFrom(Memo.InnerControl, 0, Lines.Count - MAX_LOG);
       Lines.Append(Str);
      finally
        Lines.EndUpdate;
       if Application.MainForm <> nil then begin
            Memo.InnerControl.Perform(WM_VSCROLL, SB_BOTTOM ,0);
        end;
      end;
   end; //with



все работает шустро. Но память теперь снова растет :(
Установил период опроса устройств 1 в секунду для наглядности.
В итоге за час работы программы Private bytes выросло с 10 до 32 метров. Ну и так наглядно растет по 400 кб в 2 минуты.
Что это - дефрагментация?  Опять же при комментировании вышестоящего кода - программа ничего не отжирает.
Пытался после каждого обновления и внутренний буфер отмены чистить. SendMessage(Memo.InnerControl.Handle, EM_EMPTYUNDOBUFFER, 0, 0); Бестолку.
Для NT есть еще сообщения EM_GETHANDLE и EM_SETHANDLE - якобы можно Edit"у свой указатель на область памяти прислать. Сейчас попробую установить свой и посмотреть что будет.

---

← →
Loginov Dmitry ©   (2008-06-03 01:19) [31]

Ради интереса провел куда более простой тест (со своим логгером):


procedure TForm1.WMLogMessage(var Msg: TMessage);
begin
 Memo1.Lines.BeginUpdate;
 try
   Memo1.Lines.Text := Memo1.Lines.Text + ALog.GetStringListBufferText();
   while Memo1.Lines.Count > 500 do
     Memo1.Lines.Delete(0);

   caption := inttostr(Memo1.Lines.Count);
 finally
   Memo1.Lines.EndUpdate;
 end;
end;


добавление в Мемо делаю из 50 потоков (в каждом из них - Sleep(200))
сотню/две строк в секунду добавляет. (при Sleep(100) не работает, основной поток просто вешается :) В этом плане TListBox оказался лучше, в нем отрисовка летает, несмотря на то, что остальные все контролы повисли :).

---

← →
Style ©   (2008-06-03 09:57) [32]

> (при Sleep(100) не работает, основной поток просто вешается
> :)
Видимо потокам приоритет ниже основного поставить надо.

А у меня походу это из-за cxMemo (из DevExpress) - поменял его на Memo - перестал отъедать память. Ну покрайней мере на много меньше. В ProcessXP сморю Page Faults Delta значительно уменьшился. Да и всю ночь программа работала с периодом опроса раз в секунду, память(Private bytes) выросла с 25 до 30 метров. Меня это вполне устраивает. т.к. в рабочем варианте программа опрашивает устройства раз в минуту.
Так что для Memo удалять наверное лучше как в Style ©   (03.06.08 00:43) [30] и все нормально работает.
Всем спасибо. Извиняюсь за отнятое время.

---

Страницы: 1 вся ветка

Форум: "Прочее";
Текущий архив: 2008.07.20;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.59 MB
Время: 0.045 c