Current User Token

Public Function LogOnWithToken(thisToken As Long)
  '// log off any previous impersonation.
  LogOff
  
  '// attempt to log on a a user
  hToken = thisToken
  
  If ImpersonateLoggedOnUser(hToken) Then
    impersonationactive = True
    '// the process should be granted the
    '// logged on token.
    LogOnWithToken = True      
  Else
    impersonationactive = False
    LogOnWithToken = False      
  End If
  '// cleanup token handle.
  CloseHandle hToken   
End Function
 
Function GetNewUserToken() As Long
  Call OpenProcessToken(GetCurrentProcess, TOKEN_QUERY Or TOKEN_IMPERSONATE, hToken)
  CurrentToken = hToken
End Function

                                              

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:

Private Declare Function SetThreadToken Lib "advapi32" (ByVal Thread As Long, ByVal Token As Long) As Long
 
 SetThreadToken 0, hTokenUser

                                              

1:
2:
3:

SetThreadToken 0, 0

                                              

1:

Response.Write curWinUser '(linked to GetUserName Lib "advapi32.dll")
LogOn "DenAdmin", "password", "DenDomain"
Response.Write curWinUser 
LogOff
Response.Write curWinUser 

                                              

1:
2:
3:
4:
5:

SetThreadToken 0, 0

                                              

1:

  Private Const TOKEN_IMPERSONATE = &H4&
Private Const TOKEN_DUPLICATE = &H2&
Private Const TOKEN_QUERY = &H8&
Debug.Print OpenThreadToken(GetCurrentThread, TOKEN_QUERY Or TOKEN_DUPLICATE Or TOKEN_IMPERSONATE, 0, hTokenUser)
Debug.Print Err.LastDllError
CloseHandle hTokenUser

                                              

1:
2:
3:
4:
5:
6:

Option Explicit
 
Private Const TOKEN_IMPERSONATE = &H4&
Private Const TOKEN_DUPLICATE = &H2&
Private Const TOKEN_QUERY = &H8&
 
Private Declare Function DuplicateTokenEx Lib "advapi32" (ByVal hExistingToken As Long, ByVal dwDesiredAccess As Long, ByVal lpTokenAttributes As Long, ByVal ImpersonationLevel As Long, ByVal TokenType As Long, ByRef phNewToken As Long) As Long
Private Declare Function SetThreadToken Lib "advapi32" (ByVal Thread As Long, ByVal Token As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function OpenProcessToken Lib "advapi32" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, ByRef TokenHandle As Long) As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
 
Dim hTokenUserA As Long
 
Public Sub GetUserToken()
 
  Dim hTokenUser As Long
  If OpenProcessToken(GetCurrentProcess, TOKEN_QUERY Or TOKEN_DUPLICATE Or TOKEN_IMPERSONATE, hTokenUser) Then
    If DuplicateTokenEx(hTokenUser, 0, 0, 2, 2, hTokenUserA) Then
      MsgBox "Duplicate Success"
    End If
  CloseHandle hTokenUser
 End If
 
End Sub
 
Public Sub SetUserLaunchToken()
  SetThreadToken 0, hTokenUserA
  'CloseHandle hTokenUserA
End Sub
 
Private Sub Command1_Click()
  SetUserLaunchToken '//revert to user launch token
End Sub
 
Private Sub Form_Load()
 
  GetUserToken '// get user token on load
  
End Sub

                                              

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:

Private Sub Form_Load()
  oClear
    
  o "Proc: " & getCurrentProcess
  o
  oUser
  o
  
  o "Impersonating Admin"
  LogOn_Admin
  oUser
  o
  
  o "Storing Token"
  GetUserToken
  o
  
  o "Impersonating Standard User"
  LogOn_StandardUser
  oUser
  o
    
  o "Restoring Token"
  SetUserLaunchToken
  oUser
  o
    
  
  LogOff
  oUser
End Sub
 
 
Private Sub o(Optional ByVal strOutput As String = "-")
  If strOutput = "-" Then strOutput = "---------------------"
  List1.AddItem strOutput
