<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
Private Class Client : Inherits DicomNet
Private waitEvent As AutoResetEvent = New AutoResetEvent(False)
Private clientPEM As String = LeadtoolsExamples.Common.ImagesPath.Path + "client.pem"
Public Sub New()
MyBase.New(Nothing, DicomNetSecurityeMode.Tls)
SetTlsCipherSuiteByIndex(0, DicomTlsCipherSuiteType.DheRsaWithDesCbcSha)
SetTlsClientCertificate(clientPEM, DicomTlsCertificateType.Pem, Nothing)
Dim cipherSuite As DicomTlsCipherSuiteType
cipherSuite = GetTlsCipherSuite()
Console.WriteLine("Encryption Algorithm is : {0}", GetTlsEncryptionAlgorithm(cipherSuite))
Console.WriteLine("Authentication Algorithm is : {0}", GetTlsAuthenticationAlgorithm(cipherSuite))
Console.WriteLine("Integrity Algorithm is : {0}", GetTlsIntegrityAlgorithm(cipherSuite))
Console.WriteLine("Key Exchange Algorithm is : {0}", GetTlsKeyExchangeAlgorithm(cipherSuite))
Console.WriteLine("Encryption Key Length is : {0}", GetTlsEncryptionKeyLength(cipherSuite))
Console.WriteLine("Mutual Authentication Key Length is : {0}", GetTlsMutualAuthenticationKeyLength(cipherSuite))
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
Private Class ServerConnection : Inherits DicomNet
Public Sub New()
MyBase.New(Nothing, DicomNetSecurityeMode.Tls, False)
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
Private certificationAuthoritiesFileName As String = LeadtoolsExamples.Common.ImagesPath.Path + "CA.pem"
Public Sub New()
MyBase.New(Nothing, DicomNetSecurityeMode.None)
End Sub
Protected Overrides Sub OnAccept(ByVal [error] As DicomExceptionCode)
Dim serverPEM As String = LeadtoolsExamples.Common.ImagesPath.Path + "server.pem"
client = New ServerConnection()
Dim settings As New DicomOpenSslContextCreationSettings(DicomSslMethodType.TlsV1, _
certificationAuthoritiesFileName, _
DicomOpenSslVerificationFlags.Peer Or DicomOpenSslVerificationFlags.FailIfNoPeerCertificate, _
2, _
DicomOpenSslOptionsFlags.NoSslV2 Or DicomOpenSslOptionsFlags.AllBugWorkarounds)
settings.MethodType = DicomSslMethodType.SslV23
settings.CertificationAuthoritiesFileName = certificationAuthoritiesFileName
settings.VerificationFlags = DicomOpenSslVerificationFlags.Peer Or DicomOpenSslVerificationFlags.FailIfNoPeerCertificate
settings.Options = DicomOpenSslOptionsFlags.NoSslV2 Or DicomOpenSslOptionsFlags.AllBugWorkarounds
client.Initialize(Nothing, DicomNetSecurityeMode.Tls, settings)
client.SetTlsCipherSuiteByIndex(0, DicomTlsCipherSuiteType.DheRsaWith3DesEdeCbcSha)
client.SetTlsClientCertificate(serverPEM, DicomTlsCertificateType.Pem, Nothing)
Accept(client)
End Sub
Protected Overloads Overrides Sub Dispose(ByVal __p1 As Boolean)
client.Dispose()
MyBase.Dispose(__p1)
End Sub
End Class
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)
client.Connect(Nothing, 1000, "127.0.0.1", 104)
If (Not client.Wait()) Then
Debug.Fail("Connection timed out")
End If
Debug.Assert(client.IsConnected(), "Client not connected")
If (Not client.Wait()) Then
Debug.Fail("Connection timed out waiting for authenication")
End If
client.CloseForced(True)
End Using
server.CloseForced(True)
End Using
DicomEngine.Shutdown()
DicomNet.Shutdown()
End Sub |
Syntax
Copy Code