Discussion :

[BuzzLeclaire]

Bonjour à toutes et à tous,

Je dois doit créer un outils permettant chaque matin vers 01h00 du matin, envoyé des données sur un serveur FTP.

J'ai pensé créer un service (TService) mais je ne sais pas où mettre mon code

OnStart ? OnExecute ?, je comprends pas bien l'aide qui parle de thread alors que je ne créer pas de thread.

De plus pour le déclenchement je pensais utilisé un timer dans le service ?

Dernière chose est'ce que TService ce programme pareil q'un projet classique ?

Merci à vous.

[BuzzLeclaire]

Comme c'est mon premier service, je voudrais pas me planter..

Voilà où j'en suis :

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
unit Principal;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs, IniFiles,
  Registry, ExtCtrls, DateUtils;
 
type
  TServiceAA = class(TService)
    Timer1: TTimer;
    procedure ServiceCreate(Sender: TObject);
    procedure ServiceDestroy(Sender: TObject);
    procedure ServiceExecute(Sender: TService);
    procedure ServiceAfterInstall(Sender: TService);
    procedure Timer1Timer(Sender: TObject);
  private
    { Déclarations privées }
  public
    function GetServiceController: TServiceController; override;
    { Déclarations publiques }
  end;
 
var
  ServiceAA: TServiceAA;
  Soc : TStringList;
  CheminServeur: String;
  Societes : String;
  Interval : Integer;
  HeuresTravaux : Integer;
 
implementation
 
{$R *.DFM}
 
procedure ServiceController(CtrlCode: DWord); stdcall;
begin
  ServiceAA.Controller(CtrlCode);
end;
 
function TServiceAA.GetServiceController: TServiceController;
begin
  Result := ServiceController;
end;
 
procedure TServiceAA.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\' + Name, false) then
    begin
      Reg.WriteString('Description', 'Application permettant d''envoyer les lignes de BL J-1 sur le serveur de AA.');
      Reg.CloseKey;
    end;
  finally
    Reg.Free;
  end;
end;
 
procedure TServiceAA.ServiceCreate(Sender: TObject);
Var
  Fini : TIniFile;
begin
// Récupération d'information sur les bases de données
 
  Soc := TStringList.Create;
  Soc.Delimiter := ';';
  Fini := TIniFile.Create('\\xxxxx\GEST\AA\AA.ini.txt');
  With Fini do
  begin
    Try
      CheminServeur  := ReadString('CSV','CheminServeur','\\xxxxx\SOFT\GEST');
      Societes          := ReadString('CSV','Soc','Sa;Sb;Sg;Sh;Sy');
      Interval          := ReadInteger('CSV','Interval',40000);
      HeuresTravaux     := ReadInteger('CSV','HeuresTravaux',1);
      Soc.DelimitedText := Societes;
      Soc.Sort;
    finally
      Fini.Free;
    end;
  end;
 
end;
 
procedure TServiceAA.ServiceDestroy(Sender: TObject);
begin
  Soc.Free;
end;
 
procedure TServiceAA.ServiceExecute(Sender: TService);
begin
//*** Programme principal
  Timer1.Interval := Interval;
  Timer1.Enabled := True;
end;
 
procedure TServiceAA.Timer1Timer(Sender: TObject);
begin
  if (HourOfTheDay(Now)=HeuresTravaux) and (Timer1.Tag=0) then
  begin
    Timer1.Tag:=1;
 
      // Mon travail
    // 1) Lecture des base MDB
    // 2) conception du fichier à envoyé
    // 3) Envoi FTP
  end else Timer1.Tag:=0;
end;
 
end.

MErci

[skywaukers]

Bonjour,

pourquoi ne pas faire une application console et la lancer par le planificateur de tâches ? C'est à mon avis plus adapté à votre besoin.

@++
Dany

[BuzzLeclaire]

Merci Jedi je garde cela au cas où.

Sinon, mon service à des problèmes

Lorsque je l'installe, il est marqué comme automatique, mais il ne ce passe rien du tout. Si je le lance manuellement "Démarrer" il s'arrête avec un message

Le service xxxxxxx a démarré et s'est ensuite arrêté. Certains services s'arrêtent automatiquement s'ils ne sont pas utilisés par d'autres services ou programmes

Bon je me suis dis qu'il y avait un bug dans mon algo, alors j'ai ajouté cela :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
procedure TServiceAA.ServiceStart(Sender: TService; var Started: Boolean);
Var
Soc : TStringList;
begin
    Soc := TStringList.Create;
    Soc.Delimiter := ';';
    Soc.DelimitedText := Societes;
    Soc.Sort;
    Soc.SaveToFile('c:\XXXX\GEST\SOC.CSV');
 
