さて、画面ロックのやり方がわかって喜んでいたのだが、
WindowsServer2016でテストしたところ、画面ロックが動作しない。
・・・しばらく試した末に、あきらめかけましたが、
頑張って調べました。
アクティブなユーザートークンを取得して、そのユーザーとして、LockWorkStationしているので、リモートデスクトップでユーザートークンが取得できずに、ロックできないという現象のようです。
１「WTSGetActiveConsoleSessionId」関数で物理コンソールのセッションIDを取得する。
２ 「WTSQueryUserToken」関数で取得したセッションIDのユーザートークンを主とする。
とやっているのですが、つまり物理コンソールでないとだめだということです。
リモートデスクトップではセッションIDを取得することができません。
代わりに、「WTSEnumerateSessions」
を使用してアクティブなリモートデスクトップのセッションIDを取得し、
そのセッションIDでWTSQueryUserToken 関数を使用して、ユーザートークンを取得するということをやります。
それでは、まず、WTSEnumerateSession を使えるように、クラスを作ります。
ここを参照しました。
http://hongliang.seesaa.net/article/7243455.html
Imports System Imports System.ComponentModel Imports System.Runtime.InteropServices Imports System.Text Public Class TerminalService Public Shared ReadOnly CurrentServerHandle As IntPtr = IntPtr.Zero Public Shared Function GetSessionInfos(ByVal server As IntPtr) As WTSSessionInfo() Dim buffer As IntPtr '返ってくる配列を受け取るポインタ。 Dim count As Integer '数。どちらも初期化不要。 '早速実行。失敗したら例外。 If Not (Win32Api.WTSEnumerateSessions(server, 0, 1, buffer, count)) Then Throw New Win32Exception(Marshal.GetLastWin32Error()) End If 'バッファが空ならセッション無しと言うこと。 If buffer.Equals(IntPtr.Zero) Then Return New WTSSessionInfo() {} End If Dim infos(count - 1) As WTSSessionInfo 'WTSSessionInfo構造体のサイズを取得。 Dim size As Integer = Marshal.SizeOf(GetType(WTSSessionInfo)) Try Dim i As Integer For i = 0 To count - 1 'ポインタを、sizeずつずらしていく。 Dim current As IntPtr = New IntPtr(buffer.ToInt64() + (size * i)) 'ポインタから構造体に変換して配列に格納。 infos(i) = CType(Marshal.PtrToStructure(current, GetType(WTSSessionInfo)), WTSSessionInfo) Next Return infos Catch ex As Exception Throw New InvalidOperationException( "バッファの読み出し中にエラーが発生しました。", ex) '確実に後始末 Finally Win32Api.WTSFreeMemory(buffer) End Try End Function Public Shared Function GetProcessInfos(ByVal server As IntPtr) _ As WTSProcessInfo() 'やってることはGetSessionInfosと同じ。使う関数と構造体が違うだけ。 Dim buffer As IntPtr Dim count As Integer If Not (Win32Api.WTSEnumerateProcesses(server, 0, 1, buffer, count)) Then Throw New Win32Exception(Marshal.GetLastWin32Error()) End If If buffer.Equals(IntPtr.Zero) Then Return New WTSProcessInfo() {} End If Dim infos(count - 1) As WTSProcessInfo Dim size As Integer = Marshal.SizeOf(GetType(WTSProcessInfo)) Try Dim i As Integer For i = 0 To count - 1 Dim current As IntPtr = New IntPtr(buffer.ToInt64() + (size * i)) infos(i) = CType(Marshal.PtrToStructure(current, GetType(WTSProcessInfo)), WTSProcessInfo) Next Return infos Catch ex As Exception Throw New InvalidOperationException( "バッファの読み出し中にエラーが発生しました。", ex) Finally Win32Api.WTSFreeMemory(buffer) End Try End Function <StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Auto)> Public Structure WTSSessionInfo Public SessionId As Integer Public WinStationName As String Public State As ConnectState End Structure Public Enum ConnectState Active = &H0 Connected = &H1 ConnectQuery = &H2 Shadow = &H3 Disconnected = &H4 Idle = &H5 Listen = &H6 Reset = &H7 Down = &H8 Init = &H9 End Enum <StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Auto)> Public Structure WTSProcessInfo Public SessionId As Integer Public ProcessId As Integer Public ProcessName As String Public UserSid As IntPtr End Structure Private NotInheritable Class Win32Api Declare Auto Function WTSOpenServer Lib "wtsapi32.dll" ( ByVal name As String) As IntPtr Declare Auto Function WTSEnumerateSessions Lib "wtsapi32.dll" ( ByVal server As IntPtr, ByVal reserved As Integer, ByVal version As Integer, ByRef infos As IntPtr, ByRef count As Integer) As Boolean Declare Auto Function WTSEnumerateProcesses Lib "wtsapi32.dll" ( ByVal server As IntPtr, ByVal reserved As Integer, ByVal version As Integer, ByRef infos As IntPtr, ByRef count As Integer) As Boolean Declare Auto Sub WTSFreeMemory Lib "wtsapi32.dll" (ByVal memory As IntPtr) End Class End Class
で、これをこう使います。
Dim UserTokenHandle As IntPtr = IntPtr.Zero TerminalService.GetProcessInfos(UserTokenHandle) Dim infos As TerminalService.WTSSessionInfo() = TerminalService.GetSessionInfos(UserTokenHandle) Dim activeID As UInteger For Each inf As TerminalService.WTSSessionInfo In infos If inf.State = TerminalService.ConnectState.Active Then activeID = inf.SessionId End If Next WTSQueryUserToken(activeID, UserTokenHandle) Dim ProcInfo As New PROCESS_INFORMATION Dim StartInfo As New STARTUPINFOW StartInfo.cb = CUInt(Runtime.InteropServices.Marshal.SizeOf(StartInfo)) Dim cmdline As New System.Text.StringBuilder cmdline.Append("rundll32.exe user32.dll,LockWorkStation") CreateProcessAsUser(UserTokenHandle, Nothing, cmdline, IntPtr.Zero, IntPtr.Zero, False, 0, IntPtr.Zero, Nothing, StartInfo, ProcInfo)
これで 動作しました。
ちなみに、コマンドプロンプトから query session を実行すると、現在のセッションの状態を表示することができます。これを見て、セッションが少しわかったような気がしました。
