remoteapptool/RDPSign/RDPSign.vb

Public Class RDPSign
    Public ErrorNumber As Integer = 0
    Public ErrorString As String = ""
    Sub main()

    End Sub

    ''' <summary>
    ''' Get all Certificate friendly names
    ''' </summary>
    ''' <returns>String array of Certificate friendly names</returns>
    Function GetCertificateFriendlyName()
        Dim CertStoreLM As Security.Cryptography.X509Certificates.X509Store
        Dim CertStoreCU As Security.Cryptography.X509Certificates.X509Store
        CertStoreLM = GetCertificateStoreLM()
        CertStoreCU = GetCertificateStoreCU()

        Dim FriendlyNames(CertStoreLM.Certificates.Count + CertStoreCU.Certificates.Count) As String
        Dim Counter As Integer = 0
        For Each Certificate In CertStoreLM.Certificates
            If Certificate.FriendlyName IsNot "" Then
                FriendlyNames(Counter) = Certificate.FriendlyName
                Counter = Counter + 1
            End If
        Next
        For Each Certificate In CertStoreCU.Certificates
            If Certificate.FriendlyName IsNot "" Then
                FriendlyNames(Counter) = Certificate.FriendlyName
                Counter = Counter + 1
            End If
        Next
        Array.Resize(FriendlyNames, Counter)
        Return FriendlyNames
    End Function

    ''' <summary>
    ''' Open the Local Machine certificate store and return it to the calling function/sub
    ''' </summary>
    ''' <returns>Certificate Store</returns>
    Function GetCertificateStoreLM()
        Dim CertStore As New Security.Cryptography.X509Certificates.X509Store(Security.Cryptography.X509Certificates.StoreLocation.LocalMachine)
        CertStore.Open(Security.Cryptography.X509Certificates.OpenFlags.ReadOnly)
        Return CertStore
    End Function

    ''' <summary>
    ''' Open the Current User certificate store and return it to the calling function/sub
    ''' </summary>
    ''' <returns>Certificate Store</returns>
    Function GetCertificateStoreCU()
        Dim CertStore As New Security.Cryptography.X509Certificates.X509Store(Security.Cryptography.X509Certificates.StoreLocation.CurrentUser)
        CertStore.Open(Security.Cryptography.X509Certificates.OpenFlags.ReadOnly)
        Return CertStore
    End Function

    ''' <summary>
    ''' Given a friendly name, find and return the associated thumbprint
    ''' </summary>
    ''' <param name="FriendlyName">String of the Friendly Name of a certificate</param>
    ''' <returns>String of the thumbprint of the certificate</returns>
    Function GetThumbprint(FriendlyName As String)
        Dim Thumbprint As String
        Dim CertStoreLM As Security.Cryptography.X509Certificates.X509Store
        CertStoreLM = GetCertificateStoreLM()
        For Each certificate In CertStoreLM.Certificates
            If certificate.FriendlyName = FriendlyName Then
                Thumbprint = certificate.Thumbprint
                CertStoreLM.Close()
                Return Thumbprint
            End If
        Next
        CertStoreLM.Close()
        Dim CertStoreCU As Security.Cryptography.X509Certificates.X509Store
        CertStoreCU = GetCertificateStoreCU()
        For Each certificate In CertStoreCU.Certificates
            If certificate.FriendlyName = FriendlyName Then
                Thumbprint = certificate.Thumbprint
                CertStoreCU.Close()
                Return Thumbprint
            End If
        Next
        ' We could get here if something went wrong such as Certificate was removed from certificate store after it was loaded into the application
        ' return an invalid thumbprint
        Return "0000"
    End Function

    ''' <summary>
    ''' Sign an RDP file and make a backup of the unsigned one if requested
    ''' </summary>
    ''' <param name="Thumbprint">Thumbprint used to sign RDP file</param>
    ''' <param name="RDPFileLocation">Location of RDP file</param>
    ''' <param name="CreateBackup">Boolean indicating if a backup should be created or not</param>
    Sub SignRDP(Thumbprint As String, RDPFileLocation As String, CreateBackup As Boolean)
        If Thumbprint = "0000" Then
            'Invalid thumbprint, this should be handled on the application side, but just as a safety, return without doing any work if invalid thumbprint sent
            Return
        End If
        If CreateBackup Then
            Dim BackupFile = System.IO.Path.GetDirectoryName(RDPFileLocation) & "\" & System.IO.Path.GetFileNameWithoutExtension(RDPFileLocation) & "-Unsigned.rdp"
            System.IO.File.Copy(RDPFileLocation, BackupFile, True) 'backup file with overwrite
        End If

        'If we get here, we should be good to run the command to sign the RDP file.
        Dim Command As String = "C:\Windows\System32\rdpsign.exe"
        Dim Arguments As String
        Dim FileVersionInfo As FileVersionInfo = FileVersionInfo.GetVersionInfo(Command)
        ' On my windows 10 computer, the argument is /sha256 instead of /sha1.  /sha1 doesn't work.
        ' On my windows 10 computer, the Product parts come in at 10.0.18362.1
        ' On a Windows Server 2008 R2 server I have access to, the argument is /sha1.
        ' On a Windows Server 2008 R2 server I have access to, the Product parts come in at 6.1.7601.17514 which is lower than the windows 10 ones.
        ' I do not have other versions of windows to test, so will need external testing for this.
        ' Not sure where the version number switches over, but also not sure how to determine which method to use otherwise
        If (FileVersionInfo.ProductMajorPart >= 10) Then
            Arguments = " /sha256 " & Thumbprint & " """ & RDPFileLocation & """"

        Else
            Arguments = " /sha1 " & Thumbprint & " """ & RDPFileLocation & """"
        End If
        Dim StartInfo As New ProcessStartInfo
        StartInfo.FileName = Command
        StartInfo.Arguments = Arguments
        StartInfo.WindowStyle = ProcessWindowStyle.Hidden
        Process.Start(StartInfo)
    End Sub
End Class