neu
This commit is contained in:
414
RKSV_DE/frmRKSV.vb
Normal file
414
RKSV_DE/frmRKSV.vb
Normal file
@@ -0,0 +1,414 @@
|
||||
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
|
||||
Reference in New Issue
Block a user