414 lines
17 KiB
VB.net
414 lines
17 KiB
VB.net
Imports System.Net, System.Net.Sockets
|
|
Imports System.Text
|
|
Imports System.Threading
|
|
|
|
Public Class frmRKSV
|
|
Dim serverSocket As Socket
|
|
Dim clientSocket As Socket
|
|
Dim byteData(1023) As Byte
|
|
|
|
Public Shared boolInitAufschub As Boolean = False
|
|
Public Shared boolFSSAtlas As Boolean = False
|
|
Public Shared boolDatenserver As Boolean = False
|
|
|
|
Dim splitPanelDefaultHeight As Integer = 0
|
|
|
|
Private Sub frmServer_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
|
|
splitPanelDefaultHeight = SplitContainer1.Panel2.Height
|
|
|
|
Dim computername As String = System.Environment.MachineName.ToUpper
|
|
|
|
If computername = "YLPS023046" Then 'DEVELOPER ANDREAS
|
|
cbxVERAG_DE.Checked = True
|
|
cbxAMBAR.Checked = True
|
|
End If
|
|
|
|
If computername = "DEVELOPER" Then 'DEVELOPER SERVER
|
|
cbxVERAG_DE.Checked = True
|
|
cbxAMBAR.Checked = True
|
|
cbxAMBAR.Enabled = True
|
|
End If
|
|
|
|
If True Or computername = "RKSV.........1" Then 'RKSV 1 SERVER,2
|
|
cbxVERAG_DE.Checked = True
|
|
cbxAMBAR.Checked = True
|
|
cbxAMBAR.Enabled = True
|
|
|
|
End If
|
|
|
|
' cbxInitAufschub.Checked = True
|
|
cbxVERAG_DE.Focus()
|
|
DIENST_InitSocket() 'initialisieren
|
|
End Sub
|
|
|
|
Sub DIENST_InitSocket()
|
|
serverSocket = New Socket(AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.Tcp)
|
|
Dim IpEndPoint As IPEndPoint = New IPEndPoint(IPAddress.Any, 8800)
|
|
serverSocket.Bind(IpEndPoint)
|
|
serverSocket.Listen(5)
|
|
serverSocket.BeginAccept(New AsyncCallback(AddressOf OnAccept), Nothing)
|
|
End Sub
|
|
|
|
Private Sub OnAccept(ByVal ar As IAsyncResult)
|
|
clientSocket = serverSocket.EndAccept(ar)
|
|
serverSocket.BeginAccept(New AsyncCallback(AddressOf OnAccept), Nothing)
|
|
AddClient(clientSocket)
|
|
End Sub
|
|
|
|
Delegate Sub _AddClient(ByVal client As Socket)
|
|
Private Sub AddClient(ByVal client As Socket) ' Neunen Client hinzufügen
|
|
If InvokeRequired Then
|
|
Invoke(New _AddClient(AddressOf AddClient), client)
|
|
Exit Sub
|
|
End If
|
|
writeToFrmLog(client, "", "Verbindungsaufbau.. ")
|
|
Send("ConSuccess", client) ' Der Client bekommt die Nachricht, dass die Verbindung steht...
|
|
'... jetzt kann der Client senden, der Server horcht...
|
|
clientSocket.BeginReceive(byteData, 0, byteData.Length, SocketFlags.None,
|
|
New AsyncCallback(AddressOf OnRecieve), clientSocket)
|
|
End Sub
|
|
|
|
Private Sub Send(ByVal msg As String, ByVal client As Socket) 'An den Client senden
|
|
Dim sendBytes As Byte() = Encoding.BigEndianUnicode.GetBytes(msg)
|
|
client.BeginSend(sendBytes, 0, sendBytes.Length, SocketFlags.None, New AsyncCallback(AddressOf OnSend), client)
|
|
End Sub
|
|
Private Sub OnSend(ByVal ar As IAsyncResult)
|
|
Dim client As Socket = ar.AsyncState
|
|
client.EndSend(ar)
|
|
End Sub
|
|
|
|
Private Sub OnRecieve(ByVal ar As IAsyncResult) ' Wenn ein Task-Befehl vom Client empfangen wurde
|
|
Dim client As Socket = ar.AsyncState
|
|
Try
|
|
client.EndReceive(ar)
|
|
Dim bytesRec As Byte() = byteData
|
|
Dim message As String = Encoding.BigEndianUnicode.GetString(bytesRec) '.Replace(Convert.ToChar(0), "")
|
|
Dim s As String = Read(message, client)
|
|
If s <> "" Then Send(s, client) ' Die Aufgabe wird abgearbeitet, der Client bekommt bei Fehler eine Antwort...
|
|
Catch ex As Exception
|
|
client.Shutdown(SocketShutdown.Both)
|
|
client.Close()
|
|
End Try
|
|
End Sub
|
|
Private Sub ListView1_SelectedIndexChanged(sender As Object, e As EventArgs)
|
|
|
|
End Sub
|
|
|
|
Delegate Function _Read(ByVal msg As String, client As Socket, messageFile() As Byte, fileName As String)
|
|
Private Function Read(ByVal msg As String, client As Socket, Optional messageFile() As Byte = Nothing, Optional fileName As String = "") As String
|
|
If InvokeRequired Then
|
|
Invoke(New _Read(AddressOf Read), msg, client, messageFile, fileName)
|
|
Return ""
|
|
End If
|
|
|
|
' writeToFrmLog(client, "testDS", msg)
|
|
|
|
msg = msg.Replace(Convert.ToChar(0), "")
|
|
' MsgBox(msg)
|
|
If True Then 'msg.Contains("|||") Then ''!!!!!!!!!!!!! NICHT FERTIG
|
|
Dim split() As String = msg.Split("|||")
|
|
Select Case split(0)
|
|
Case "RKSV_DE" 'der Task für die RKSV Signierung wird aufgerufen
|
|
'If Not boolDatenserver Then Me.writeToFrmLog(client, "DATENSERVER", "Abgebrochen - Task nicht aktiv " & msg) : Return "Task inactive"
|
|
|
|
If split.Length > 1 Then
|
|
Select Case split(1)
|
|
Case "VERAG_DE"
|
|
writeToFrmLog(client, "testDS", "VERAG_DE")
|
|
|
|
'' die eigentliche Funktion wird in einem Tread aufgrufen
|
|
'Dim thread As New Thread(AddressOf SignRKSV)
|
|
'thread.IsBackground = True
|
|
'thread.Start(client)
|
|
|
|
''Ein zweiter Thread kontrolliert, ob die Funktion nach einer gewissen Zeit noch läuft und beendet diese ggf.
|
|
'Dim st As New Thread(AddressOf stopThread)
|
|
'st.IsBackground = True
|
|
'Dim param_obj(3) As Object
|
|
''Übergabeparameter des 2. Threads
|
|
'param_obj(0) = thread
|
|
'param_obj(1) = client
|
|
'param_obj(2) = 110 'SEKUNDEN
|
|
'st.Start(param_obj)
|
|
|
|
' Return "Task successful"
|
|
Send("Task successful", client) 'Client-Mittelung
|
|
|
|
Case "AMBAR"
|
|
|
|
writeToFrmLog(client, "testDS", "AMBAR")
|
|
|
|
' die eigentliche Funktion wird in einem Tread aufgrufen
|
|
Dim thread As New Thread(AddressOf SignRKSV_AMBAR)
|
|
thread.IsBackground = True
|
|
thread.Start(client)
|
|
|
|
'Ein zweiter Thread kontrolliert, ob die Funktion nach einer gewissen Zeit noch läuft und beendet diese ggf.
|
|
Dim st As New Thread(AddressOf stopThread)
|
|
st.IsBackground = True
|
|
Dim param_obj(3) As Object
|
|
'Übergabeparameter des 2. Threads
|
|
param_obj(0) = thread
|
|
param_obj(1) = client
|
|
param_obj(2) = 110 'SEKUNDEN
|
|
st.Start(param_obj)
|
|
|
|
' Return "Task successful"
|
|
Send("Task successful", client) 'Client-Mittelung
|
|
End Select
|
|
End If
|
|
|
|
|
|
|
|
|
|
Return ""
|
|
End Select
|
|
'Else
|
|
' Select Case msg
|
|
' Case "test" 'nur ein Test, des Ergbnis ist immer Positiv
|
|
' writeToFrmLog(client, "test", "test ")
|
|
' ' Return "Task successful"
|
|
' Send("Task successful", client) 'Client-Mittelung
|
|
' Case "initAufschubkonten" 'der Task initAufschubkonten wird aufgerufen
|
|
' ' MsgBox("initAufschubkonten")
|
|
' If Not boolInitAufschub Then Me.writeToFrmLog(client, "initAufschubkonten", "Abgebrochen - Task nicht aktiv " & msg) : Return "Task inactive"
|
|
|
|
' ' die eigentliche Funktion wird in einem Tread aufgrufen
|
|
' Dim thread As New Thread(AddressOf startInitAufschubkonten)
|
|
' thread.IsBackground = True
|
|
' thread.Start(client)
|
|
|
|
' 'Ein zweiter Thread kontrolliert, ob die Funktion nach einer gewissen Zeit noch läuft und beendet diese ggf.
|
|
' Dim st As New Thread(AddressOf stopThread)
|
|
' st.IsBackground = True
|
|
' Dim param_obj(3) As Object
|
|
' 'Übergabeparameter des 2. Threads
|
|
' param_obj(0) = thread
|
|
' param_obj(1) = client
|
|
' param_obj(2) = 60
|
|
' st.Start(param_obj)
|
|
|
|
' Return ""
|
|
' Case "FSSAtlasStart" 'der Task initAufschubkonten wird aufgerufen
|
|
' ' MsgBox("initAufschubkonten")
|
|
' If Not boolFSSAtlas Then Me.writeToFrmLog(client, "KASSE_AMBAR", "Abgebrochen - Task nicht aktiv " & msg) : Return "Task inactive"
|
|
|
|
' ' die eigentliche Funktion wird in einem Tread aufgrufen
|
|
' Dim thread As New Thread(AddressOf startFSSAtlas)
|
|
' thread.IsBackground = True
|
|
' thread.Start(client)
|
|
|
|
' 'Ein zweiter Thread kontrolliert, ob die Funktion nach einer gewissen Zeit noch läuft und beendet diese ggf.
|
|
' Dim st As New Thread(AddressOf stopThread)
|
|
' st.IsBackground = True
|
|
' Dim param_obj(3) As Object
|
|
' 'Übergabeparameter des 2. Threads
|
|
' param_obj(0) = thread
|
|
' param_obj(1) = client
|
|
' param_obj(2) = 110 'SEKUNDEN
|
|
' st.Start(param_obj)
|
|
|
|
' Return ""
|
|
|
|
' End Select
|
|
End If
|
|
Return "Task not found"
|
|
Me.writeToFrmLog(client, "", "ERROR: Undefinierter Task: " & msg)
|
|
|
|
End Function
|
|
|
|
|
|
Sub stopThread(param_obj As Object) 'Stoppt einen Hauptthread nach einer gewissen Anzahl von Sekunden; Übergabeparameter: Object { Tread, clientSocket, SekundenToTimeout }
|
|
Thread.Sleep(param_obj(2) * 1000) ' Hier wird soviele Senkunden gewartet, wie in den Übergabeparametern definiert wurde.
|
|
If param_obj(0).IsAlive Then
|
|
param_obj(0).Abort() ' Wenn der Hauptthread noch immer läuft, wird er jetzt beendet.
|
|
Else
|
|
Exit Sub
|
|
End If
|
|
Send("Task timeout", param_obj(1)) 'Client-Mittelung
|
|
Me.writeToFrmLog(param_obj(1), "ERROR: Task wurde aufgrund eines Timeouts abgebrochen.") 'Log-Mittelung
|
|
End Sub
|
|
|
|
|
|
|
|
Function SignRKSV(client As Socket) As Boolean
|
|
Me.writeToFrmLog(client, "KASSE_VERAG_DE", "Signierung gestartet...")
|
|
|
|
Try
|
|
'SIGNIERUNG"!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
|
|
Me.writeToFrmLog(client, "KASSE_VERAG_DE", "Signierung beendet (Success)")
|
|
Send("Task successful", client)
|
|
Return True
|
|
Catch ex As Exception
|
|
Me.writeToFrmLog(client, "KASSE_VERAG_DE", "ERROR: Fehler Signierung: " & ex.Message)
|
|
Send("Task error", client)
|
|
Return False
|
|
End Try
|
|
End Function
|
|
|
|
|
|
Function SignRKSV_AMBAR(client As Socket) As Boolean
|
|
Me.writeToFrmLog(client, "KASSE_AMBAR", "Signierung gestartet...")
|
|
|
|
Try
|
|
'SIGNIERUNG"!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
|
|
Me.writeToFrmLog(client, "KASSE_AMBAR", "Signierung beendet (Success)")
|
|
Send("Task successful", client)
|
|
Return True
|
|
Catch ex As Exception
|
|
Me.writeToFrmLog(client, "KASSE_AMBAR", "ERROR: Fehler Signierung: " & ex.Message)
|
|
Send("Task error", client)
|
|
Return False
|
|
End Try
|
|
End Function
|
|
|
|
|
|
'Threadsichere Funktion zum schreiben in die TextBox:
|
|
Delegate Sub writeToFrmLogCallback(ByVal client As Socket, ByVal nameTask As String, ByVal text As String)
|
|
Public Sub writeToFrmLog(ByVal client As Socket, ByVal nameTask As String, ByVal text As String)
|
|
|
|
' InvokeRequired required compares the thread ID of the
|
|
' calling thread to the thread ID of the creating thread.
|
|
' If these threads are different, it returns true.
|
|
If Me.txtLog.InvokeRequired Then
|
|
Dim d As New writeToFrmLogCallback(AddressOf writeToFrmLog)
|
|
Me.Invoke(d, New Object() {client, nameTask, text})
|
|
Else
|
|
Dim remoteIpEndPoint As IPEndPoint = client.RemoteEndPoint
|
|
Me.txtLog.Text &= Now.ToString("dd.MM.yyyy HH:mm ") & nameTask & " (" & remoteIpEndPoint.Address.ToString & "): " & text & vbNewLine
|
|
If Me.txtLog.Lines.Count > 35 Then
|
|
Dim arr As String() = Me.txtLog.Lines
|
|
Me.txtLog.Text = ""
|
|
For i = arr.Count - 35 To arr.Count - 1
|
|
Me.txtLog.Text &= arr(i) & vbNewLine
|
|
Next i
|
|
End If
|
|
End If
|
|
Me.txtLog.SelectionLength = 0
|
|
End Sub
|
|
|
|
Public Sub writeToFrmLog(ByVal nameTask As String, ByVal text As String)
|
|
Me.txtLog.Text &= Now.ToString("dd.MM.yyyy HH:mm ") & nameTask & ": " & text & vbNewLine
|
|
If Me.txtLog.Lines.Count > 35 Then
|
|
Dim arr As String() = Me.txtLog.Lines
|
|
Me.txtLog.Text = ""
|
|
For i = arr.Count - 35 To arr.Count - 1
|
|
Me.txtLog.Text &= arr(i) & vbNewLine
|
|
Next i
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub CheckBox_CheckedChanged(sender As Object, e As EventArgs) Handles cbxVERAG_DE.CheckedChanged
|
|
boolInitAufschub = cbxVERAG_DE.Checked
|
|
If cbxVERAG_DE.Checked Then
|
|
txtInitAufschubStatus.Text = "läuft"
|
|
writeToFrmLog("KASSE_VERAG_DE", "läuft ...")
|
|
txtInitAufschubStatus.ForeColor = Color.DarkGreen
|
|
Else
|
|
txtInitAufschubStatus.Text = "läuft nicht"
|
|
writeToFrmLog("KASSE_VERAG_DE", "läuft nicht ...")
|
|
txtInitAufschubStatus.ForeColor = Color.DarkRed
|
|
End If
|
|
|
|
|
|
|
|
End Sub
|
|
|
|
Private Sub CheckBox1_CheckedChanged(sender As Object, e As EventArgs) Handles cbxAMBAR.CheckedChanged
|
|
|
|
|
|
boolFSSAtlas = cbxAMBAR.Checked
|
|
If cbxAMBAR.Checked Then
|
|
txtFSSATLAS.Text = "läuft"
|
|
writeToFrmLog("KASSE_AMBAR", "läuft ...")
|
|
txtFSSATLAS.ForeColor = Color.DarkGreen
|
|
Else
|
|
txtFSSATLAS.Text = "läuft nicht"
|
|
writeToFrmLog("KASSE_AMBAR", "läuft nicht ...")
|
|
txtFSSATLAS.ForeColor = Color.DarkRed
|
|
End If
|
|
|
|
|
|
End Sub
|
|
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
|
|
DIENST_InitSocket()
|
|
End Sub
|
|
|
|
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click 'geht nicht
|
|
clientSocket.Close()
|
|
|
|
If clientSocket.Connected Then
|
|
clientSocket.Shutdown(SocketShutdown.Both)
|
|
clientSocket.Close()
|
|
End If
|
|
clientSocket.Disconnect(True)
|
|
|
|
txtInitAufschubStatus.Text = "angehalten"
|
|
txtInitAufschubStatus.ForeColor = Color.DarkRed
|
|
End Sub
|
|
|
|
Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
|
|
clientSocket.Shutdown(SocketShutdown.Both)
|
|
clientSocket.Close()
|
|
serverSocket.Shutdown(SocketShutdown.Both)
|
|
serverSocket.Close()
|
|
DIENST_InitSocket()
|
|
End Sub
|
|
|
|
|
|
|
|
|
|
|
|
Private Result As Object = Nothing 'Store the worked result of abc()
|
|
Private Sub Worker(ByVal state As Object)
|
|
Dim are As AutoResetEvent = DirectCast(state, AutoResetEvent)
|
|
' do anything you want here:
|
|
|
|
|
|
|
|
|
|
|
|
Dim result As Integer = 0
|
|
'result = abc(input_val);
|
|
|
|
SyncLock Me.Result
|
|
Me.Result = result
|
|
End SyncLock
|
|
are.[Set]()
|
|
End Sub
|
|
Private Sub method()
|
|
|
|
Const TimeOut As Int32 = 5000
|
|
Dim [handles] As WaitHandle() = New WaitHandle() {New AutoResetEvent(False)}
|
|
|
|
ThreadPool.QueueUserWorkItem(New WaitCallback(AddressOf Worker), [handles](0))
|
|
Dim finished As Boolean = WaitHandle.WaitAll([handles], TimeOut, True)
|
|
'ThreadPool.RegisterWaitForSingleObject ()
|
|
|
|
If finished Then
|
|
' step 2
|
|
MessageBox.Show("Worker function finished sucessfully, go to Step2")
|
|
Else
|
|
' step 3
|
|
MessageBox.Show([String].Format("Worker function time out({0})!, go to Step3", TimeOut))
|
|
End If
|
|
End Sub
|
|
|
|
|
|
Private Sub LinkLabel1_LinkClicked(sender As Object, e As LinkLabelLinkClickedEventArgs) Handles LinkLabel1.LinkClicked
|
|
SplitContainer1.Panel2Collapsed = Not SplitContainer1.Panel2Collapsed
|
|
If SplitContainer1.Panel2Collapsed Then
|
|
Me.Height = 150
|
|
Else
|
|
Me.Height = 620
|
|
End If
|
|
End Sub
|
|
|
|
|
|
|
|
Private Sub Label3_Click(sender As Object, e As EventArgs) Handles Label3.Click
|
|
|
|
End Sub
|
|
End Class |