对 VB.NET WinForm 应用程序使用模拟，可以保存文件，无法打开文件

Question

我正在为我编写的应用程序添加文档上传功能。我希望用户能够上传、打开和删除他们无法正常访问的网络驱动器上的文档。考虑到这一点，我偶然发现了 Impersonation，用户可以在其中模拟一个对驱动器拥有完全权限的用户帐户，然后在执行代码后将其处理掉。

我以前从未使用过模拟，所以在研究过程中我发现了这个帖子： Impersonate a Windows or Active Directory user from a different, untrusted domain

我创建并复制了用户 Max Vernon 发布的课程如下：

Option Explicit On
Option Infer Off

Imports System
Imports System.Runtime.InteropServices '   DLL Import
Imports System.Security.Principal '  WindowsImpersonationContext
Imports System.ComponentModel

Public Class Impersonation

    'Group Type Enum
    Enum SECURITY_IMPERSONATION_LEVEL As Int32
        SecurityAnonymous = 0
        SecurityIdentification = 1
        SecurityImpersonation = 2
        SecurityDelegation = 3
    End Enum

    Public Enum LogonType As Integer

        'This logon type is intended for users who will be interactively using the computer, such as a user being logged on
        'by a terminal server, remote shell, or similar process.
        'This logon type has the additional expense of caching logon information for disconnected operations,
        'therefore, it is inappropriate for some client/server applications, such as a mail server.
        LOGON32_LOGON_INTERACTIVE = 2

        'This logon type is intended for high performance servers to authenticate plaintext passwords.
        'The LogonUser function does not cache credentials for this logon type.
        LOGON32_LOGON_NETWORK = 3

        'This logon type is intended for batch servers, where processes may be executing on behalf of a user without
        'their direct intervention. This type is also for higher performance servers that process many plaintext
        'authentication attempts at a time, such as mail or Web servers.
        'The LogonUser function does not cache credentials for this logon type.
        LOGON32_LOGON_BATCH = 4

        'Indicates a service-type logon. The account provided must have the service privilege enabled.
        LOGON32_LOGON_SERVICE = 5

        'This logon type is for GINA DLLs that log on users who will be interactively using the computer.
        'This logon type can generate a unique audit record that shows when the workstation was unlocked.
        LOGON32_LOGON_UNLOCK = 7

        'This logon type preserves the name and password in the authentication package, which allows the server to make
        'connections to other network servers while impersonating the client. A server can accept plaintext credentials
        'from a client, call LogonUser, verify that the user can access the system across the network, and still
        'communicate with other servers.
        'NOTE: Windows NT:  This value is not supported.
        LOGON32_LOGON_NETWORK_CLEARTEXT = 8

        'This logon type allows the caller to clone its current token and specify new credentials for outbound connections.
        'The new logon session has the same local identifier but uses different credentials for other network connections.
        'NOTE: This logon type is supported only by the LOGON32_PROVIDER_WINNT50 logon provider.
        'NOTE: Windows NT:  This value is not supported.
        LOGON32_LOGON_NEW_CREDENTIALS = 9

    End Enum

    Public Enum LogonProvider As Integer

        'Use the standard logon provider for the system.
        'The default security provider is negotiate, unless you pass NULL for the domain name and the user name
        'is not in UPN format. In this case, the default provider is NTLM.
        'NOTE: Windows 2000/NT:   The default security provider is NTLM.
        LOGON32_PROVIDER_DEFAULT = 0
        LOGON32_PROVIDER_WINNT35 = 1
        LOGON32_PROVIDER_WINNT40 = 2
        LOGON32_PROVIDER_WINNT50 = 3

    End Enum

    'Obtains user token.
    Declare Auto Function LogonUser Lib "advapi32.dll" (ByVal lpszUsername As String, ByVal lpszDomain As String, ByVal lpszPassword As String, ByVal dwLogonType As LogonType, ByVal dwLogonProvider As LogonProvider, ByRef phToken As IntPtr) As Integer


    'Closes open handles returned by LogonUser.
    Declare Function CloseHandle Lib "kernel32.dll" (ByVal handle As IntPtr) As Boolean

    'Creates duplicate token handle.
    Declare Auto Function DuplicateToken Lib "advapi32.dll" (ExistingTokenHandle As IntPtr, SECURITY_IMPERSONATION_LEVEL As Int16, ByRef DuplicateTokenHandle As IntPtr) As Boolean

    'WindowsImpersonationContext newUser.
    Private newUser As WindowsImpersonationContext

    'Attempts to impersonate a user.  If successful, returns 
    'a WindowsImpersonationContext of the new user's identity.
    ' 
    'Username that you want to impersonate.
    'Logon domain.
    'User's password to logon with.
    Public Sub Impersonator(ByVal sDomain As String, ByVal sUsername As String, ByVal sPassword As String)

        'Initialize tokens
        Dim pExistingTokenHandle As New IntPtr(0)
        Dim pDuplicateTokenHandle As New IntPtr(0)

        If sDomain = "" Then
            sDomain = System.Environment.MachineName
        End If

        Try

            Const LOGON32_PROVIDER_DEFAULT As Int32 = 0
            Const LOGON32_LOGON_NEW_CREDENTIALS = 9

            Dim bImpersonated As Boolean = LogonUser(sUsername, sDomain, sPassword, LOGON32_LOGON_NEW_CREDENTIALS, LOGON32_PROVIDER_DEFAULT, pExistingTokenHandle)

            If bImpersonated = False Then
                Dim nErrorCode As Int32 = Marshal.GetLastWin32Error()
                Throw New ApplicationException("LogonUser() failed with error code: " & nErrorCode.ToString)
            End If

            Dim bRetVal As Boolean = DuplicateToken(pExistingTokenHandle, SECURITY_IMPERSONATION_LEVEL.SecurityImpersonation, pDuplicateTokenHandle)
            If bRetVal = False Then
                Dim nErrorCode As Int32 = Marshal.GetLastWin32Error
                CloseHandle(pExistingTokenHandle)
                Throw New ApplicationException("DuplicateToken() failed with error code: " & nErrorCode)
            Else
                Dim newId As New WindowsIdentity(pDuplicateTokenHandle)
                Dim impersonatedUser As WindowsImpersonationContext = newId.Impersonate
                newUser = impersonatedUser
            End If

        Catch ex As Exception
            MessageBox.Show("An error has occurred. Please contact Technical Support. " & vbCrLf & ex.Message, "Application Title", MessageBoxButtons.OK, MessageBoxIcon.Error)
        Finally
            If pExistingTokenHandle <> IntPtr.Zero Then
                CloseHandle(pExistingTokenHandle)
            End If
            If pDuplicateTokenHandle <> IntPtr.Zero Then
                CloseHandle(pDuplicateTokenHandle)
            End If
        End Try
    End Sub

    Public Sub Undo()
        newUser.Undo()
    End Sub
