Windows7でのアクセストークンの変更エラー (ID:47532)

名前

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

本文

Delphi2007でシャットダウンや日付変更を行うためアクセス権を変更して実行しています。

WindowsXPまでは正常に動作していたのですが
Windows7(64bit)で試すと
「一部の特権が呼び出し側に割り当てられていません」
というエラーが帰ってきます。もちろんアクセス権は変更出来ません。

デバッグ環境を使わず、実行ファイルから「管理者権限で実行」をすると
エラーは無く正常に動作するのですが、これは理想ではありません

この辺のサイトを見て試行錯誤しているのですが
どれも同じエラーが出ます。
アクセス権の設定に問題があるのでしょうか？

http://ht-deko.com/tech043.html
http://homepage1.nifty.com/project21/articles/delphi/tips07.htm
http://www.geocities.jp/asumaroyuumaro/program/tips/setlocaltime.html

procedure ProcessTokenOpen(const ProcessName : PChar);
var
  hToken    :THandle;  //アクセストークンのハンドル
  tkp, origintkp :TTokenPrivileges;
  ReturnLen :DWord;
begin
  //WinNT の場合SE_SYSTEMTIME_NAME特権の有効化が必要
  if Win32Platform = VER_PLATFORM_WIN32_NT then
  begin
    //プロセスのアクセストークンを開く
    if OpenProcessToken(GetCurrentProcess,
                        TOKEN_ADJUST_PRIVILEGES or
                        TOKEN_QUERY, hToken) then
    begin
      try
        //特権名を示す一意のLuidを取得
        if not LookupPrivilegeValue(nil, ProcessName,
                                    tkp.Privileges[0].luid) then Exit;
        //構造体の中の特権数
        tkp.PrivilegeCount := 1;
        //SE_SYSTEMTIME_NAME 特権を有効にする
        tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
        //新しいアクセストークン情報(tkp)を適用する
        //origintkpには適用以前の情報が返される
        if not AdjustTokenPrivileges(hToken, False, tkp,
                                      Sizeof(origintkp), origintkp, ReturnLen) then
          Exit;
        if (GetLastError <> ERROR_SUCCESS) then
        begin
          raise Exception.Create(SysErrorMessage(GetLastError));
          Exit;
        end;
      finally
        //アクセストークンを閉じる
        CloseHandle(hToken);
      end;
    end;
  end;
end;

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

戻る