Imports System.Net, System.Net.Sockets Imports System.Text Imports System.Threading Public Class frmServer 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 cbxInitAufschub.Checked = True cbxFSSATLAS.Checked = True End If If computername = "DEVELOPER" Then 'DEVELOPER SERVER cbxInitAufschub.Checked = True cbxFSSATLAS.Checked = False cbxFSSATLAS.Enabled = False cbxDatenserver.Enabled = True cbxDatenserver.Checked = True End If 'VERAG-ATLAS1 = SUBEN 'VERAG-ATLAS3 = SALZBURG If computername = "VERAG-ATLAS3" Or computername = "VERAG-ATLAS1" Then cbxFSSATLAS.Checked = True cbxInitAufschub.Checked = False cbxInitAufschub.Enabled = False End If ' cbxInitAufschub.Checked = True cbxInitAufschub.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 msg = msg.Replace(Convert.ToChar(0), "") ' MsgBox(msg) If False Then 'msg.Contains("|||") Then ''!!!!!!!!!!!!! NICHT FERTIG Dim split() As String = msg.Split("|||") Select Case split(0) Case "DATENSERVER_Upload" 'der Task initAufschubkonten wird aufgerufen ' MsgBox("initAufschubkonten") If Not boolDatenserver Then Me.writeToFrmLog(client, "DATENSERVER", "Abgebrochen - Task nicht aktiv " & msg) : Return "Task inactive" writeToFrmLog(client, "testDS", "testDS ") MsgBox(split(1)) ' Return "Task successful" Send("Task successful", client) 'Client-Mittelung Exit Function ' 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 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, "FSSAtlas", "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 startInitAufschubkonten(client As Socket) As Boolean Me.writeToFrmLog(client, "initAufschubkonten", "gestartet...") Try AtlasAufschubDatenEinlesen.initAllFiles("\\192.168.0.95\g\atlas\atlas\fssouzb") Me.writeToFrmLog(client, "initAufschubkonten", "Aufgabe 1/2 erledigt") AtlasAufschubDatenEinlesen.initAllFiles("\\192.168.133.98\g\atlas\atlas\fssouzb") Me.writeToFrmLog(client, "initAufschubkonten", "Aufgabe 2/2 erledigt") Send("Task successful", client) Me.writeToFrmLog(client, "initAufschubkonten", "beendet (Success)") Return True Catch ex As Exception Me.writeToFrmLog(client, "initAufschubkonten", "ERROR: Fehler frmAtalsAufschub: " & ex.Message) Return False End Try End Function Function startFSSAtlas(client As Socket) As Boolean Me.writeToFrmLog(client, "FSSAtlas", "gestartet...") Try ' AtlasAufschubDatenEinlesen.initAllFiles("\\192.168.0.95\g\atlas\atlas\fssouzb") Dim process As System.Diagnostics.Process = process.Start("G:\atlas\atlas\tools\fhpstart.exe") process.WaitForExit() Me.writeToFrmLog(client, "FSSAtlas", "Aufgabe 1/1 erledigt") Me.writeToFrmLog(client, "FSSAtlas", "beendet (Success)") Send("Task successful", client) Return True Catch ex As Exception Me.writeToFrmLog(client, "FSSAtlas", "ERROR: Fehler FSSAtlasStart: " & 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 cbxInitAufschub.CheckedChanged boolInitAufschub = cbxInitAufschub.Checked If cbxInitAufschub.Checked Then txtInitAufschubStatus.Text = "läuft" writeToFrmLog("initAufschubkonten", "läuft ...") txtInitAufschubStatus.ForeColor = Color.DarkGreen Else txtInitAufschubStatus.Text = "läuft nicht" writeToFrmLog("initAufschubkonten", "läuft nicht ...") txtInitAufschubStatus.ForeColor = Color.DarkRed End If End Sub Private Sub CheckBox1_CheckedChanged(sender As Object, e As EventArgs) Handles cbxFSSATLAS.CheckedChanged boolFSSAtlas = cbxFSSATLAS.Checked If cbxFSSATLAS.Checked Then txtFSSATLAS.Text = "läuft" writeToFrmLog("FSSAtlas", "läuft ...") txtFSSATLAS.ForeColor = Color.DarkGreen Else txtFSSATLAS.Text = "läuft nicht" writeToFrmLog("FSSAtlas", "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 CheckBox1_CheckedChanged_1(sender As Object, e As EventArgs) Handles cbxDatenserver.CheckedChanged boolDatenserver = cbxDatenserver.Checked If cbxFSSATLAS.Checked Then lblDatenserver.Text = "läuft" writeToFrmLog("DATENSERVER", "läuft ...") lblDatenserver.ForeColor = Color.DarkGreen Else lblDatenserver.Text = "läuft nicht" writeToFrmLog("DATENSERVER", "läuft nicht ...") lblDatenserver.ForeColor = Color.DarkRed End If End Sub Private Sub Label3_Click(sender As Object, e As EventArgs) Handles Label3.Click End Sub End Class