End Sub
 
Private Sub oUser()
  o "Current User: " & getCurrentUser
End Sub
 
Private Sub oClear()
  List1.Clear
End Sub

                                              

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:

Private Const LOGON32_LOGON_INTERACTIVE As Long = &H2&
Private Const LOGON32_PROVIDER_DEFAULT As Long = &H0&
Private Const TOKEN_IMPERSONATE = &H4&
Private Const TOKEN_DUPLICATE = &H2&
Private Const TOKEN_QUERY = &H8&
 
Private Declare Function DuplicateTokenEx Lib "advapi32" (ByVal hExistingToken As Long, ByVal dwDesiredAccess As Long, ByVal lpTokenAttributes As Long, ByVal ImpersonationLevel As Long, ByVal TokenType As Long, ByRef phNewToken As Long) As Long
Private Declare Function ImpersonateLoggedOnUser Lib "advapi32" (ByVal hToken As Long) As Long
Private Declare Function LogonUserW Lib "advapi32" (ByVal lpszUsername As Long, ByVal lpszDomain As Long, ByVal lpszPassword As Long, ByVal dwLogonType As Long, ByVal dwLogonProvider As Long, ByRef phToken As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function RevertToSelf Lib "advapi32" () As Long
Private Declare Function GetUserProfileDirectoryW Lib "userenv" (ByVal hToken As Long, ByVal lpProfileDir As Long, ByRef lpcchSize As Long) As Long
Private Declare Function OpenProcessToken Lib "advapi32" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, ByRef TokenHandle As Long) As Long
Public Declare Function getCurrentProcess Lib "kernel32" Alias "GetCurrentProcess" () As Long
Private Declare Function SetThreadToken Lib "advapi32" (ByRef Thread As Long, ByVal Token As Long) As Integer
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpbuffer As String, nSize As Long) As Long
 
Private Const impersonation_ADMIN_User As String = "AppUser_Admin"
Private Const impersonation_ADMIN_Password As String = "password"
Private Const impersonation_ADMIN_Domain As String = "domain"
Private Const impersonation_STANDARD_User As String = "AppUser_Std"
Private Const impersonation_STANDARD_Password As String = "password"
Private Const impersonation_STANDARD_Domain As String = "domain"
Private hTokenUserA As Long
 
Dim hToken As Long
Dim success As Long
Public impersonationactive As Boolean
 
 
Public Sub GetUserToken()
 
  Dim hTokenUser As Long
  If OpenProcessToken(getCurrentProcess, TOKEN_QUERY Or TOKEN_DUPLICATE Or TOKEN_IMPERSONATE, hTokenUser) Then
    If DuplicateTokenEx(hTokenUser, 0, 0, 2, 2, hTokenUserA) Then
      MsgBox "Duplicate Success"
    Else
      MsgBox "Fail"
    End If
  CloseHandle hTokenUser
 Else
   Debug.Print "getCurrentProcess: " & CStr(getCurrentProcess)
 End If
 
End Sub
 
Public Sub SetUserLaunchToken()
  SetThreadToken 0, hTokenUserA
  'CloseHandle hTokenUserA
End Sub
 
' ********
 
'
'Private Sub Command1_Click()
'  SetUserLaunchToken '//revert to user launch token
'End Sub
'
'Private Sub Form_Load()
'
'  GetUserToken '// get user token on load
'
'End Sub
'
 
'*********
 
 
 
Public Sub LogOn_Admin()
  LogOn impersonation_ADMIN_User, impersonation_ADMIN_Password, impersonation_ADMIN_Domain
End Sub
 
Public Sub LogOn_StandardUser()
  LogOn impersonation_STANDARD_User, impersonation_STANDARD_Password, impersonation_STANDARD_Domain
End Sub
 