End Class

模拟非常适合“上传”（实际上只是将文件从用户本地文件复制到网络驱动器，如果不存在则创建特定的文件路径）但在尝试时似乎不起作用打开文件备份，或删除该文件。

我收到这样的拒绝访问错误：

尝试打开文件时出现错误消息

打开文件单击事件和类调用如下所示：

 Private Sub btnOpenDoc_Click(sender As Object, e As EventArgs) Handles btnOpenDoc.Click
        Dim Impersonator As New Impersonation
        Dim sUser As String = "UserNameGoesHere"
        Dim sPass As String = "PasswordGoesHere"
        Dim sDomain As String = "DomainGoesHere"

        Try
            If sActionID <> "" And iDocument = 1 Then
                'Starts impersonation
                Impersonator.Impersonator(sDomain, sUser, sPass)

                Process.Start(RetrieveFilePath())

                'Ends Impersonation
                Impersonator.Undo()
            End If

        Catch ex As Exception
            MessageBox.Show("An error has occurred. Please contact Technical Support. " & vbCrLf & ex.Message, "Application Title", MessageBoxButtons.OK, MessageBoxIcon.Error)
            modGlobal.WriteToErrorLog(ex.Message, "frmActionEntry", modGlobal.GetExceptionInfo(ex), "frmActionEntry->btnOpenDoc_Click", currentUser.getEmployeeName())
        End Try
    End Sub

