GetTlsCipherSuiteByIndex Method

Imports Leadtools
  Imports Leadtools.Dicom

  <StructLayout(LayoutKind.Sequential)> _
  Public Structure MSG
      Public hwnd As IntPtr
      Public message As UInteger
      Public wParam As IntPtr
      Public lParam As IntPtr
      Public time As UInteger
      Public p As System.Drawing.Point
  End Structure
  Public Enum WaitReturn
      Complete
      Timeout
  End Enum

  Private Class Utils
   <DllImport("user32.dll")> _
   Shared Function PeekMessage(<System.Runtime.InteropServices.Out()> ByRef lpMsg As MSG, ByVal hWnd As IntPtr, ByVal wMsgFilterMin As UInteger, _
                                  ByVal wMsgFilterMax As UInteger, ByVal wRemoveMsg As UInteger) As <MarshalAs(UnmanagedType.Bool)> Boolean
   End Function

      <DllImport("user32.dll")> _
      Shared Function TranslateMessage(ByRef lpMsg As MSG) As Boolean
      End Function
      <DllImport("user32.dll")> _
      Shared Function DispatchMessage(ByRef lpmsg As MSG) As IntPtr
      End Function

      Private Const PM_REMOVE As UInteger = 1

      Public Shared Function WaitForComplete(ByVal mill As Double, ByVal wh As WaitHandle) As WaitReturn
          Dim goal As TimeSpan = New TimeSpan(DateTime.Now.AddMilliseconds(mill).Ticks)

          Do
              Dim msg As MSG = New MSG()

              If PeekMessage(msg, IntPtr.Zero, 0, 0, PM_REMOVE) Then
                  TranslateMessage(msg)
                  DispatchMessage(msg)
              End If

              If wh.WaitOne(New TimeSpan(0, 0, 0), False) Then
                  Return WaitReturn.Complete
              End If

              If goal.CompareTo(New TimeSpan(DateTime.Now.Ticks)) < 0 Then
                  Return WaitReturn.Timeout
              End If

          Loop While True
      End Function
  End Class

  '
  ' Secure client (TLS)
  '
  Private Class Client : Inherits DicomNet
      Private waitEvent As AutoResetEvent = New AutoResetEvent(False)
   Private clientPEM As String = Path.Combine(LEAD_VARS.ImagesDir, "client.pem")

   Public Sub New()
      MyBase.New(Nothing, DicomNetSecurityeMode.Tls)
      SetTlsCipherSuiteByIndex(0, DicomTlsCipherSuiteType.DheRsaWithDesCbcSha)
      SetTlsClientCertificate(clientPEM, DicomTlsCertificateType.Pem, Nothing)
   End Sub

   Public Function Wait() As Boolean
      Dim ret As WaitReturn

      ret = Utils.WaitForComplete((5 * 60) * 1000, waitEvent)

      Return (ret = WaitReturn.Complete)
   End Function

   Protected Overrides Sub OnConnect(ByVal [error] As DicomExceptionCode)
      waitEvent.Set()
   End Sub

   Protected Overrides Function OnPrivateKeyPassword(ByVal encryption As Boolean) As String
      Return "test"
   End Function

   Protected Overrides Sub OnSecureLinkReady(ByVal [error] As DicomExceptionCode)
      waitEvent.Set()
   End Sub
End Class

'
' Secure server (TLS)
'
Private Class ServerConnection : Inherits DicomNet

   Private serverPEM As String = Path.Combine(LEAD_VARS.ImagesDir, "server.pem")

   Public Sub New()
      MyBase.New(Nothing, DicomNetSecurityeMode.Tls)
      SetTlsCipherSuiteByIndex(0, DicomTlsCipherSuiteType.DheRsaWith3DesEdeCbcSha)
      SetTlsClientCertificate(serverPEM, DicomTlsCertificateType.Pem, Nothing)
   End Sub

   Protected Overrides Function OnPrivateKeyPassword(ByVal encryption As Boolean) As String
      Return "test"
   End Function
End Class

  Private Class Server : Inherits DicomNet
      Private client As ServerConnection

      Public Sub New()
          MyBase.New(Nothing, DicomNetSecurityeMode.None)
      End Sub

      Protected Overrides Sub OnAccept(ByVal [error] As DicomExceptionCode)
          client = New ServerConnection()

          Accept(client)
      End Sub

      Protected Overloads Overrides Sub Dispose(ByVal __p1 As Boolean)
          client.Dispose()
          MyBase.Dispose(__p1)
      End Sub
  End Class


  <TestMethod()> _
  Public Sub TLSSecuritySample()
      DicomEngine.Startup()
      DicomNet.Startup()

      Using server As Server = New Server()
          Using client As Client = New Client()
              server.Listen("127.0.0.1", 104, 1) ' start server
              client.Connect(Nothing, 1000, "127.0.0.1", 104) ' connect to server
              If (Not client.Wait()) Then ' wait for connection to finish
                  Debug.Fail("Connection timed out")
              End If

              Debug.Assert(client.IsConnected(), "Client not connected")

              '
              ' Wait for authenication
              '
              If (Not client.Wait()) Then
                  Debug.Fail("Connection timed out waiting for authenication")
              End If

              ' Once two computers have negotiated the ciphersuite, and have 
              ' authenticated each other, they can begin transferring 
              ' messages and data between them.

               ' Now we can get detailed information about the Cipher Suite 
               Dim cipherSuite As DicomTlsCipherSuiteType
               cipherSuite = client.GetTlsCipherSuite()

               Console.WriteLine("Encryption Algorithm is : {0}",             client.GetTlsEncryptionAlgorithm(cipherSuite))
               Console.WriteLine("Authentication Algorithm is : {0}",         client.GetTlsAuthenticationAlgorithm(cipherSuite))
               Console.WriteLine("Integrity Algorithm is : {0}",              client.GetTlsIntegrityAlgorithm(cipherSuite))
               Console.WriteLine("Key Exchange Algorithm is : {0}",           client.GetTlsKeyExchangeAlgorithm(cipherSuite))
               Console.WriteLine("Encryption Key Length is : {0}",            client.GetTlsEncryptionKeyLength(cipherSuite))
               Console.WriteLine("Mutual Authentication Key Length is : {0}", client.GetTlsMutualAuthenticationKeyLength(cipherSuite))

              ' Continue with normal dicom communication

              client.CloseForced(True)
          End Using
          server.CloseForced(True)
      End Using

      DicomEngine.Shutdown()
      DicomNet.Shutdown()
  End Sub

  Public NotInheritable Class LEAD_VARS
  Public Const ImagesDir As String = "C:\Users\Public\Documents\LEADTOOLS Images"
  End Class