Public Function LogOn( _
  ByVal szUser As String, _
  ByVal szPassword As String, _
  ByVal szDomain As String) As Boolean
  
  '// log off any previous impersonation.
  LogOff
  
  '// attempt to log on a a user
  success = LogonUserW( _
    StrPtr(szUser), _
    StrPtr(szDomain), _
    StrPtr(szPassword), _
    LOGON32_LOGON_INTERACTIVE, _
    LOGON32_PROVIDER_DEFAULT, _
    hToken)
 
  If success Then
    If ImpersonateLoggedOnUser(hToken) Then
      impersonationactive = True
      '// the process should be granted the
      '// logged on token.
      LogOn = True
      
    Else
      impersonationactive = False
      LogOn = False
      
    End If
    '// cleanup token handle.
    CloseHandle hToken
  
  Else
  
    LogOn = False
    
  End If
  
End Function
 
 
Public Sub LogOff()
  
  '// logs off the impersonation.
'  SetThreadToken 0, 0
  RevertToSelf
 
  impersonationactive = False
End Sub
 
 
 
 
Private Function GetUserProfile(ByVal dwTokenHandle As Long) As String
  
  Dim Buffer() As Byte
  Dim dwSize As Long
  
  ReDim Buffer(4096) As Byte
  dwSize = 4096
  If GetUserProfileDirectoryW(dwTokenHandle, VarPtr(Buffer(0)), dwSize) Then
    ReDim Preserve Buffer(dwSize * 2 - 2) As Byte '// unicode bytes
    GetUserProfile = Buffer
  End If
  Erase Buffer
End Function
 
 
 
 
Public Function LogOnWithToken(thisToken As Long)
  '// log off any previous impersonation.
  LogOff
  '// attempt to log on a a user
  hToken = thisToken
  If ImpersonateLoggedOnUser(hToken) Then
    impersonationactive = True
    '// the process should be granted the
    '// logged on token.
    LogOnWithToken = True
  Else
    impersonationactive = False
    LogOnWithToken = False
  End If
  '// cleanup token handle.
  CloseHandle hToken
End Function
 
Public Function getCurrentUser() As String
  Dim sBuffer As String
  Dim lSize As Long
 
  sBuffer = Space$(255)
  lSize = Len(sBuffer)
  Call GetUserName(sBuffer, lSize)
  sBuffer = Trim$(Left$(sBuffer, lSize))
  lSize = InStr(sBuffer, vbNullChar)
  If lSize > 0 Then
    sBuffer = Left$(sBuffer, lSize - 1)
  End If
  getCurrentUser = sBuffer
End Function
 
 
Function CurrentToken() As Long
  Dim cUT As Long
  Call OpenProcessToken(getCurrentProcess, TOKEN_QUERY Or TOKEN_IMPERSONATE, cUT)
  CurrentToken = cUT
  CloseHandle hToken
End Function
                                              

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:

Private Const LOGON32_LOGON_INTERACTIVE As Long = &H2&
Private Const LOGON32_PROVIDER_DEFAULT As Long = &H0&
Private Const TOKEN_IMPERSONATE = &H4&
Private Const TOKEN_DUPLICATE = &H2&
Private Const TOKEN_QUERY = &H8&
 
Private Declare Function DuplicateTokenEx Lib "advapi32" (ByVal hExistingToken As Long, ByVal dwDesiredAccess As Long, ByVal lpTokenAttributes As Long, ByVal ImpersonationLevel As Long, ByVal TokenType As Long, ByRef phNewToken As Long) As Long
Private Declare Function ImpersonateLoggedOnUser Lib "advapi32" (ByVal hToken As Long) As Long
Private Declare Function LogonUserW Lib "advapi32" (ByVal lpszUsername As Long, ByVal lpszDomain As Long, ByVal lpszPassword As Long, ByVal dwLogonType As Long, ByVal dwLogonProvider As Long, ByRef phToken As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function RevertToSelf Lib "advapi32" () As Long
Private Declare Function GetUserProfileDirectoryW Lib "userenv" (ByVal hToken As Long, ByVal lpProfileDir As Long, ByRef lpcchSize As Long) As Long
Private Declare Function OpenProcessToken Lib "advapi32" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, ByRef TokenHandle As Long) As Long
Public Declare Function getCurrentProcess Lib "kernel32" Alias "GetCurrentProcess" () As Long
Private Declare Function SetThreadToken Lib "advapi32" (ByRef Thread As Long, ByVal Token As Long) As Integer
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpbuffer As String, nSize As Long) As Long
 
