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. |
Satané fuite de mémoire !
Répondre avec citation
Partager