Discussion :

[Euseibus]

Bonjour,

j'ai une fuite de mémoire, comme mon prog est pas long, je me permet de vous le soumettre car je ne suis pas sûr de réussir à me servir de progs sensés les détecter.

le but est d'avoir un service qui scan copie les fichiers d'un répertoire à un autre s'ils n'y sont pas déjà, et le problème est une fuite de mémoire mais je ne sais pas où :

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
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs,
  ExtCtrls, ShellApi, Inifiles, Registry, WinSvc;
 
type
  TSvArchiv = class(TService)
    Timer1: TTimer;
    procedure Timer1Timer(Sender: TObject);
    procedure ServiceStart(Sender: TService; var Started: Boolean);
    procedure ServiceAfterInstall(Sender: TService);
    procedure ServiceBeforeUninstall(Sender: TService);
    procedure ServiceStop(Sender: TService; var Stopped: Boolean);
  private
    { Déclarations privées }
  public                             
    { Déclarations publiques }
    function GetServiceController: TServiceController; override;
  end;
 
var
  SvArchiv: TSvArchiv;
  IniDelai, ErrCode : integer;
  IniTraiter, IniChemin, IniArchivage {, IniDestination} : string;
  IniLstRep, IniLstArc : TStringList;      
  RepTemp : array [0..128] of string;
  TailleTab, i : integer;
  Info : TSearchRec;
 
implementation
 
{$R *.DFM}
 
{ fonctions }       
 
function WriteLog(LogString: string): Integer;
var
  f: TextFile;
  sLOGFILE: string;
begin           
{$IOCHECKS OFF}
  sLOGFILE := 'C:\SvArchiv\SvArchiv.log';
  AssignFile(f, sLOGFILE);
  if FileExists(sLOGFILE) then
    Append(f)
  else
    Rewrite(f);
  Writeln(f, FormatDateTime('ddddd t', Now)+' '+LogString);
  CloseFile(f);          
{$IOCHECKS ON}
  result := GetLastError();
end;
 
function CreateIni:Integer;
var
  ini : TInifile;