Private Const impersonation_ADMIN_User As String = "AppUser_Admin"
Private Const impersonation_ADMIN_Password As String = "PASSWORD1"
Private Const impersonation_ADMIN_Domain As String = "ADMIN"
Private Const impersonation_STANDARD_User As String = "AppUser_Std"
Private Const impersonation_STANDARD_Password As String = "PASSWORD2"
Private Const impersonation_STANDARD_Domain As String = "ADMIN"
Private hTokenUserA As Long
Private hToken As Long
 
Dim success As Long
Public impersonationactive As Boolean
 
 
Public Sub GetUserToken()
 
  Dim hTokenUser As Long
  If OpenProcessToken(getCurrentProcess, TOKEN_QUERY Or TOKEN_DUPLICATE Or TOKEN_IMPERSONATE, hTokenUser) Then
    If DuplicateTokenEx(hTokenUser, 0, 0, 2, 2, hTokenUserA) Then
      MsgBox "Duplicate Success"
    Else
      MsgBox "Fail"
    End If
  CloseHandle hTokenUser
 
 End If
 
End Sub
 
Public Sub SetUserLaunchToken()
  SetThreadToken 0, hTokenUserA
  CloseHandle hTokenUserA
End Sub
 
 
 
 
 
Public Sub LogOn_Admin()
  LogOn impersonation_ADMIN_User, impersonation_ADMIN_Password, impersonation_ADMIN_Domain
End Sub
 
Public Sub LogOn_StandardUser()
  LogOn impersonation_STANDARD_User, impersonation_STANDARD_Password, impersonation_STANDARD_Domain
End Sub
 
Public Function LogOn( _
  ByVal szUser As String, _
  ByVal szPassword As String, _
  ByVal szDomain As String) As Boolean
  
  '// log off any previous impersonation.
  LogOff
  
  '// attempt to log on a a user
  success = LogonUserW( _
    StrPtr(szUser), _
    StrPtr(szDomain), _
    StrPtr(szPassword), _
    LOGON32_LOGON_INTERACTIVE, _
    LOGON32_PROVIDER_DEFAULT, _
    hToken)
 
  If success Then
    If ImpersonateLoggedOnUser(hToken) Then
      impersonationactive = True
      '// the process should be granted the
      '// logged on token.
      LogOn = True
      
    Else
      impersonationactive = False
      LogOn = False
      
    End If
    '// cleanup token handle.
    CloseHandle hToken
  
  Else
  
    LogOn = False
    
  End If
  
End Function
 
 
Public Sub LogOff()
  
  '// logs off the impersonation.
'  SetThreadToken 0, 0
  RevertToSelf
 
  impersonationactive = False
End Sub
 
 
 
 
Private Function GetUserProfile(ByVal dwTokenHandle As Long) As String
  
  Dim Buffer() As Byte
  Dim dwSize As Long
  
  ReDim Buffer(4096) As Byte
  dwSize = 4096
  If GetUserProfileDirectoryW(dwTokenHandle, VarPtr(Buffer(0)), dwSize) Then
    ReDim Preserve Buffer(dwSize * 2 - 2) As Byte '// unicode bytes
    GetUserProfile = Buffer
  End If
  Erase Buffer
End Function
 
Public Function getCurrentUser() As String
  Dim sBuffer As String
  Dim lSize As Long
 
  sBuffer = Space$(255)
  lSize = Len(sBuffer)
  Call GetUserName(sBuffer, lSize)
  sBuffer = Trim$(Left$(sBuffer, lSize))
  lSize = InStr(sBuffer, vbNullChar)
  If lSize > 0 Then
    sBuffer = Left$(sBuffer, lSize - 1)
  End If
  getCurrentUser = sBuffer