end;

J'ai relancer le service, puis redémarrer a la main, j'ai toujours le même message mais mon fichier CSV est bien créé.

Si je fais la même chose dans un timer il fait rien.

J'ai du mal à comprendre le démarrage.

Qui connais ?

[Andnotor]

La réponse est assez simple
Il démarre bien, mais un service est comme un thread : Execute est appelé une fois et à sa sortie, le service est arrêté.

Donc, il ne faut pas sortir de Execute

Code :

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

1
2
3
4
5
procedure TMonService.ServiceExecute(Sender: TService);
begin
  while not Terminated do
    ServiceThread.ProcessRequests(TRUE); //Attend l'ordre de fermeture
end;

Ensuite, plutôt que de tester dans le timer : Est-ce l'heure ou pas ?
Fixe directement l'intervalle correct. Soit "l'heure souhaitée" - "maintenant". (A recalculer aussi dans OnTimer)

Code :

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

1
2
3
4
5
6
7
procedure TMonService.ServiceExecute(Sender: TService);
begin
  Timer1.Interval := MilliSecondsBetween(Now, ...);
 
  while not Terminated do
    ServiceThread.ProcessRequests(TRUE); //Attend l'ordre de fermeture
end;

ps: J'aurais aussi juste créé une tâche planifiée

[Ph. B.]

Bonjour BuzzLeclaire,

J'ai ressorti un code similaire que j'avais dans mes archives pour traiter de manière automatique des notifications envoyés par mail. Je l'ai adapté a ce que vous aviez proposé.
Maniaque comme je suis, j'ai également déplacé du code afin que cela soit plus propre... J'ai ajouté un préfixe dans les balises de commentaire pour le mettre en évidence. J'ai laissé la procédure ServiceExecute bien qu'elle ne serve plus, et intégré les cas où on suspend puis relance le service.
J'ai retiré la référence à Timer.tag ; à rajouter suivant les besoins...
Le code et ci-après :

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
unit Principal;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, IniFiles,
  Registry, ExtCtrls, DateUtils;
 
type
  TServiceAA = class(TService)
    Timer1: TTimer;
    procedure ServiceCreate(Sender: TObject);
    procedure ServiceDestroy(Sender: TObject);
    procedure ServiceStart(Sender: TService; var Started: Boolean);
    procedure ServiceStop(Sender: TService; var Stopped: Boolean);
    procedure ServicePause(Sender: TService; var Paused: Boolean);
    procedure ServiceContinue(Sender: TService; var Continued: Boolean);
    procedure ServiceExecute(Sender: TService);
    procedure ServiceAfterInstall(Sender: TService);
    procedure Timer1Timer(Sender: TObject);
  private
    { Déclarations privées }
    FIsRunning: Boolean;
    // Variables provenant de la section interface
    Soc: TStringList;
    CheminServeur: String;
    Societes: String;
    Interval: Integer;
    HeuresTravaux: Integer;
    //
    procedure InitParametres;
    procedure Traitements;
  public
    { Déclarations publiques }
    function GetServiceController: TServiceController; override;
  end;
 
var
  ServiceAA: TServiceAA;
//PB//  Soc : TStringList;
//PB//  CheminServeur: String;
//PB//  Societes : String;
//PB//  Interval : Integer;
//PB//  HeuresTravaux : Integer;
 
implementation
 
{$R *.DFM}
 
procedure ServiceController(CtrlCode: DWord); stdcall;
begin
  ServiceAA.Controller(CtrlCode);
end;
 
function TServiceAA.GetServiceController: TServiceController;
begin
  Result := ServiceController;
end;
 
procedure TServiceAA.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\' + Name, false) then
    begin
      Reg.WriteString('Description', 'Application permettant d''envoyer les lignes de BL J-1 sur le serveur de AA.');
      Reg.CloseKey;
    end;
  finally
    Reg.Free;
  end;
end;
 
procedure TServiceAA.ServiceCreate(Sender: TObject);
//PB//Var
//PB//  Fini : TIniFile;
begin
  FIsRunning := False;
  Timer1.Enabled := False;
//PB// déplacé dans la procedure InitParametres appelée lors du démarrage du service
//PB//// Récupération d'information sur les bases de données
//PB//
//PB//  Soc := TStringList.Create;
//PB//  Soc.Delimiter := ';';
//PB//  Fini := TIniFile.Create('\\xxxxx\GEST\AA\AA.ini.txt');
//PB//  With Fini do
//PB//  begin
//PB//    Try
//PB//      CheminServeur  := ReadString('CSV','CheminServeur','\\xxxxx\SOFT\GEST');
//PB//      Societes          := ReadString('CSV','Soc','Sa;Sb;Sg;Sh;Sy');
//PB//      Interval          := ReadInteger('CSV','Interval',40000);
//PB//      HeuresTravaux     := ReadInteger('CSV','HeuresTravaux',1);
//PB//      Soc.DelimitedText := Societes;
//PB//      Soc.Sort;
//PB//    finally
//PB//      Fini.Free;
//PB//    end;
//PB//  end;
end;
 
procedure TServiceAA.ServiceDestroy(Sender: TObject);
begin
  Soc.Free;
end;
 
procedure TServiceAA.ServiceExecute(Sender: TService);
begin
//PB////*** Programme principal
//PB//  Timer1.Interval := Interval;
//PB//  Timer1.Enabled := True;
end;
 
procedure TServiceAA.Timer1Timer(Sender: TObject);
begin
  if not FIsRunning then
  begin
    // On désactive le timer tant que le traitement n'est pas terminé
    FIsRunning := True;
    Timer1.Enabled := False;
    try
      // Lancer le traitement
      Traitements;
    finally
      FIsRunning := False;
      Timer1.Enabled := True;
    end;
  end;
//PB// déplacé dans la procedure Traitements
//PB//  if (HourOfTheDay(Now)=HeuresTravaux) and (Timer1.Tag=0) then
//PB//  begin
//PB//    Timer1.Tag:=1;
//PB//
//PB//      // Mon travail
//PB//    // 1) Lecture des base MDB
//PB//    // 2) conception du fichier à envoyé
//PB//    // 3) Envoi FTP
//PB//  end else Timer1.Tag:=0;
end;
 
procedure TServiceAA.ServiceStart(Sender: TService; var Started: Boolean);
begin
  InitParametres;
  Timer1.Enabled := True;
  Started := True;
end;
 
procedure TServiceAA.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
  Timer1.Enabled := False;
  Stopped := True;
end;
 
procedure TServiceAA.ServicePause(Sender: TService; var Paused: Boolean);
begin
  Timer1.Enabled := False;
  Paused := True;
end;
 
procedure TServiceAA.ServiceContinue(Sender: TService; var Continued: Boolean);
begin
  Timer1.Enabled := True;
  Continued := True;
end;
 
procedure TServiceAA.InitParametres;
var
  FIni: TIniFile;
begin
  // Traitement inactif au démarrage
  FIsRunning := False;
 
// Récupération d'information sur les bases de données
 
  Soc := TStringList.Create;
  Soc.Delimiter := ';';
  Fini := TIniFile.Create('\\xxxxx\GEST\AA\AA.ini.txt');
  With Fini do
  begin
    Try
      CheminServeur     := ReadString('CSV', 'CheminServeur', '\\xxxxx\SOFT\GEST');
      Societes          := ReadString('CSV', 'Soc', 'Sa;Sb;Sg;Sh;Sy');
      Interval          := ReadInteger('CSV', 'Interval', 40000);
      HeuresTravaux     := ReadInteger('CSV', 'HeuresTravaux', 1);
      Soc.DelimitedText := Societes;
      Soc.Sort;
      Soc.SaveToFile('c:\XXXX\GEST\SOC.CSV');
      // Paramétrer le timer
      Timer1.Interval := Interval;
    finally
      Fini.Free;
    end;
  end;
end;
 
procedure TServiceAA.Traitements;
begin
//PB//  if (HourOfTheDay(Now) = HeuresTravaux) and (Timer1.Tag = 0) then
//PB//  begin
//PB//    Timer1.Tag := 1;
  if HourOfTheDay(Now) = HeuresTravaux then
  begin
    // Mon travail
    // 1) Lecture des base MDB
    // 2) conception du fichier à envoyé
    // 3) Envoi FTP
  end;
//PB//  end else Timer1.Tag := 0;
end;
 
end.

Bonne lecture !

[BuzzLeclaire]

@AndNotOr

En cherchant sur le net je suis tombé sur ce que tu as donné, j'aurai dû revenir plutôt

@Ph. B.
Au moment où je répond, je voit ton topic 'en dessous" et incroyable regarde ce que j'ai fais :

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
unit Principal;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs, IniFiles,
  Registry, ExtCtrls, DateUtils, DB, ADODB;
 
