以编程方式将SSL证书附加到IIS中的站点

时间:2016-04-08 19:40:39

标签: vb.net ssl-certificate iis-6

我现在正在寻找解决我问题的方法,并且几乎没有发现任何问题。这是问题:我需要将SSL证书附加到IIS 6中的网站。我可以设置https绑定,但每次我尝试设置证书的指纹和证书存储时,对于绑定我都会获得COM异常。这是我的代码。

    Private Const UnformattedMetabasePathForSiteProperties As String = "IIS://localhost/W3SVC/{0}"
    Private metabasePath As String
    Public Sub BindCertificateToSite(iisSiteId As Integer, ByVal aCertificate As X509Certificate2) Implements IIisSslHandler.BindCertificatetoSite
        metabasePath = UnformattedMetabasePathForSiteProperties.FormatIt(iisSiteId)
        Dim ipAddress As String = GetProperty(metabasePath, "ServerBindings")
        Contract.Require(Not String.IsNullOrEmpty(ipAddress), New Exception("Failed to find the site's http binding and IP address. Can not bind certificate to site."))
        ipAddress = ipAddress.Split(":")(0)
        SetProperty(metabasePath, "SecureBindings", ipAddress & ":443:", True)
        SetProperty(metabasePath, "SSLStoreName", "MY", True)
        SetBinaryProperty(metabasePath, "SSLCertHash", aCertificate.Thumbprint, True)
    End Sub

    Private Sub SetProperty(ByVal metabasePath As String, ByVal propertyName As String, ByVal newValue As Object, clearCurrentValue As Boolean)
        Dim path As DirectoryEntry
        path = New DirectoryEntry(metabasePath)
        If clearCurrentValue Then path.Properties(propertyName).Clear()
        path.Properties(propertyName).Add(newValue)
        path.CommitChanges()
    End Sub

    Private Sub SetBinaryProperty(ByVal metabasePath As String, ByVal propertyName As String, ByVal newValue As Object, clearCurrentValue As Boolean)
        Dim path As DirectoryEntry
        path = New DirectoryEntry(metabasePath)
        Dim propValues As PropertyValueCollection
        propValues = path.Properties(propertyName)
        If clearCurrentValue Then propValues.Clear()
        propValues.Add(newValue)
        path.CommitChanges()
    End Sub

我在对于SSLStoreName和SSLCertHash的propValues.Add调用中获得的异常

SSLStoreName exception: An exception of type 'System.Runtime.InteropServices.COMException' occurred in System.DirectoryServices.dll but was not handled in user code. Additional information: A specified logon session does not exist. It may already have been terminated. (Exception from HRESULT: 0x80070520)

SSLCertHash Exception: An exception of type 'System.Runtime.InteropServices.COMException' occurred in mscorlib.dll but was not handled in user code. Additional information: Exception from HRESULT: 0x8000500C

我在网上的堆栈和其他网站上发现了其他问题,这些问题似乎指向了.Net框架中的一个缺陷,但是我希望在这里并非如此。所以我的问题是:为什么这不起作用,我该如何解决?

1 个答案:

答案 0 :(得分:0)

好的,所以我终于开始工作了。因此,我将为未来的堆叠器和我自己发布此代码。

Private Const UnformattedMetabasePathForSiteProperties As String = "IIS://localhost/W3SVC/{0}"
Private metabasePath As String
Public Sub BindCertificateToSite(iisSiteId As Integer, ByVal aCertificate As X509Certificate2) Implements IIisSslHandler.BindCertificatetoSite
    metabasePath = UnformattedMetabasePathForSiteProperties.FormatIt(iisSiteId)
    Dim ipAddress As String = GetProperty(metabasePath, "ServerBindings")
    Contract.Require(Not String.IsNullOrEmpty(ipAddress), New Exception("Failed to find the site's http binding and IP address. Can not bind certificate to site."))
    ipAddress = ipAddress.Split(":")(0)
    SetProperty(metabasePath, "SecureBindings", ipAddress & ":443:", True)
    SetProperty(metabasePath, "SSLStoreName", "MY", True)
    SetBinaryProperty(metabasePath, "SSLCertHash", aCertificate.GetCertHash(), True)
End Sub

Private Sub SetProperty(ByVal metabasePath As String, ByVal propertyName As String, ByVal newValue As Object, clearCurrentValue As Boolean)
    Dim path As DirectoryEntry
    path = New DirectoryEntry(metabasePath)
    If clearCurrentValue Then path.Properties(propertyName).Clear()
    path.Invoke("Put", propertyName, newValue)
    path.CommitChanges()
End Sub

Private Sub SetBinaryProperty(ByVal metabasePath As String, ByVal propertyName As String, ByVal newValue As Object, clearCurrentValue As Boolean)
    Dim path As DirectoryEntry
    path = New DirectoryEntry(metabasePath)
    Dim propValues As PropertyValueCollection
    propValues = path.Properties(propertyName)
    If clearCurrentValue Then propValues.Clear()
    path.Invoke("Put", propertyName, newValue)
    path.CommitChanges()
End Sub