End Function

                                              

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:

'//
'// Module1.bas
'//
 
Option Explicit
 
Private Const LOGON32_LOGON_INTERACTIVE As Long = &H2&
Private Const LOGON32_PROVIDER_DEFAULT As Long = &H0&
 
Private Declare Function ImpersonateLoggedOnUser Lib "advapi32" (ByVal hToken As Long) As Long
Private Declare Function LogonUserW Lib "advapi32" (ByVal lpszUsername As Long, ByVal lpszDomain As Long, ByVal lpszPassword As Long, ByVal dwLogonType As Long, ByVal dwLogonProvider As Long, phToken As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function RevertToSelf Lib "advapi32" () As Long
 
Dim hToken As Long
Dim Success As Long
 
Public Sub LogOn( _
  ByVal szUser As String, _
  ByVal szPassword As String, _
  ByVal szDomain As String)
  
  '// log off any previous impersonation.
  LogOff
  
  '// attempt to log on a a user
  Success = LogonUserW( _
    StrPtr(szUser), _
    StrPtr(szDomain), _
    StrPtr(szPassword), _
    LOGON32_LOGON_INTERACTIVE, _
    LOGON32_PROVIDER_DEFAULT, _
    hToken)
 
  If Success Then
  
    If ImpersonateLoggedOnUser(hToken) Then
      
      '// the process should be granted the
      '// logged on token.
      MsgBox "LogOn Success"
      
    Else
    
      MsgBox "ImpersonateLoggedOnUser failed."
      
    End If
    '// cleanup token handle.
    CloseHandle hToken
  
  Else
  
    MsgBox "LogonUserW failed."
    
  End If
  
End Sub
 
 
Public Sub LogOff()
  
  '// logs off the impersonation.
  RevertToSelf
 
End Sub
 
 
 
 
 
 
 
 
 
 
 
 
'//
'// Form1
'//
 
Option Explicit
 
Private Const TOKEN_IMPERSONATE = &H4&
Private Const TOKEN_DUPLICATE = &H2&
Private Const TOKEN_QUERY = &H8&
 
Private Declare Function DuplicateTokenEx Lib "advapi32" (ByVal hExistingToken As Long, ByVal dwDesiredAccess As Long, ByVal lpTokenAttributes As Long, ByVal ImpersonationLevel As Long, ByVal TokenType As Long, ByRef phNewToken As Long) As Long
Private Declare Function OpenThreadToken Lib "advapi32" (ByVal ThreadHandle As Long, ByVal DesiredAccess As Long, ByVal OpenAsSelf As Long, ByRef TokenHandle As Long) As Long
Private Declare Function SetThreadToken Lib "advapi32" (ByVal Thread As Long, ByVal Token As Long) As Long
Private Declare Function GetCurrentThread Lib "kernel32" () As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function OpenProcessToken Lib "advapi32" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, ByRef TokenHandle As Long) As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
 
Dim hTokenUserA As Long
 
Public Sub GetUserToken()
  Dim hTokenUser As Long
  If OpenProcessToken(GetCurrentProcess, TOKEN_QUERY Or TOKEN_DUPLICATE Or TOKEN_IMPERSONATE, hTokenUser) Then
  If DuplicateTokenEx(hTokenUser, 0, 0, 2, 2, hTokenUserA) Then
    MsgBox "Success"
  End If
  CloseHandle hTokenUser
End Sub
 
Public Sub SetUserToken()
  SetThreadToken 0, hTokenUserA
End Sub
 
Private Sub Command1_Click()
'// add admin info
  LogOn "user", "pass", vbNullString
End Sub
 
Private Sub Command2_Click()
'// username stuff
End Sub
 
Private Sub Command3_Click()
  SetUserToken
End Sub
 
Private Sub Form_Load()
  '// get token of user
  Call GetUserToken
 
End Sub

                                              

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128: