Mar
01
|
Suite à mes problèmes liés à Free, j’ai décidé de me faire une petite application DelphiW pour logger mes coupures… cela permettra d’investiguer de façon plus fine…
Le principe est simple :
- Créer un Service WindowsW qui se lance au démarrage d’une machine qui est toujours allumée…
- Vérifier à intervalles réguliers si la connexion est disponible :
- Toutes les 5 minutes, je pingueW free.fr et je stocke le résultat dans un fichier journalier (ça marche ou pas).
- Si cela ne marche pas, je vérifie alors toutes les 15 secondes…
- Dès que cela remarche au bout d’une dizaine de fois, je repasse à un intervalle de 5 minutes…
- Utiliser les fichiers générés avec un tableurW, type ExcelW pour tracer les heures de disponibilité/indisponibilité !
Pour ceux que cela intéresse, le code est ci-dessous…
J’ai simplement créé un nouveau projet application Service, dans lequel j’ai ajouté 2 composants :
- 1 TTimer pour vérifier régulièrement et pas coder mon propre threadW…
- 1 TIdIcmpClient pour pinguer le serveur de Free…
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 | unit main; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs, ExtCtrls, IdBaseComponent, IdComponent, IdRawBase, IdRawClient, IdIcmpClient, StrUtils, DateUtils; const LONG_INTERVAL = 300000; SHORT_INTERVAL = 15000; SHORT_RETRY = 10; type TConnectionLoggerService = class(TService) tmrCheck: TTimer; idcmpclntPinger: TIdIcmpClient; procedure ServiceExecute(Sender: TService); procedure tmrCheckTimer(Sender: TObject); procedure ServicePause(Sender: TService; var Paused: Boolean); procedure ServiceContinue(Sender: TService; var Continued: Boolean); private { Déclarations privées } iSpeedRetry: Integer; sFileName: string; fPointer: TextFile; procedure WriteIt(sToWrite: string); function Ping(): Boolean; function AddLeadingZeroes(const iNumber: Integer; iLength: Integer = 2): string; function CheckIt: Boolean; public function GetServiceController: TServiceController; override; { Déclarations publiques } end; var ConnectionLoggerService: TConnectionLoggerService; implementation {$R *.DFM} procedure ServiceController(CtrlCode: DWord); stdcall; begin ConnectionLoggerService.Controller(CtrlCode); end; function TConnectionLoggerService.AddLeadingZeroes(const iNumber: Integer; iLength: Integer): string; begin Result := SysUtils.Format('%.*d', [iLength, iNumber]) ; end; function TConnectionLoggerService.CheckIt: Boolean; begin Result := Ping; if (Result) then begin Dec(iSpeedRetry); if (iSpeedRetry = 0) then begin tmrCheck.Interval := LONG_INTERVAL; end; end else begin iSpeedRetry := SHORT_RETRY; tmrCheck.Interval := SHORT_INTERVAL; end; WriteIt(DateTimeToStr(Now) + ';' + IfThen(Result, '1', '0')); end; function TConnectionLoggerService.GetServiceController: TServiceController; begin Result := ServiceController; end; function TConnectionLoggerService.Ping(): Boolean; begin Result := True; with idcmpclntPinger do begin try Ping(); except Result := False; Exit; end; if (ReplyStatus.ReplyStatusType <> rsEcho) then Result := False; //pas d'écho, on renvoi false. end; end; procedure TConnectionLoggerService.ServiceContinue(Sender: TService; var Continued: Boolean); begin tmrCheck.Enabled := True; WriteIt('Restarted @ ' + DateTimeToStr(Now)); Continued := True; end; procedure TConnectionLoggerService.ServiceExecute(Sender: TService); begin sFileName := ExtractFilePath(ParamStr(0)) + 'ConnectionLogger-' + IntToStr(YearOf(Now)) + '-' + AddLeadingZeroes(MonthOf(Now)) + '-' + AddLeadingZeroes(DayOf(Now)) + '.log'; WriteIt('Started @ ' + DateTimeToStr(Now)); tmrCheck.Interval := LONG_INTERVAL; // On vérifie au démarrage CheckIt; // On revérifiera à intervalles réguliers tmrCheck.Enabled := True; while not Terminated do ServiceThread.ProcessRequests(True);// wait for termination WriteIt('Stopped @ ' + DateTimeToStr(Now)); tmrCheck.Enabled := False; end; procedure TConnectionLoggerService.ServicePause(Sender: TService; var Paused: Boolean); begin tmrCheck.Enabled := False; WriteIt('Paused @ ' + DateTimeToStr(Now)); Paused := True; end; procedure TConnectionLoggerService.tmrCheckTimer(Sender: TObject); begin CheckIt; end; procedure TConnectionLoggerService.WriteIt(sToWrite: string); begin AssignFile(fPointer, sFileName); if FileExists(sFileName) then Append(fPointer) else Rewrite(fPointer); Writeln(fPointer, sToWrite); CloseFile(fPointer); end; end. |
J’l’ai implémenté pendant ma pause-déjeuner.. Merci d’être tolérant
Attention, sous VistaW, pour installer le service, il faut être administrateur (élévation des droits)… Personnellement, j’ai ouvert une console DOS en tant qu’administrateur, et j’ai installé le service (ConnectionLogger.exe /install)…
Il ne me reste plus qu’à attendre une semaine ou deux pour avoir suffisamment de données à comparer…
Si à tout hasard, vous souhaiteriez la version binaire pour l’utiliser chez vous… vous pouvez poster un commentaire…
Derniers commentaires