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
| unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs,
ExtCtrls, WinSVC, IdMessage, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient, IdMessageClient, IdSMTP;
type
TService1 = class(TService)
Timer1: TTimer;
SMTP: TIdSMTP;
MailMessage: TIdMessage;
function EnvoiDuMail(NomExpediteur, MailExpediteur, MailReponse, MailDestinataire, MailSujet, MailCorps: String) : boolean ;
procedure ServiceExecute(Sender: TService);
procedure Timer1Timer(Sender: TObject);
procedure ServiceContinue(Sender: TService; var Continued: Boolean);
private
{ Private declarations }
public
function GetServiceController: TServiceController; override;
{ Public declarations }
end;
var
Service1: TService1;
PasserSurLaPause, DejaPasserIci: Boolean;
implementation
{$R *.DFM}
{ Ouvre un service }
function ServiceOpen( SrvName : string; Machine : string = '' ) : Cardinal;
var
H_SC : SC_Handle;
begin
if ( Machine = '' ) then
H_SC := OpenSCManager( nil, nil, SC_MANAGER_ALL_ACCESS )
else
H_SC := OpenSCManager( PChar( Machine ), nil, SC_MANAGER_ALL_ACCESS );
Result := OpenService( H_SC,
PChar( SrvName ),
SC_MANAGER_ALL_ACCESS );
end;
{ Renvoi l'etat actuel du service }
function ServiceState( SrvName : string; Machine : string = '' ) : string;
var
SrvHandle : Cardinal;
SrvState : _SERVICE_STATUS;
begin
SrvHandle := ServiceOpen( SrvName, Machine );
try
if not ( QueryServiceStatus( SrvHandle, SrvState ) ) then
Result := 'Le service est inexistant !'
else
begin
case ( SrvState.dwCurrentState ) of
SERVICE_CONTINUE_PENDING : Result := 'Le service est en train d''être relancé après une opération continue';
SERVICE_PAUSE_PENDING : Result := 'le service est en train d''être relancé après une opération pause';
SERVICE_PAUSED : Result := 'Le service est en pause';
SERVICE_RUNNING : Result := 'Le service est démarré';
SERVICE_START_PENDING : Result := 'Le service est en cours de démarrage';
SERVICE_STOP_PENDING : Result := 'Le service est en cours d''arrêt';
SERVICE_STOPPED : Result := 'Le service est stoppé';
else
Result := 'Etat du service inconnu ou service inexistant !';
end;
end;
finally
CloseServiceHandle( SrvHandle );
end;
end;
function TService1.EnvoiDuMail(NomExpediteur, MailExpediteur, MailReponse, MailDestinataire, MailSujet, MailCorps: String) : boolean ;
begin
// on vide le composant message
MailMessage.BODY.clear;
IF not SMTP.Connected then begin
SMTP.Connect;
end;
// conception du Message
MailMessage.Subject := MailSujet;
MailMessage.From.Name := NomExpediteur;
MailMessage.From.Address := MailExpediteur;
MailMessage.ReplyTo.EMailAddresses := MailReponse;
MailMessage.Body.Add(MailCorps); // MailMessage est un TSringList
MailMessage.Recipients.EMailAddresses := MailDestinataire; // Je gere pas les multi adresse (pas besoin)
TRY
// Envoi du message
SMTP.Send(MailMessage);
Result := true;
Except
on E : exception do begin
// Il y a eu un blem...
result := false;
end;
end;
end;
procedure ServiceController(CtrlCode: DWord); stdcall;
begin
Service1.Controller(CtrlCode);
end;
function TService1.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;
procedure TService1.ServiceExecute(Sender: TService);
begin
PasserSurLaPause := False;
DejaPasserIci := False;
Timer1.Enabled := True;
while not Terminated do
ServiceThread.ProcessRequests(True); //attend l'ordre de fermeture
Timer1.Enabled := False;
end;
procedure TService1.Timer1Timer(Sender: TObject);
const
FileName = 'c:\logdate.txt';
var
F: TextFile;
begin
AssignFile(f,FileName);
if FileExists(FileName) then Append(f)
else
Rewrite(f);
if ServiceState('Service1') = 'Le service est en pause'
then
Begin
if Not PasserSurLaPause then
Begin
writeln(f,'à été mis en pause ' + DateTimeToStr(Now));
EnvoiDuMail('moi',SMTP.Username,SMTP.Username,'rainconnu2@free.fr','Il y a une tâche à effectuer.','Pause du service effectuée.');
PasserSurLaPause := True;
end
end
else
if not DejaPasserIci then
Begin
writeln(f,DateTimeToStr(Now));
DejaPasserIci := True;
end;
CloseFile(f);
end;
procedure TService1.ServiceContinue(Sender: TService;
var Continued: Boolean);
begin
PasserSurLaPause := False;
end;
end. |
Conseil d'utilisation (tâches planifiées)
Répondre avec citation
Envoyé par Andnotor
.
:
Partager