So, ich wollte jetzt nur mal eine Rückmeldung geben.
Danke an Euch für die Tipps.
@Uwe Raabe: Das mit dem NTP Server ist auch ein interessanter Gedanke. Bei Googlen hab ich allerdings immer nur Beispiele zu NTP Clients gefunden.
@kuba: Das mit der Registry ist sicher ein einfacher Weg. Man muss nur sicherstellen, dass der Lesende nicht irgendeine alte Zeit ausliest.
Ich hab das Ganze jetzt über einen Dienst und named Pipes gelöst (Dank an Bernhard Geyer). Um mir das Leben leicht zu machen und weil ich nicht so viel Zeit hatte mich in die Materie der Named Pipes einzuarbeiten hab ich die pipes.pas von Russel Jordan genommen. Gefunden hab ich die z.B.
hier. Das hab ich dann als Komponente sowohl im Dienst als auch in meiner Taskbar-Applikation verwendet. Hat sogar bei meinem betagten Delhi 5 Pro auf Anhieb funktioniert. Der Vorteil war außerdem, dass ich dann in meinem Dienst ein OnMessage-Event nutzen kann, so dass ich gar nicht selber dauernd in einer Schleife auf vorhandene Daten prüfen muss.
Delphi-Quellcode:
procedure TMyTimeSettingService.PipeServer1PipeMessage(Sender: TObject;
Pipe: Cardinal; Stream: TStream);
var
TimeVar: TSystemTime;
Daten: Array[0..1024] of Byte;
Count: Integer;
begin
for Count := 0 to 16 do Daten[Count] := 0;
Count := Stream.Size;
Stream.Read(Daten[0],Count);
if (Daten[0] = $59) then // Uhrzeitdaten beginnen bei mir mit $59
begin
FillChar(TimeVar, SizeOf(TimeVar), 0);
TimeVar.wYear := (Daten[1] *256) + Daten[2];
TimeVar.wMonth := (Daten[3] *256) + Daten[4];
TimeVar.wDayOfWeek := (Daten[5] *256) + Daten[6];
TimeVar.wDay := (Daten[7] *256) + Daten[8];
TimeVar.wHour := (Daten[9] *256) + Daten[10];
TimeVar.wMinute := (Daten[11] *256) + Daten[12];
TimeVar.wSecond := (Daten[13] *256) + Daten[14];
TimeVar.wMilliseconds := (Daten[15] *256) + Daten[16];
Daten[0] := $59; // Antwort an Sender
Daten[1] := 1;
if SetPCSystemTime(TimeVar) then
Daten[2] := 1 // Status OK
else
Daten[2] := 0; // Status False
PipeServer1.Write(Pipe,Daten,3); // 3 Bytes zurücksenden
end;
end;
Ich habe für den Stream den Typ Byte gewählt, weil meine Daten eh schon als Bytes vorliegen. Dabei hatte ich zuerst ein merkwürdiges Phänomen und zwar hatte ich zuerst als Typ Word genommen. Im OnMessage Ereignis hatte ich dann zwar die richtige Anzahl (Count). Wenn ich dann aber "Count" Anzahl Daten aus dem Stream gelesen habe, hatte ich danach nur die Hälfte der Daten, da jedes Lesen immer nur ein Byte geholt hatte. Na egal, hab's auf Typ Byte geändert und nun gehts.
Zum endgültigen Setzen der Uhrzeit verwende ich dann folgenden Code:
Delphi-Quellcode:
function SetPCSystemTime(dSysTime: TSystemTime): Boolean;
const
SE_SYSTEMTIME_NAME = 'SeSystemtimePrivilege';
var
hToken: THandle;
ReturnLength: DWORD;
tkp, PrevTokenPriv: TTokenPrivileges;
luid: TLargeInteger;
begin
Result := False;
if (Win32Platform = VER_PLATFORM_WIN32_NT) then
begin
if OpenProcessToken(GetCurrentProcess,
TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then
begin
try
if not LookupPrivilegeValue(nil, SE_SYSTEMTIME_NAME, luid) then Exit;
tkp.PrivilegeCount := 1;
tkp.Privileges[0].luid := luid;
tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
if not AdjustTokenPrivileges(hToken, False, tkp, SizeOf(TTOKENPRIVILEGES),
PrevTokenPriv, ReturnLength) then
Exit;
if (GetLastError <> ERROR_SUCCESS) then
begin
LogMessage('Das angeforderte Recht zum Setzen der Uhrzeit wurde nicht gewährt. Meldung vom System: '+ SysErrorMessage(GetLastError) + '. ' +
'Prüfen Sie, ob der Dienst unter dem lokalen System-Konto ausgeführt wird.', EVENTLOG_ERROR_TYPE, 0, 4);
Exit;
end;
finally
CloseHandle(hToken);
end;
end;
end;
Result := Windows.SetLocalTime(dSysTime);
end;
Wie man sieht benutze ich die LogMessage Funktion, um bei Nichterfolg dieses zu Protokollieren. Dazu fand ich das
Tutorial von Finn Tolderlund sehr hilfreich. Für diejenigen die auf der Suche nach dem Message Compiler (mc.exe) sind: Googled mal nach GRMSDK_EN_DVD.iso. Zu finden unter
Microsoft Windows SDK for Windows 7 and .NET Framework 4 (ISO). Wenn man die ISO Datei öffnet/mounted findet man unter Setup\WinSDKWin32Tools eine Installation mit der unter andrem der mc.exe installiert wird. Man muss dann nicht gleich das ganze Visual Studio installieren, nur um den Message Compiler zu bekommen.
Und der vollständigkeit halber: Installiert wird der Dienst bei mir zusammen mit der Taskbar-Anwendung mit Inno Setup. Dazu registriert bzw. deregistriert sich der Dienst selbst. Das Inno Setup Script dazu sieht so aus (ich hoffe der Code-Tag zeigt das halbwegs richtig an):
Code:
[Run]
Filename: {app}\MyTimeService.exe; Parameters: " /install /silent"; WorkingDir: {app}
[UninstallRun]
Filename: {app}\MyTimeService.exe; Parameters: " /uninstall /silent"; WorkingDir: {app}
Da man bei einem Update den Dienst ja erst stoppen muss hab ich im Inno Script in der Code-Sektion das Beispiel von
Silvio Iaccarino eingefügt.
Im Inno Script habe ich dann Pascal-Code für CurStepChanged und CurUninstallStepChanged eingefügt:
Code:
procedure CurStepChanged(CurrentStep: TSetupStep);
var
I: Integer;
Flag: Boolean;
begin
if CurrentStep = ssInstall then
begin
if IsServiceInstalled('{#ServiceName}') = true then
begin
if IsServiceRunning('{#ServiceName}') = true then
begin
Flag := false;
StopService('{#ServiceName}');
// after stopping a service you should wait some seconds before removing
// otherwise removing can fail
ProgressPage.SetText('Stoppe den laufenden Dienst...', '');
ProgressPage.SetProgress(0, 0);
ProgressPage.Show;
try
for I := 0 to 100 do
begin
ProgressPage.SetProgress(I, 100);
Sleep(100);
if IsServiceRunning('{#ServiceName}') = false then
begin
Flag := True;
Sleep(100);
Break;
end;
end;
if not Flag then
MsgBox('Der Dienst {#ServiceName} konnte nicht gestoppt werden!',mbInformation, MB_OK);
finally
ProgressPage.Hide;
end;
end;
RemoveService('{#ServiceName}');
end;
end;
if CurrentStep = ssPostInstall then
begin
if IsServiceInstalled('{#ServiceName}') = true then
begin
Flag := false;
StartService('{#ServiceName}');
ProgressPage.SetText('Starte den Dienst...', '');
ProgressPage.SetProgress(0, 0);
ProgressPage.Show;
try
for I := 0 to 100 do
begin
ProgressPage.SetProgress(I, 100);
Sleep(100);
if IsServiceRunning('{#ServiceName}') = true then
begin
Flag := True;
Sleep(100);
Break;
end;
end;
if not Flag then
MsgBox('Der Dienst {#ServiceName} konnte nicht gestartet werden!',mbInformation, MB_OK);
finally
ProgressPage.Hide;
end;
end;
end;
end;
procedure CurUninstallStepChanged(CurUninstallStep: TUninstallStep);
var
I: Integer;
Flag: Boolean;
begin
if CurUninstallStep = usUninstall then
begin
if IsServiceInstalled('{#ServiceName}') = true then
begin
if IsServiceRunning('{#ServiceName}') = true then
begin
Flag := false;
StopService('{#ServiceName}');
// after stopping a service you should wait some seconds before removing
// otherwise removing can fail
for I := 0 to 100 do
begin
Sleep(100);
if IsServiceRunning('{#ServiceName}') = false then
begin
Flag := True;
Sleep(100);
Break;
end;
end;
if not Flag then
MsgBox('Der Dienst {#ServiceName} konnte nicht gestoppt werden!',mbInformation, MB_OK);
end;
end;
end;
end;
{#ServiceName} ist bei mir im Script als Konstante definiert und ist der Name (nicht der DisplayName) des Dienstes.
In meiner Systray-App kann ich jetzt sehr schön auch prüfen ob der Dienst läuft. Dazu hab ich das Beispiel
hier aus dem Forum von CalganX genommen.
Soweit alles gut. Ich hoffe meine Ausführungen zum Message Compiler und Inno Setup waren nicht zu sehr
OT, aber ich denke das andere dieses vielleicht auch hilfreich finden.
Eine kleine Frage hab ich dann aber doch noch: In meiner Systray-Anwendung möchte ich dem Nutzer die Möglichkeit geben über einen Button den Dienst auch mal zu stoppen und wieder zu starten. Könnte ja vielleicht bei Fehlereingrenzung hilfreich sein und möchte dann ungern den Benutzer per Telefon erst zu den Diensten lotsen müssen. Aber um Meine Dienst zu starten oder zu stoppen brauch ich ja Adminrechte, da der Dienst unter dem lokalen Systemkonto läuft. Also angenommen ich hab folgende Button-Click Methode:
Delphi-Quellcode:
procedure TSubForm.Button2Click(Sender: TObject);
begin
Label1.Caption := 'Warte...';
Application.ProcessMessages;
if ServiceStop('','MyTimeSettingService') then
Label1.Caption := 'OK'
else
Label1.Caption := 'Fehler';
Label2.Caption := IntToStr(ServiceGetStatus('','MyTimeSettingService'));
end;
Ist es auf einfachem Weg möglich die Funktion ServiceStop mit Adminrechten auszuführen? Die Windows
UAC-Abfrage ist dabei kein Problem und soll auch kommen, da zu diesem Zeitpunkt ja auch ein Benutzer vor dem PC sitzt.
Vielen Dank
Ronny