SetSystemTime unter Windows 7

[RonnyBausA]

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