这里是文档删除功能：

    Private Function DeleteFile() As Boolean
        Dim Impersonator As New Impersonation
        Dim sUser As String = "UsernameGoesHere"
        Dim sPass As String = "PasswordGoesHere"
        Dim sDomain As String = "DomainGoesHere"

        Try
            'Starts impersonation
            Impersonator.Impersonator(sDomain, sUser, sPass)

            File.Delete(RetrieveFilePath())
            Return True

            'Ends Impersonation
            Impersonator.Undo()
        Catch ex As Exception
            MessageBox.Show("An error has occurred. Please contact Technical Support. " & vbCrLf & ex.Message, "Application Title", MessageBoxButtons.OK, MessageBoxIcon.Error)
            modGlobal.WriteToErrorLog(ex.Message, "frmActionEntry", modGlobal.GetExceptionInfo(ex), "frmActionEntry->DeleteFile", currentUser.getEmployeeName())
            Return False
        End Try
    End Function

在 FileSave 函数中的使用方式基本相同。就像我说的那样，我是模仿的新手，感觉就像我撞到了墙，整个上午都在研究和尝试各种事情。非常感谢任何建议！

-李维斯

Answer 1

因此，经过大量研究和反复试验，我对此有了答案。

简短的回答：

没有一种干净、优雅的方式来使用模拟打开网络驱动器上的文件，因为您要么使用 Windows 安全性，要么遇到 Windows Shell 问题。我决定走另一条路。

长答案：

我相信我是正确的，因为访问被拒绝错误是由于尝试以本地用户计算机上的模拟用户身份打开文件。为了解决这个问题，我决定尝试使用 ProcessStartInfo() 传递正确的凭据（同时还使用模拟访问驱动器），如下所示：

'Opens the document associated with this action
    Private Sub btnOpenDoc_Click(sender As Object, e As EventArgs) Handles btnOpenDoc.Click
        'Initializes an impersonation object
        Dim Impersonator As New Impersonation
        'Strings with login credentials
        Dim sUser As String = "UsernameGoesHere"
        Dim sPass As String = "PasswordGoesHere"
        Dim sDomain As String = "DomainGoesHere"
        'Used to load file path in from RetrieveFilePath()
        Dim sPath As String = ""

        Try
            If sActionID <> "" And iDocument = 1 Then
                'Starts impersonation
                Impersonator.Impersonator(sDomain, sUser, sPass)

                'Initializes a ProcessStartInfo Object to use with impersonation
                'as Process.Start class always inherits the security context of 
                'the parent process i.e. the local user
                Dim startInfo As New ProcessStartInfo()

                'Creates a secure string as the startInfo.Password parameter only accepts SecureStrings
                Dim securePass As New Security.SecureString()

                'You can't put a full string into a SecureString, so appending char by char
                For Each c As Char In sPass
                    securePass.AppendChar(c)
                Next

                'Grab the file path
                sPath = RetrieveFilePath()

                'Load in the parameters for startInfo
                startInfo.FileName = sPath
                startInfo.UserName = sUser
                startInfo.Password = securePass
                startInfo.Domain = sDomain
                startInfo.UseShellExecute = False
                startInfo.WorkingDirectory = "\\Directory\Goes Here"

                If File.Exists(sPath) Then
                    'Execute the process using startInfo
                    Process.Start(startInfo)
                Else
                    MsgBox("File Not Found!")
                End If

                'Dispose of securePass
                securePass.Dispose()

                'Ends Impersonation
                Impersonator.Undo()
            End If

        Catch ex As Exception
            MessageBox.Show("An error has occurred. Please contact Technical Support. " & vbCrLf & ex.Message, "Application Title", MessageBoxButtons.OK, MessageBoxIcon.Error)
            modGlobal.WriteToErrorLog(ex.Message, "frmActionEntry", modGlobal.GetExceptionInfo(ex), "frmActionEntry->btnOpenDoc_Click", currentUser.getEmployeeName())
        End Try
    End Sub

这里有一些有趣的方面需要注意。使用 ProcessStartInfo 时必须使用 SecureString 作为密码，并且只能按字符分配，更重要的是，我必须将 UseShellExecute 属性设置为 False。

我希望这会起作用，但经过一些迭代后，我遇到了这个错误消息：

Error Message Example

我发现这是由于无法访问 Windows Shell 来找到打开相应文件类型的默认程序，所以它只需要一个可执行文件。经过更多研究后，我无法找到解决此问题的干净方法，因此我决定以不同的方式解决此文件上传问题。

Answer 2

我知道这是一个老问题，但也许它可以帮助其他人，我遇到了同样的问题，最后，意识到授予模拟用户读取和写入文件夹的权限并进行修改是不够的，如果不这样做，用户将无法删除该文件。