Windows7での時刻設定（解決） (ID：47551)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

以前Windows7での時刻設定を行えなえず
アクセストークンも効かないことで相談しましたが
解決の目処が立ちましたので報告だけ

SNTPサーバーを真似れば時計を合わせられると考えましたが
Windows7では、自分のIPアドレスへは読みにいかないようでダメでした

アドバイスを頂いたサービスアプリケーションを別途作成し
ソケット通信を使用してメインソフトから時計データを受け取り
時計に反映させることに成功しました。

サービスの起動や停止もメインソフトから制御出来そうな所まで来ています。

サービスをインストールをインストーラーから行うのがちょっと敷居が高そうなのですが
最悪でもそこは手動で行っても良いので
およそ理想の動作をするようになりました。

ありがとうございました。

サービスアプリケーションクラス(TService)の
基礎的な使い方があまりネット上になさそうなので
今後のために記載しておきます。

type
  TTimeAjust = class(TService)
    procedure ServiceStart(Sender: TService; var Started: Boolean);
    procedure ServiceStop(Sender: TService; var Stopped: Boolean);
    procedure ServiceCreate(Sender: TObject);
    procedure ServiceDestroy(Sender: TObject);
    procedure ServiceExecute(Sender: TService);
  private
    { Private 宣言 }

function ProcessMessages() : Boolean;
  public
    function GetServiceController: TServiceController; override;
    { Public 宣言 }
  end;

var
  TimeAjust: TTimeAjust;

implementation

{$R *.DFM}

procedure TTimeAjust.ServiceCreate(Sender: TObject);
begin
end;

procedure TTimeAjust.ServiceDestroy(Sender: TObject);
begin
end;

procedure TTimeAjust.ServiceStart(Sender: TService; var Started: Boolean);
begin
  Started := True;
end;

procedure TTimeAjust.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
  Stopped := True;
end;

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
  TimeAjustJJY.Controller(CtrlCode);
end;

function TTimeAjust.GetServiceController: TServiceController;
begin
  Result := ServiceController;
end;

function TTimeAjust.ProcessMessages() : Boolean;
var
  Msg : TMsg;
  OldStatus : TCurrentStatus;
  ActionOK : Boolean;
begin
  result := PeekMessage(Msg,0,0,0,PM_REMOVE);
  if (not result) then exit;
  with Msg do
    if (hwnd = 0) and (message = CM_SERVICE_CONTROL_CODE) then begin
      OldStatus := Status;
      try
        result := False;
        ActionOK := True;
        case wParam of
          SERVICE_CONTROL_STOP : begin
            ActionOK := DoStop;
            result := ActionOK;
          end;

SERVICE_CONTROL_PAUSE : begin
            ActionOK := DoPause;
            result := False;
          end;

SERVICE_CONTROL_CONTINUE : begin
            ActionOK := DoContinue;
            result := False;
          end;

SERVICE_CONTROL_SHUTDOWN : begin
            DoShutDown;
            result := True;
          end;

SERVICE_CONTROL_INTERROGATE : begin
            DoInterrogate;
            result := False;
          end;

end;
        if (not ActionOK) then Status := OldStatus;
      finally
      end;
    end;

end;

procedure TTimeAjust.ServiceExecute(Sender: TService);
begin

while (not Terminated) do begin
    if (ProcessMessages) then begin
      break;
    end;
  end
end;

←解決時は質問者本人がここをチェックしてください。

戻る