type
  TServiceAA = class(TService)
    Timer1: TTimer;
    Cnx: TADOConnection;
    Qry: TADOQuery;
    procedure ServiceCreate(Sender: TObject);
    procedure ServiceExecute(Sender: TService);
    procedure ServiceAfterInstall(Sender: TService);
    procedure Timer1Timer(Sender: TObject);
    procedure ServicePause(Sender: TService; var Paused: Boolean);
    procedure ServiceStart(Sender: TService; var Started: Boolean);
    procedure ServiceContinue(Sender: TService; var Continued: Boolean);
    procedure ServiceStop(Sender: TService; var Stopped: Boolean);
  private
    { Déclarations privées }
    procedure LectureIni;
    procedure Log(Msg: String);
  public
    function GetServiceController: TServiceController; override;
    { Déclarations publiques }
  end;
 
var
  ServiceAA: TServiceAA;
  CheminServeur: String;
  Societes, Tables : String;
  Interval : Integer;
  HeuresTravaux : Integer;
  TypeEnvoi : String;
  // Serveur FTP
  LigneEntete : Boolean;
  FTPAdresse : String;
  FTPPassword: String;
  FTPLogin   : String;
  Requete : String;
 
 
implementation
 
{$R *.DFM}
 
procedure TServiceAA.LectureIni;
var
  Reg: TRegistry;
