tagCANDY CGI VBレスキュー(花ちゃん)の Visual Basic 6.0用 掲示板
VBレスキュー(花ちゃん)の Visual Basic 6.0用 掲示板
[ツリー表示へ]  [ワード検索]  [Home]

タイトル Win7でシステム日付を設定できません
投稿日: 2010/07/12(Mon) 18:40
投稿者come
OS:win7
VB6.0

システム日付と時刻を設定するロジックがあり、
XPでは問題なく動作しておりましたが、
Win7ではエラーが出て動作しないようです。

エラー内容:70 書き込みできません。


以下のようなロジックです。
                'システム日付を設定
                Date = Format(dDate, "yyyy/mm/dd")
                'システム時刻を設定
                Time = Format(dDate, "hh:mm:nn")

vistaではUACの問題で特権を設定しないといけないと見つけたので、
同様にwin7でも試しましたがエラーが出て動作しません。

以下、権限を与えるロジック
*********************************
    If CreateObject("SYSINFO.Sysinfo").OSPlatform = 2 Then
        Dim lngResult       As Long
        Dim hTokenHandle    As Long
        Dim tkpNew          As TOKEN_PRIVILEGES
        Dim tkpPrevious     As TOKEN_PRIVILEGES
        
        'プロセスに関連づけアクセストークンのオープン
        lngResult = OpenProcessToken(GetCurrentProcess, TOKEN_QUERY Or TOKEN_ADJUST_PRIVILEGES, hTokenHandle)
        If lngResult = 0 Then
            Exit Sub
        End If
        
        'ローカルシステムのシステム日付変更特権の取得
        lngResult = LookupPrivilegeValue(vbNullString, SE_SYSTEMTIME_NAME, tkpNew.Privileges(0).LUID)
        If lngResult = 0 Then
            Exit Sub
        End If
        
        tkpNew.PrivilegeCount = 1
        tkpNew.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
        'アクセストークンの特権を変更する
        lngResult = AdjustTokenPrivileges(hTokenHandle, False, tkpNew, Len(tkpPrevious), tkpPrevious, 0&)
        If lngResult = 0 Then
            Exit Sub
        End If
        If Not GetLastError = ERROR_SUCCESS Then
            Exit Sub
        End If

        
        CloseHandle (hTokenHandle)
    End If
*********************************

以下宣言部
*********************************
'''****
Public Type LUID
  UsedPart As Long
  IgnoredForNowHigh32BitPart As Long
End Type

Public Type LUID_AND_ATTRIBUTES
    LUID As LUID
    Attributes As Long
End Type

Public Type TOKEN_PRIVILEGES
  PrivilegeCount As Long
  Privileges(0) As LUID_AND_ATTRIBUTES
End Type

'プロセスに関連付けられているアクセストークンを開きます。
Public Declare Function OpenProcessToken Lib "advapi32" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long

Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

'ローカル一意識別子(LUID)を取得し、指定された特権名を表現します
Public Declare Function LookupPrivilegeValue Lib "advapi32" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long

'カレントプロセスの擬似ハンドルを返す(P656)
Public Declare Function GetCurrentProcess Lib "kernel32" () As Long

'指定したアクセストークン内の特権を有効または無効にします
Public Declare Function AdjustTokenPrivileges Lib "advapi32" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long

Public Declare Function GetLastError Lib "kernel32" () As Long
Public Const ERROR_SUCCESS = 0&

Public Const TOKEN_QUERY = &H8
Public Const TOKEN_ADJUST_PRIVILEGES = &H20
Public Const SE_SYSTEMTIME_NAME = "SeSystemtimePrivilege"
Public Const SE_PRIVILEGE_ENABLED = &H2

*********************************

どこか謝り等あれば指摘ください。
お願いします。

- 関連一覧ツリー をクリックするとツリー全体を一括表示します)

古いスレッドにレスはつけられません。