Discussion :

[franckcl]

bonjour,

J'utilise un objet TServerSocket dont j'ai écrit ma propre procedure ServerSocket.OnClientRead pour lire les packets recus.
Dans cette procedure je viens logger dans un mémo chaque trame recue (j''appelle la procedure log ci-dessous).
Lorsque le memo atteint 400 lignes, j'en supprime la moitié.
Le problème est lorsque j'arrive à 400 lignes, le temps pour vider le mémo est de 1.8 secondes (d'après mes calculs) et ce temps augmente proportionnellement avec le nombre de lignes à supprimer. Toute l'appli est donc bloquée pendant 1.8 secondes !!!

voici la procedure log:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
 
Procedure TForm.Log(S:string);
Var
  HoroDate: String;
Begin
    DateTimeToString(HoroDate, 'dd/mm/yy hh:nn:ss.zzz', now);
    S := HoroDate+ ': ' + S;
    Memo1.lines.beginupdate;
    if Memo1.lines.count>400 then
      while Memo1.lines.count>200 do Memo1.lines.delete(0);
    Memo1.lines.add(S);
    Memo1.SelStart := Memo1.Perform(EM_LINEINDEX, MaxInt, 0);
    Memo1.lines.endupdate;
    Memo1.Perform(EM_SCROLLCARET, 0, 0);
End;

Je pense qu'il y a un problème de synchro entre tache mais je n'arrive pas à le résoudre.
Si quelqu'un à la solution...
merci
Franck

[franckcl]

Après quelques essais supplémentaires je constate qu'il ne s'agit pas d'un problème de synchro mais juste le temps "normal" pour supprimer 200 lignes d'un Memo (j'ai crée une fiche avec un memo, un bouton pour ajouter 400 lignes et un autre pour en supprimer 200 et j'obtiens le même résultat).
Ce qui me parait toutefois énorme : 1.8 secondes !!
merci

[franckcl]

J'ai fait d'autres essais avec une listbox et c'est beaucoup plus rapide (16ms) je vais donc m'orienter vers ça mais j'aurais quand même bien aimé comprendre..

[franckcl]

J'ai trouvé !
Alors pour ceux qui auraient le même problème voici LA solution:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
 
  With Memo1, Lines do
  if (Count > 400) then
  begin
    i := Count - 200;
    BeginUpdate;
    SelStart  := 0;
    SelLength := Perform(EM_LINEINDEX, i, 0);
    SelText  := '';
    EndUpdate;
  end;

ceci ne prends qu'environ 15ms au lieu de 1.8s par la fonction delete(0)

[ShaiLeTroll]

As-tu remarqué une différence avec ou sens BeginUpdate ?
Certains composants ne le gère pas, comme le TMemo est plutôt orienté Text que Lines (le WordWrap pouvant en changer le comportement) on avait eu un sujet à ce propos, si je le retrouve

Le temps que je prenne le café et que je valide ma réponse, tu avais déjà choisi la TListBox que j'allais te proposer

J'ai fait une trace similaire à la tienne avec un TRichEdit colorée mais je faisais un Clear passé 1000 lignes

Déjà au lieu de faire directement l'affichage dans le OnClientRead, tu pourrais l'ajouter à une TStringList