begin
  Log('(Deb) - AfterInstall : Création de clé de registre ['+ FormatDateTime('dd/mm/yyyy hh:nn:ss',Now()) +']');
  Try
    Reg := TRegistry.Create(KEY_READ or KEY_WRITE);
    try
      Reg.RootKey := HKEY_LOCAL_MACHINE;
      if Reg.OpenKey('\SYSTEM\CurrentControlSet\Services\' + Name, false) then
      begin
        Reg.WriteString('Description', 'Application permettant d''envoyer les lignes de BL J-1 sur le serveur de XXXXXXXX.');
        Reg.CloseKey;
      end;
    finally
      Reg.Free;
    end;
  Except
    Log('(Exception) - AfterInstall : Création de clé de registre ['+ FormatDateTime('dd/mm/yyyy hh:nn:ss',Now()) +']');
  End;
  Log('(Fin) - AfterInstall : Création de clé de registre ['+ FormatDateTime('dd/mm/yyyy hh:nn:ss',Now()) +']');
 
end;
 
procedure TServiceAA.Log(Msg: String);
Var
  F: TextFile;
begin
  AssignFile(F,'XXXXXXXXXX');
  Append(F);
  WriteLn(F,Msg);
  CloseFile(F);
end;
 
procedure ServiceController(CtrlCode: DWord); stdcall;
begin
  ServiceAA.Controller(CtrlCode);
end;
 
function TServiceAA.GetServiceController: TServiceController;
begin
  Result := ServiceController;
end;
 
procedure TServiceAA.ServiceAfterInstall(Sender: TService);
begin
  LectureIni;
end;
 
procedure TServiceAA.ServiceCreate(Sender: TObject);
Var
  Fini : TIniFile;
begin
// Récupération d'information sur les bases de données
  Log('(Deb) - ServiceCreate : Lecture du fichier ini ['+ FormatDateTime('dd/mm/yyyy hh:nn:ss',Now()) +']');
 
  Try
    Fini := TIniFile.Create('XXXXXX\AA.ini.txt');
    With Fini do
    begin
      Try
        CheminServeur   := ReadString('CSV','CheminServeur','XXXXXXX');
        Societes        := ReadString('CSV','Soc','Sa;Sb;Sg;Sh;Sy');
 
        Tables          := ReadString('STOCK','LectureTable','LigneBlClient;LigneBlClient;LigneBlClient;LigneBlClient;LigneBlClient');
        Interval        := ReadInteger('STOCK','Interval',40000);
        HeuresTravaux   := ReadInteger('STOCK','HeuresTravaux',1);
        LigneEntete     := ReadBool('STOCK','LigneEntete',True);
        TypeEnvoi       := ReadString('STOCK','TypeEnvoi','Fichier');
        FTPAdresse      := ReadString('STOCK','FTPAdresse','Adresse');
        FTPPassword     := ReadString('STOCK','FTPPassword','MotDePasse');
        FTPLogin        := ReadString('STOCK','FTPLogin','MotDePasse');
        Requete         := ReadString('STOCK','Requete','Select CodeArticle, Sum(Quantite) As QteLivree From %S Where (DateDocument BETWEEN :DateDeb And :DateFin) Group By CodeArticle HAVING Sum(Quantite) <> 0 ');
      finally
        Fini.Free;
      end;
    end;
  Except
    Log('(Exception) - ServiceCreate : Lecture du fichier ini ['+ FormatDateTime('dd/mm/yyyy hh:nn:ss',Now()) +']');
  End;
  Log('(Fin) - ServiceCreate : Lecture du fichier ini ['+ FormatDateTime('dd/mm/yyyy hh:nn:ss',Now()) +']');
end;
 
procedure TServiceAA.ServiceExecute(Sender: TService);
begin
//*** Programme principal
  Timer1.Enabled := True;
 
  While not Terminated do
    ServiceThread.ProcessRequests(True);// wait for termination
 
end;
 
procedure TServiceAA.ServicePause(Sender: TService; var Paused: Boolean);
begin
  Paused := True;
  Timer1.Enabled := False;
end;
 
procedure TServiceAA.ServiceStart(Sender: TService; var Started: Boolean);
begin
  Started := True;
  LectureIni;
  Timer1.Enabled := True;
  Timer1.Tag:=0;
end;
 
procedure TServiceAA.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
  Stopped := True;
  Timer1.Enabled := False;
end;
 
procedure TServiceAA.ServiceContinue(Sender: TService;
  var Continued: Boolean);
begin
  Continued := True;
  LectureIni;
  Timer1.Enabled := True;
  Timer1.Tag:=0;
end;
 
procedure TServiceAA.Timer1Timer(Sender: TObject);
Var
  i: Integer;
  Base: String;
  Soc, LectureTable, StringListFichier : TStringList;
begin
 
//  if (HourOfTheDay(Now)=HeuresTravaux) and (Timer1.Tag=0) then'
// Pour l'instant phase de test
  if (Timer1.Tag=0) then
  begin
    Log('**************> (Deb) - Timer : Démarrage du Timer ['+ FormatDateTime('dd/mm/yyyy hh:nn:ss',Now()) +']');
 
    Timer1.Tag:=1;
 
   {$REGION 'Enumération des sociétés'}
    Soc := TStringList.Create;
    Soc.Delimiter := ';';
    Soc.DelimitedText := Societes;
    Soc.Sort;
   {$ENDREGION}
    Log('(Travaux) - Timer : Structure des Sociétés ['+ FormatDateTime('dd/mm/yyyy hh:nn:ss',Now()) +'] : '+Societes);
 
   {$REGION 'Enumération des Tables à lire'}
    LectureTable := TStringList.Create;
    LectureTable.Delimiter := ';';
    LectureTable.DelimitedText := Tables;
    LectureTable.Sort;
   {$ENDREGION}
    Log('(Travaux) - Timer : Structure des Tables ['+ FormatDateTime('dd/mm/yyyy hh:nn:ss',Now()) +'] : '+Tables);
    StringListFichier := TStringList.Create;
    Try
      if LigneEntete Then StringListFichier.Add('Dossier;CodeArticle;QteLivree');
    // Mon travail
      With Cnx do
      begin
        Try
          for i := 0 to Soc.Count - 1 do
          begin
            Base   := IncludeTrailingPathDelimiter(CheminServeur)+
                         IncludeTrailingPathDelimiter(Soc.Strings[i])+
                         'xxxxxxxx.mdb';
            Connected := False;
            ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' + Base +
          ';Persist Security Info=False';
    Log('(Travaux) - Timer : ConnectionString '+ Soc.Strings[i] +' ['+ FormatDateTime('dd/mm/yyyy hh:nn:ss',Now()) +']'+#13+ConnectionString);
            LoginPrompt := False;
            Try
              Connected := True;
    Log('(Travaux) - Timer : Connection ['+ FormatDateTime('dd/mm/yyyy hh:nn:ss',Now()) +']');
              With Qry do
              begin
                SQL.Clear;
                SQL.Add(Format(Requete,[LectureTable.Strings[i]]) );
                Parameters.ParamByName('DateDeb').DataType := ftDate;
                Parameters.ParamByName('DateFin').DataType := ftDate;
                Parameters.ParamByName('DateDeb').Value := IncDay(Date,-1);
                Parameters.ParamByName('DateFin').Value := IncDay(Date,-1);
    Log('(Travaux) - Timer : Qry avant ouverture '+ Soc.Strings[i] +' ['+ FormatDateTime('dd/mm/yyyy hh:nn:ss',Now()) +']'+#13+Qry.SQL.Text);
                Open;
    Log('(Travaux) - Timer : Ouverture du Qry sur '+ Soc.Strings[i] +' ['+ FormatDateTime('dd/mm/yyyy hh:nn:ss',Now()) +']');
 
                While Not Eof do
                begin
                  StringListFichier.Add(
                            Soc.Strings[i]+
                            ';'+
                            FieldByName('CodeArticle').AsString +
                            ';'+
                            FieldByName('QteLivree').AsString );
                  next;
                end;
 
                Close;
    Log('(Travaux) - Timer : Fermeture du Qry '+ Soc.Strings[i] +'['+ FormatDateTime('dd/mm/yyyy hh:nn:ss',Now()) +']');
 
              end;
            Except
 
    Log('(Travaux) - Timer : Erreur '+ Soc.Strings[i] +' ['+ FormatDateTime('dd/mm/yyyy hh:nn:ss',Now()) +']');
 
            End;
          end;
        Finally
          Connected := False;
          Log('(Travaux) - Timer : Déconnection ['+ FormatDateTime('dd/mm/yyyy hh:nn:ss',Now()) +']');
        End;
        StringListFichier.SaveToFile('xxxxxx\test.csv');
        Log('(Travaux) - Timer : Ecritures du fichier de sortie csv ['+ FormatDateTime('dd/mm/yyyy hh:nn:ss',Now()) +']');
 
      end;
 
    Finally
      if Assigned(StringListFichier) Then StringListFichier.Free;
      if Assigned(Soc) then Soc.Free;
      if Assigned(LectureTable) then LectureTable.Free;
    End;
    Log('**************> (Fin) - Timer : Fermeture du Timer ['+ FormatDateTime('dd/mm/yyyy hh:nn:ss',Now()) +']');
  end else Timer1.Tag:=1;
end;
 
end.

Je vais regarder ton histoire de FIsRunning, procédure traitements.

[Ph. B.]

Je vais regarder ton histoire de FIsRunning, procédure traitements.

FIsRunning permet de ne pas relancer le traitement si il n'est toujours pas terminé. Si j'ai bien compris votre code, cela correspond peu ou prou au test de la valeur de Timer1.Tag
Dans ma proposition, je dirais même que FIsRunning est inutile vu que je désactive le timer tout le temps du traitement ; ce dernier ne peut donc être appelé 2 fois...

Après, le code de gestion de l'événement ServiceExecute n'apporte rien, car le traitement est déjà fait dans le code de gestion de ServiceStart (événement appelé juste avant lors de l'exécution).
Ensuite pourquoi écrire ceci dans Timer1Timer :

Code :

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

1
2
3
4
5
  if (Timer1.Tag=0) then
  begin
    // ...
  end else Timer1.Tag:=1;
  // le else n'apporte rien...

[BuzzLeclaire]

Ensuite pourquoi écrire ceci dans Timer1Timer :

En fait le if (Timer1.Tag=0) then c'est du teste le vrai c'est if (HourOfTheDay(Now)=HeuresTravaux) and (Timer1.Tag=0) then et là le else Timer1.tag :=0, as tout son sens.

[Andnotor]

...et là le else Timer1.tag :=1, as tout son sens.

Pas si l'intervalle est calculé correctement depuis le départ. (Pas plus que IsRunnning d'ailleurs )

[BuzzLeclaire]

Pas si l'intervalle est calculé correctement depuis le départ. (Pas plus que IsRunnning d'ailleurs )

Salut grand maitre AndNotor

En fait, je vais t'avoue

Code :

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

Timer1.Interval := MilliSecondsBetween(Now, ...);

J'ai rien capter, je vois pas comment le traduire pour que cela fonctionne chaque jour (sauf le dimanche) à 01h00 du mat !!!
Et l'heure bouge (heureusement abruti de buzz...) donc ton interval bouge tout le temps, a qu'elle moment il passe à true ton truc ?

Si il est 21h00 tu fais 21 en milli moins 1 en milli... donc plus on grandi dans les heures plus mon interval grandi... hmmmm
Et admettons que l'interval arrive à 0, cela ne déclenche rien ?

Mais je t'aurais un jour je t'aurais........

[Andnotor]

Quelque chose comme ceci :

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
function TForm1.StartTimer :int64;
var
  Start :TDateTime;
 
const
  Clock = 1; //1h du mat'
 
begin
  Timer1.Enabled := FALSE;
 
  //Aujourd'hui ou demain ?
  if HoursBetween(Now, IncHour(Tomorrow, Clock)) >= 24
  then Start := IncHour(Date, Clock)
  else Start := IncHour(Tomorrow, Clock);
 
  //Dimanche => jour suivant
  if DayOfWeek(Start) = 1 then
    Start := IncDay(Start);
 
  Timer1.Interval := MilliSecondsBetween(Now, Start);
  Timer1.Enabled  := TRUE;
end;

Le timer est ainsi exécuté 1x en 24h et non 1x par seconde. Tous les autres tests deviennent inutiles

[BuzzLeclaire]

Salut AndNotOr,

J'ai du mal à comprendre, si je lance mon service je vais dans ma procédure Exécute qui doit donc selon ta proposition passer le Timer à True.

Mais le Exécute tourne tout le temps ? non ? ce qui voudrait dire que je ferais sans arrêt ta procédure Starttimer et donc l'interval change toute les secondes ?

Bref, je vais essayer sa vaudra mieux, et je te dis .

Merci.

[Andnotor]

Execute n'est appelé qu'une seule fois. C'est while not terminated qui tourne en boucle et StartTimer est appelé avant. Regarde mieux mon exemple

Il faudra appeler StartTimer depuis OnExecute, OnTimer et partout où tu dois redémarrer le timer.

[BuzzLeclaire]

Execute n'est appelé qu'une seule fois. C'est while not terminated qui tourne en boucle et StartTimer est appelé avant. Regarde mieux mon exemple

Il faudra appeler StartTimer depuis OnExecute, OnTimer et partout où tu dois redémarrer le timer.

T'es vraiment un dictionnaire, c'est hallucinant.

Voilà ce que j'ai fais :

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
procedure TServiceAA.StartTimer;
var
  Start :TDateTime;
begin
  Timer1.Enabled := FALSE;
 
  //Aujourd'hui ou demain ?
  if HoursBetween(Now, IncHour(Tomorrow, HeuresTravaux)) >= 24
  then Start := IncHour(Date, HeuresTravaux)
  else Start := IncHour(Tomorrow, HeuresTravaux);
 
  //Dimanche => jour suivant
  if DayOfWeek(Start) = 1 then
    Start := IncDay(Start);
 
  Timer1.Interval := MilliSecondsBetween(Now, Start);
  Log(
  'StartTimer : Now = '+FormatDateTime('dd/mm/yy hh:nn:ss',Now)+#13+
  'StartTimer : Start = '+FormatDateTime('dd/mm/yy hh:nn:ss',Start)+#13+
  'StartTimer : Interval = '+inttostr(Timer1.Interval));
 
  Timer1.Enabled  := TRUE;
end;
 
procedure TServiceAA.ServiceExecute(Sender: TService);
begin
//*** Programme principal
  StartTimer;
 
  While not Terminated do
    ServiceThread.ProcessRequests(True);// wait for termination
 
end;
 
procedure TServiceAA.ServicePause(Sender: TService; var Paused: Boolean);
begin
  Paused := True;
  Timer1.Enabled := False;
end;
 
procedure TServiceAA.ServiceStart(Sender: TService; var Started: Boolean);
begin
  Started := True;
  LectureIni;
//  Timer1.Enabled := True;
//  Timer1.Tag:=0;
  StartTimer;
end;
 
procedure TServiceAA.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
  Stopped := True;
  Timer1.Enabled := False;
end;
 
procedure TServiceAA.ServiceContinue(Sender: TService;
  var Continued: Boolean);
begin
  Continued := True;
  LectureIni;
//  Timer1.Enabled := True;
//  Timer1.Tag:=0;
  StartTimer;
end;

[BuzzLeclaire]

Juste un p'tit topic en plus pour partager.

On peut s'apperçevoir que le timer démarre 3 secondes avant l'heure réel c'est marrant

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
StartTimer : Now = 23/11/12 17:35:50
StartTimer : Start = 23/11/12 18:00:00
StartTimer : Interval = 1449463

**************> (Deb) - Timer : Démarrage du Timer [23/11/2012 17:59:57]
(Travaux) - Timer : Structure des Sociiétés [23/11/2012 17:59:57] : scA;scT;scV;scG;scL
(Travaux) - Timer : Structure des Tables [23/11/2012 17:59:57] : LigneBL;LigneBL;LigneBL;LigneBL;LigneBL
(Travaux) - Timer : ConnectionString AAAAA15 [23/11/2012 17:59:57]
Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\xxxxx\AAAAA15\base.mdb;Persist Security Info=False
(Travaux) - Timer : Connection [23/11/2012 17:59:57]
(Travaux) - Timer : Qry avant ouverture AAAAA15 [23/11/2012 17:59:57]
Select CodeTiers, DateDocument, CodeArticle, Sum(Quantite) As QteLivree From LigneBL Where (DateDocument BETWEEN :DateDeb And :DateFin) Group By CodeTiers, DateDocument, CodeArticle HAVING Sum(Quantite) <> 0 ORDER BY CodeTiers, DateDocument;

(Travaux) - Timer : Ouverture du Qry sur AAAAA15 [23/11/2012 17:59:57]
(Travaux) - Timer : Fermeture du Qry AAAAA15[23/11/2012 17:59:57]
(Travaux) - Timer : ConnectionString AAAAA20 [23/11/2012 17:59:57]
Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\xxxxx\AAAAA20\base.mdb;Persist Security Info=False
(Travaux) - Timer : Connection [23/11/2012 17:59:57]
(Travaux) - Timer : Qry avant ouverture AAAAA20 [23/11/2012 17:59:57]
Select CodeTiers, DateDocument, CodeArticle, Sum(Quantite) As QteLivree From LigneBL Where (DateDocument BETWEEN :DateDeb And :DateFin) Group By CodeTiers, DateDocument, CodeArticle HAVING Sum(Quantite) <> 0 ORDER BY CodeTiers, DateDocument;

(Travaux) - Timer : Ouverture du Qry sur AAAAA20 [23/11/2012 17:59:57]
(Travaux) - Timer : Fermeture du Qry AAAAA20[23/11/2012 17:59:57]
(Travaux) - Timer : ConnectionString AAAAA23 [23/11/2012 17:59:57]
Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\xxxxx\AAAAA23\base.mdb;Persist Security Info=False
(Travaux) - Timer : Connection [a23/11/2012 17:59:57]
(Travaux) - Timer : Qry avant ouverture AAAAA23 [23/11/2012 17:59:57]
Select CodeTiers, DateDocument, CodeArticle, Sum(Quantite) As QteLivree From LigneBL Where (DateDocument BETWEEN :DateDeb And :DateFin) Group By CodeTiers, DateDocument, CodeArticle HAVING Sum(Quantite) <> 0 ORDER BY CodeTiers, DateDocument;

(Travaux) - Timer : Ouverture du Qry sur AAAAA23 [23/11/2012 17:59:58]
(Travaux) - Timer : Fermeture du Qry AAAAA23[23/11/2012 17:59:58]
(Travaux) - Timer : ConnectionString AAAAA24 [23/11/2012 17:59:58]
Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\xxxxx\AAAAA24\base.mdb;Persist Security Info=False
(Travaux) - Timer : Connection [23/11/2012 17:59:58]
(Travaux) - Timer : Qry avant ouverture AAAAA24 [23/11/2012 17:59:58]
Select CodeTiers, DateDocument, CodeArticle, Sum(Quantite) As QteLivree From LigneBL Where (DateDocument BETWEEN :DateDeb And :DateFin) Group By CodeTiers, DateDocument, CodeArticle HAVING Sum(Quantite) <> 0 ORDER BY CodeTiers, DateDocument;

(Travaux) - Timer : Ouverture du Qry sur AAAAA24 [23/11/2012 17:59:58]
(Travaux) - Timer : Fermeture du Qry AAAAA24[23/11/2012 17:59:58]
(Travaux) - Timer : ConnectionString AAAAA25 [23/11/2012 17:59:58]
Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\xxxxx\AAAAA25\base.mdb;Persist Security Info=False
(Travaux) - Timer : Connection [23/11/2012 17:59:58]
(Travaux) - Timer : Qry avant ouverture AAAAA25 [23/11/2012 17:59:58]
Select CodeTiers, DateDocument, CodeArticle, Sum(Quantite) As QteLivree From LigneBL Where (DateDocument BETWEEN :DateDeb And :DateFin) Group By CodeTiers, DateDocument, CodeArticle HAVING Sum(Quantite) <> 0 ORDER BY CodeTiers, DateDocument;

(Travaux) - Timer : Ouverture du Qry sur AAAAA25 [23/11/2012 17:59:58]
(Travaux) - Timer : Fermeture du Qry AAAAA25[23/11/2012 17:59:58]
(Travaux) - Timer : Déconnection [23/11/2012 17:59:58]
(Travaux) - Timer : Ecritures du fichier de sortie csv [23/11/2012 17:59:58]
**************> (Fin) - Timer : Fermeture du Timer [23/11/2012 17:59:58]

StartTimer : Now = 23/11/12 18:00:00
StartTimer : Start = 24/11/12 18:00:00
StartTimer : Interval = 86399397