begin
  ini := Tinifile.Create('C:\SvArchiv\SvArchiv.ini');    
  result := GetLastError();
  ini.WriteInteger('parametres','DelaiEnDixiemes',5); // délai du timer
  ini.WriteString('parametres','Traiter','TOUT'); // traiter tout ou juste la liste
  ini.WriteString('parametres','Rep_A_Traiter',''); // liste des rep a copier
  ini.WriteString('parametres','Rep_A_Archiver',''); // liste des rep a archiver
  ini.WriteString('chemins','Origine','E:\Origine\'); // chemin origine
  ini.WriteString('chemins','Archivage','E:\Archivage\'); // chemin Archivage
  ini.Free;
end;
 
function ReadIni:Integer;
var
  ini:TInifile;
begin        
{$IOCHECKS OFF}
  ini := Tinifile.Create('C:\SvArchiv\SvArchiv.ini');
  ErrCode := GetLastError();
  IniDelai := ini.ReadInteger('parametres','DelaiEnDixiemes',5)*100;
  if (IniDelai < 100) then IniDelai := 100;             
  IniTraiter := ini.ReadString('parametres','Traiter','');
  IniLstRep := TStringList.Create();
  IniLstRep.CommaText := ini.ReadString('parametres','Rep_A_Traiter','');
  IniLstRep.Sort;
  IniLstArc := TStringList.Create();
  IniLstArc.CommaText := ini.ReadString('parametres','Rep_A_Archiver','');
  IniLstArc.Sort;
  IniChemin := IncludeTrailingPathDelimiter(ini.ReadString('chemins','Origine',''));
  IniArchivage := IncludeTrailingPathDelimiter(ini.ReadString('chemins','Archivage',''));
  ini.Free;
  if (ErrCode=0) then
  begin
    if not ((IniTraiter='TOUT') or (IniTraiter='LISTE')) then
    begin
      WriteLog('Erreur du parametre Traiter (TOUT ou LISTE)');
      WriteLog(SysErrorMessage(13));
    end;
    if ((IniTraiter='LISTE') and (IniLstRep.Count = 0)) then
    begin
      WriteLog('Erreur Rep_A_Traiter manquants (separer les valeurs par des virgules)');
      WriteLog(SysErrorMessage(13));
    end;
    if ((IniChemin='') or (IniArchivage='')) then
    begin
      WriteLog('Erreur chemin manquant');
      WriteLog(SysErrorMessage(13));
    end;
  end;
{$IOCHECKS ON}
  result := ErrCode;
end;
 
{ implementation }
 
procedure ServiceController(CtrlCode: DWord); stdcall;
begin
  SvArchiv.Controller(CtrlCode);
end;
 
function TSvArchiv.GetServiceController: TServiceController;
begin
  Result := ServiceController;
end;
 
 
procedure TSvArchiv.ServiceAfterInstall(Sender: TService);
var
  Reg: TRegistry;
begin
  Reg := TRegistry.Create(KEY_READ or KEY_WRITE);
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    if Reg.OpenKey('\SYSTEM\CurrentControlSet\Services\SvArchiv', false) then
    begin
      Reg.WriteString('Description', 'Service de copie de fichiers pour archivage Gil.');
      Reg.CloseKey;
    end;
  finally
    Reg.Free;
  end;
  { Créer fichier LOG et INI }    
  CreateDir('C:\SvArchiv');
  ErrCode := WriteLog('Installation du service ...');
  if not (ErrCode=0) then
  begin
    Showmessage(SysErrorMessage(ErrCode))
  end
  else
  begin
    ErrCode := CreateIni;
    if not (ErrCode=0) then
    begin
      WriteLog('Creation fichier INI : Erreur '+IntToStr(ErrCode)+' => '+SysErrorMessage(ErrCode))
    end
    else
    begin
      WriteLog('Service installé.');
    end;
  end;
end;
 
procedure TSvArchiv.ServiceBeforeUninstall(Sender: TService);
begin
   if FileExists('C:\SvArchiv\SvArchiv.log') then DeleteFile('C:\SvArchiv\SvArchiv.log');  
   if FileExists('C:\SvArchiv\SvArchiv.ini') then DeleteFile('C:\SvArchiv\SvArchiv.ini');
end;
 
procedure TSvArchiv.ServiceStart(Sender: TService; var Started: Boolean);
begin
  WriteLog('Demarrage du service ...');
  ErrCode := ReadIni;
  if not (ErrCode=0) then
  begin
    WriteLog('Demarrage du service : Erreur '+IntToStr(ErrCode)+' => '+SysErrorMessage(ErrCode));
    WriteLog('Corriger l''erreur et redémarrer le service.');
    Timer1.Enabled := false;
  end
  else
  begin
    if not (DirectoryExists(IniChemin)) then
    begin
      WriteLog('Le répertoire a traiter n''existe pas => '+IniChemin);
      WriteLog('Corriger l''erreur et redémarrer le service.');
      Timer1.Enabled := false;
    end
    else
    begin                            
      if not DirectoryExists(IniArchivage) then CreateDir(IniArchivage);
      Timer1.Interval := IniDelai;
      Timer1.Enabled := true;
      WriteLog('Service demarré.');
    end;
  end;
end;
 
procedure TSvArchiv.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
  WriteLog('Arrêt du service ...');
  WriteLog('Service arrêté.');
end;
 
procedure TSvArchiv.Timer1Timer(Sender: TObject);
begin         
  Timer1.Enabled := false;
Try
  { effacer le contenu du rép. Archivage s'il est 18h00:03<>18h00:07 }
  if (strtoint(FormatDateTime('hhnnss', Now)) >= (180003)) and (strtoint(FormatDateTime('hhnnss', Now)) <= (180007)) then WriteLog('Effacer archivage !');  
 
  TailleTab := 0;
  i := 0;
 
  { Liste les répertoires disponibles }
  If FindFirst(IniChemin+'*.*',faAnyFile,Info)=0 Then
  Begin
    Repeat
      If Not((Info.Attr And faDirectory)=0)
        Then begin
      { C'est un répertoire }
          Inc(TailleTab);
          RepTemp[TailleTab] := Info.FindData.cFileName;
        end;
      { Il faut ensuite rechercher l'entrée suivante }
    Until FindNext(Info)<>0;
    FindClose(Info);
  End;          
 
  while i <= TailleTab do
  begin          
    if (IniTraiter = 'LISTE') then
    begin
    { rép à traiter trouvé dans la liste } 
      if not (IniLstRep.IndexOf(RepTemp[i]) = -1) then 
      begin 
        { Recherche de la première entrée du répertoire }
        If FindFirst(IncludeTrailingPathDelimiter(IniChemin+RepTemp[i])+'*.V*',faAnyFile,Info)=0 Then
        Begin
          Repeat
            If Not((Info.Attr And faDirectory)=0)
              Then begin
            { C'est un répertoire }
              end
              Else begin
                { C'est un  fichier }    
                if not (IniLstArc.IndexOf(RepTemp[i]) = -1) then 
                begin
                  { copier le rép vers l'archivage }  
                  if not DirectoryExists(IniArchivage+RepTemp[i]) then CreateDir(IniArchivage+RepTemp[i]);  
                  if not FileExists(PChar(IncludeTrailingPathDelimiter(IniArchivage+RepTemp[i])+Info.FindData.cFileName)) then
                  begin
                    CopyFile(PChar(IncludeTrailingPathDelimiter(IniChemin+RepTemp[i])+Info.FindData.cFileName), PChar(IncludeTrailingPathDelimiter(IniArchivage+RepTemp[i])+Info.FindData.cFileName), False);
                  end;   
                end;    
              end;
          Until FindNext(Info)<>0;   
          FindClose(Info);
          End;
      end;
    end
{ on traite tous les répertoires } 
    else if (IniTraiter = 'TOUT') then
    begin      
        { Recherche de la première entrée du répertoire }
        If FindFirst(IncludeTrailingPathDelimiter(IniChemin+RepTemp[i])+'*.V*',faAnyFile,Info)=0 Then
        Begin
          Repeat
            If Not((Info.Attr And faDirectory)=0)
              Then begin
            { C'est un répertoire }
              end
              Else begin
            { C'est un  fichier }   
                if not (IniLstArc.IndexOf(RepTemp[i]) = -1) then 
                begin
                { copier le rép vers l'archivage } 
                  if not DirectoryExists(IniArchivage+RepTemp[i]) then CreateDir(IniArchivage+RepTemp[i]);             
                  if not FileExists(PChar(IncludeTrailingPathDelimiter(IniArchivage+RepTemp[i])+Info.FindData.cFileName)) then
                  begin
                    CopyFile(PChar(IncludeTrailingPathDelimiter(IniChemin+RepTemp[i])+Info.FindData.cFileName), PChar(IncludeTrailingPathDelimiter(IniArchivage+RepTemp[i])+Info.FindData.cFileName), False);
                  end;
                end;   
              end;
          Until FindNext(Info)<>0;     
          FindClose(Info);
        End;               
      end;
    Inc(i);
  end;     
  FindClose(Info);
  Timer1.Enabled := true;     
Except            
  FindClose(Info);
  WriteLog(SysErrorMessage(GetLastError));
end;     
end;
 
end.

[Linkin]

A quel moment libères-tu les StringList?

[Euseibus]

Ben en fait je ne les libères pas car j'en ai besoin tout le temps et je ne les initialise qu'une seule fois au début.
Mais à chaque boucle du timer le prog prend un peu plus de mémoire. Pourtant dans cette boucle je n'instancie rien de spécial, a part le TSearchRec mais rien d'anormal, me semble-til !

[Linkin]

Je ne vois pas pour lemoment, je ferais des tests dans la journée.
Mais déjà tu peux simplifier ton code (éviter la répétition de code), en transformant le test en

Code :

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

1
2
3
 
if ((IniTraiter = 'LISTE') and not (IniLstRep.IndexOf(RepTemp[i]) = -1)) or
   (IniTraiter = 'TOUT') then

[Andnotor]

Ton service n'est pas très clair !

Ces StringList devraient définitivement être créées dans OnStart et détruites dans OnStop.

La 2ème chose est que tu n'as pas de boucle OnExecute. Ton service devrait démarrer, être exécuté une fois et quitter. OnExecute devrait être utilisé à la place du timer (un sleep dans la boucle).

J'ai comme l'impression que tu as une erreur qui entraîne un redémarage automatique du service par le système et qui te donne l'impression qu'il tourne perpétuellement, mais avec à chaque fois la création des 2 StringList qui ne sont jamais détruites .

edit: En fait je pense que tu dépasses rapidement les 129 entrées dans RepTemp avec à la clé une violation d'accès .

[Euseibus]

Re ! je prends en compte ces remarques,
mais entre-temps j'ai créé une bête fiche VCL reprenant les différentes fonctions du service avec 4 boutons, 1 pour l'install, 1 pour lancer le scan, 1 pour le stopper et 1 pour désinstaller et je l'ai lancé via MemProof : problème identique, fuite de mémoire ! mais je comprends rien au log

dans "ressources details" il me dit : VirtualAlloc reserves or commits a region of pages in the virtual address space of the calling process.
The allocated pages must be freed with VirtualFree when no longer needed.

je sais pas si ça vous aide, mais pas moi !

[Andnotor]

Ajoute ceci en début de projet:

Code :

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

ReportMemoryLeaksOnShutDown := TRUE;

et regarde ce que ça dit en quittant.

[ShaiLeTroll]

Déplace TOUS ces var globales en private de l'objet service !
cela sera déjà plus propre !

Test déjà cette modif, même reflexion que Andnotor

Code :

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

1
2
3
4
5
6
if not Assigned(IniLstRep) then
  IniLstRep := TStringList.Create();
IniLstRep.CommaText := ini.ReadString('parametres','Rep_A_Traiter','');
IniLstRep.Sort;
if not Assigned(IniLstArc) then
  IniLstArc := TStringList.Create();

C'est marrant, je dois avoir fait exactement le même genre de Service que toi, la semaine dernière
La seule différence, c'est que je dois lancer une application tiers qui récupère des fichiers d'un serveur mail, et que j'attends que le fichiers soit libres d'utilisation pour les balancer sur un autre serveur FTP
Idem Log Paranoia !

[Euseibus]

Bonjour a tous,
j'ai fait toutes les modifs hiers et j'ai laissé tourner le service toute la nuit, ce matin aucune différence de mémoire !

Merci beaucoup !