ADMIN/ServerListender/frmServer.vb

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