Dans un TTimer::OnTimer ou TApplicationEvents::OnIdle (lorsque ton appli ne fait rien, pas de clavier, pas d'écran, pas de socket, ce qui arrive très souvent), tu parcours cette TStringList pour ajouter au TMemo et tu y gères ton affichage

D'ailleurs, je te conseille, de ne rien traiter dans le OnClientRead mais de déporter cela dans un Thread qui partage une TThreadList et un TEvent avec ton TServerSocket

[franckcl]

Effectivement, le beginupdate et endupdate n'ont pas une grande influence.
Je voulais un TMemo pour pouvoir récupérer facilement le contenu par copier/coller. Pour cette appli, je n'ai pas besoin de couleur mais pour une autre appli, j'ai utilisé un listbox avec des couleurs et des icones sur chaque ligne.

Et je mets de coté ce que tu m'as dit pour le TStringlist qui pourra m'être utile lorsque je vais développer une autre appli en multi-thread.

Merci pour ton aide...toujours très efficace comme d'hab !

[Dr.Who]

pas besoin d'HoroDate

penser à protéger les BeginUpdate/EndUpdate des assertions et exception avec des try finally

Null besoin dans un log de supprimer N lignes si T > MAX, on ajoute 1 on supprime 1 si le log est pleins.

Utiliser des dates au format anglais, c'est mieux pour le tris naturel :

format anglais et tris naturel :

2013-01-01
2013-01-02
2013-02-01
2013-02-02

format français et tris naturel :

01-01-2013
01-02-2013
02-01-2013
02-02-2013

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
 
  S := formatDateTime('yyyy-mm-dd hh:nn:ss.zzz', now)+ ' > ' + S;
  Memo1.lines.beginupdate;
  try
    if Memo1.lines.count > 400 then
      Memo1.lines.delete(0); // supprime 1, pas besoin d'en supprimer 200 d'un coups.
    Memo1.lines.add(S); // ajoute 1
    Memo1.SelStart := Memo1.Perform(EM_LINEINDEX, MaxInt, 0);
  finally
    Memo1.lines.endupdate;
    Memo1.Perform(EM_SCROLLCARET, 0, 0);
  end;

Version ListBox, beaucoup plus rapide :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
 
Procedure TForm13.Log(S:string);
Begin
  with ListBoxLog do
  begin
    Items.beginupdate;
    try
      if Items.count > 400 then
        Items.delete(0);
      ItemIndex := Items.add(formatDateTime('yyyy-mm-dd hh:nn:ss.zzz', now)+ ' > ' + S);
    finally
      Items.endupdate;
    end;
  end;
End;

Version TStrings indépendante :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
function Log(aLogStrings: TStrings; aLogMsg:string; const aMax: integer= 400): integer;
Begin
  with aLogStrings do
  begin
    beginUpdate;
    try
      if Count > aMax then
        Delete(0);
      result := add(formatDateTime('yyyy-mm-dd hh:nn:ss.zzz', now)+ ' > ' + aLogMsg);
    finally
      endUpdate;
    end;
  end;
End;

version unité :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
 
unit Log;
 
interface
 
uses
  Windows, SysUtils, Classes;
 
type
  TAppLogOption = (
    aloAddLast,  // add push at last line
    aloAddFirst, // add push at first line
    aloAutoSave,
    aloClearOnOpen
  );
 
  TAppLogOptions = set of TAppLogOption;
 
  const
    AppLogDefaultSizeLimit = 2*1024*1024; // 2Mo
 
type
  TAppLog = class
  private
    fLog       : TStringList;
    fFileName  : TFileName;
    fSizeLimit : int64;
    fOptions   : TAppLogOptions;
    fTick      : LongWord;
    fOnChange  : TNotifyEvent;
  protected
    procedure Load;
    procedure Save;
    procedure Clean;
    procedure Change;
  public
    property OnChange : TNotifyEvent   read fOnChange write fOnChange;
    property Options  : TAppLogOptions read fOptions write fOptions;
 
    function push(aMsg: string): integer;
    procedure AssignTo(aStrings: TStrings);
 
    constructor Create(const aFileName: TFileName; const aSizeLimit: int64=AppLogDefaultSizeLimit; const aOptions: TAppLogOptions = [aloAddLast, aloAutoSave]); reintroduce; virtual;
    destructor Destroy; override;
  end;
 
var
  AppLog : TAppLog;
 
implementation
 
{ TAppLog }
 
procedure TAppLog.AssignTo(aStrings: TStrings);
begin
  aStrings.Assign(fLog);
end;
 
procedure TAppLog.Change;
begin
  if assigned(fOnChange) then
    fOnChange(Self);
end;
 
procedure TAppLog.Clean;
var C: int64;
begin
  C := length(fLog.Text);
 
  while Length(fLog.Text) > fSizeLimit do
    if aloAddLast in fOptions then
      fLog.Delete(0)
    else
      fLog.Delete(fLog.Count-1);
 
  if length(fLog.Text) <> C then
    Change;
end;
 
constructor TAppLog.Create(const aFileName: TFileName; const aSizeLimit: int64; const aOptions: TAppLogOptions);
begin
  inherited Create;
 
  fFileName := aFileName;
  fSizeLimit:= aSizeLimit;
  fOptions  := aOptions;
 
  fLog := TStringList.Create;
 
  Load;
 
  Clean;
 
  fTick := GetTickCount;
end;
 
destructor TAppLog.Destroy;
begin
  fOnChange := nil;
 
  Clean;
 
  Save;
 
  fLog.Free;
  inherited;
end;
 
procedure TAppLog.Load;
begin
  if fileExists(fFileName) then
    fLog.LoadFromFile(fFileName);
 
  if aloClearOnOpen in fOptions then
    fLog.Clear;
end;
 
function TAppLog.push(aMsg: string): integer;
begin
  result := 0;
  if (aloAddLast in fOptions) or (fLog.Count = 0) then
    result := fLog.Add(aMsg)
  else
    fLog.Insert(0,aMsg);
 
  Change;
 
  if (getTickCount-fTick) >= 600000 then // clean all 10 minutes
  begin
    Clean;
    fTick := GetTickCount;
  end;
end;
 
procedure TAppLog.Save;
begin
  if aloAutoSave in fOptions then
    fLog.SaveToFile(fFileName);
end;
 
 
 
initialization
  AppLog := TAppLog.Create(ChangeFileExt(ParamStr(0),'.log'));
 
finalization
  AppLog.Free;
 
end.

[franckcl]

Merci Dr Who pour tous ces détails très intéressant.
Juste une petite remarque concernant la version Unit, si quelqu'un l'utilise, il faut faire attention à l'utilisation de GetTickCount qui est un DWORD et donc qui repasse à zéro tous les 50 jours environ, il faut donc en tenir compte si le PC sur lequel tourne le soft n'est pas rebouté tous les 50 jours mini.

Franck

[Dr.Who]

49.71 jours précisement

il est vrai que j'aurais pus mettre un TDateTime plutôt ... ou baser le clean sur un nombre minimum de push, tout les 10 ou 20 push par exemple ...