Beiträge von woemoe

'in disem Modul befindet sich die Erstellung des Unix Zeitstempels
    'Füllen eines Array mit Status 1-6
    'schreiben eines Narcihten Strings mit dem entsprechenden Status und aktuellem Zeitstempel


    Public ArrStatusListe(5, 3)

    Sub Test()
        Dim Zeitstempel As Long
        Dim Nachricht As String 'der zu übergebende Text an den EM
        Dim Status As String 'Die eigentliche Statusmeldung
        Dim Issi As String 'Absender Kennung des Fahrzeuges
        Zeitstempel = ZeitstempelUnix("Unix", 0)
        MsgBox(Zeitstempel)

        Nachricht = StatusString(Zeitstempel, "1", "454545") 'StatusString(Zeitstempel, Status, Issi)
        Console.WriteLine(Nachricht)

    End Sub

    Public Function ZeitstempelUnix(Art As String, UnixNr As Long) As Long
        'Übergabeparameter Art ist entwerder "Datum" um einen Wert aus einem Unix zu erstellen
        'oder ein "Unix" um das aktuelle Datum in einen Unix Zeitstempel zu wandeln
        'UnixNr wird benötigt wenn daraus das Datum wiedergegebn werden soll

        Dim Datum As Date ' heutiges Datum
        Dim DatumToUnix As Long 'Unix Zahlenwert in MS
        Dim UnixtoDatum As Long 'Zahlenwert nach Unix gewandelt in Datum Zeit

        Datum = Now() 'CDate("04.07.2017 09:14:48")
        Console.WriteLine(Datum)
        ''Variante 1 geht auf sekunden
        DatumToUnix = DateDiff("s", DateSerial(1970, 1, 1), Datum)
        DatumToUnix = DatumToUnix * 1000
        Console.WriteLine("V1 " & DatumToUnix)

        'Variante 2 geht auf millisekunden
        'DatumToUnix = (Datum - DateSerial(1970, 1, 1)) * 86400000
        'Console.WriteLine("V2 " & lngUnix_Date)

        UnixtoDatum = UnixNr / 86400000 + 25569
        Console.WriteLine(UnixtoDatum)

        If Art = "Unix" Then
            ZeitstempelUnix = DatumToUnix
        ElseIf Art = "Datum" Then
            If UnixNr = 0 Then
                MsgBox("Sie haben die Funktion ohne Unix Nummer aufgerufen somit wird Null zurück gegeben")
                ZeitstempelUnix = 0
            End If
        End If
    End Function



    Public Function StatusString(Zeitstempel As Long, Status As String, Issi As String) As String

        Dim ID As Integer
        'prüfen ob die Status Liste Gefüllt ist
        If ArrStatusListe(0, 0) = "" Then
            ArrStatusListe = ArrStatus()
        End If
        'Prüfen ob der Zeitstempel gefüllt ist
        If Zeitstempel = 0 Then
            Zeitstempel = ZeitstempelUnix("Unix", 0)
        End If
        'Der Status muss in eine andere Nummer übergeben werden
        ID = 10
        If Status = "1" Then
            ID = 0
        ElseIf Status = "2" Then
            ID = 1
        ElseIf Status = "3" Then
            ID = 2
        ElseIf Status = "4" Then
            ID = 3
        ElseIf Status = "5" Then
            ID = 4
        ElseIf Status = "6" Then
            ID = 5
        End If
        If ID = 10 Then
            MsgBox("Es wurde kein Status gefunden, oder der Status liegt nicht zwischen 1-6")
            MsgBox("Es wird der Status 2 übergeben")
            ID = 1
            'Exit Function
        End If
        Dim Zeitformat As String = "2018-03-22T" & Hour(Now) & ":" & Minute(Now) & ":" & Second(Now)
        Console.WriteLine(Zeitformat)
        Console.WriteLine("2018-02-28T16:52:07")
        'StatusString = "{""type"":""status"",""status"":""2"",""statusCode"":""8004"",""statusText"":""Einsatz-Bereit Wache"",""destSSI"":""Ziel"",""destName"":""NamedesZiels"",""srcSSI"":""Absender"",""srcName"":""FunkrufnameSender"",""ts"":""\/Date(ZeitinSekunden\/"",""radioID"":FunkgerätID"",""radioName"":""Funkgerätname"",""remark"":""}"
        '{"type":"status","status":1,"statusCode":8003,"statusText":Frei Verfügbar auf fahrt,"destSSI":"Ziel","destName":"NamedesZiels","srcSSI":454545,"srcName":"FunkrufnameSender","ts":"\/Date(1521640638000\/","radioID":FunkgerätID","radioName":"Funkgerätname","remark":"}
        '{"type":"status","status":1,{"type":"status","status":"2","statusCode":"8004","statusText":"Einsatz-Bereit Wache","destSSI":"Ziel","destName":"NamedesZiels","srcSSI":"Absender","srcName":"FunkrufnameSender","ts":"\/Date(ZeitinSekunden\/","radioID":FunkgerätID","radioName":"Funkgerätname","remark":"}
        'StatusString = "{""type"":""status"",""status"":" & ArrStatusListe(ID, 1) & ",""statusCode"":" & ArrStatusListe(ID, 2) & ",""statusText"":" & ArrStatusListe(ID, 3) & ",""destSSI"":""Ziel"",""destName"":""NamedesZiels"",""srcSSI"":" & Issi & ",""srcName"":""FunkrufnameSender"",""ts"":""\/Date(" & Zeitstempel & "\/"",""radioID"":FunkgerätID"",""radioName"":""Funkgerätname"",""remark"":""}"
        'StatusString = "{""type"":""status"",""status"":" & """" & ArrStatusListe(ID, 1) & """" & ",""statusCode"":" & """" & ArrStatusListe(ID, 2) & """" & ",""statusText"":" & """" & ArrStatusListe(ID, 3) & """" & ",""destSSI"":""Ziel"",""destName"":""NamedesZiels"",""srcSSI"":" & """" & Issi & """" & ",""srcName"":""FunkrufnameSender"",""ts"":""\/Date(" & Zeitstempel & ")\/"",""radioID"":1,""radioName"":""Funkgeraetname"",""remark"":""Test""}"
        'StatusString = "{""type"":""status"",""status"":" & """" & ArrStatusListe(ID, 1) & """" & ",""statusCode"":" & """" & ArrStatusListe(ID, 2) & """" & ",""statusText"":" & """" & ArrStatusListe(ID, 3) & """" & ",""destSSI"":""Ziel"",""destName"":""NamedesZiels"",""srcSSI"":" & """" & Issi & """" & ",""srcName"":""FunkrufnameSender"",""ts"":""\/" & Zeitformat & "\/"",""radioID"":1,""radioName"":""Funkgeraetname"",""remark"":""Test""}"
        StatusString = "{""type"":""status"",""status"":" & """" & ArrStatusListe(ID, 1) & """" & ",""statusCode"":" & """" & ArrStatusListe(ID, 2) & """" & ",""statusText"":" & """" & ArrStatusListe(ID, 3) & """" & ",""destSSI"":""Ziel"",""destName"":""NamedesZiels"",""srcSSI"":" & """" & Issi & """" & ",""srcName"":""FunkrufnameSender"",""ts"":" & """" & Zeitformat & """" & ",""radioID"":1,""radioName"":""Funkgeraetname"",""remark"":""Test""}"



    End Function

    Function ArrStatus()

        Dim Arr(5, 3)

        Arr(0, 1) = "1"
        Arr(0, 2) = "8003"
        Arr(0, 3) = "Frei Verfuegbar auf fahrt"

        Arr(1, 1) = "2"
        Arr(1, 2) = "8004"
        Arr(1, 3) = "Einsatzbereit Wache"

        Arr(2, 1) = "3"
        Arr(2, 2) = "8003"
        Arr(2, 3) = "Einsatzauftrag uebernommen"

        Arr(3, 1) = "4"
        Arr(3, 2) = "8003"
        Arr(3, 3) = "Einsatzstelle eingetroffen"

        Arr(4, 1) = "5"
        Arr(4, 2) = "8003"
        Arr(4, 3) = "Sprechwunsch"

        Arr(5, 1) = "6"
        Arr(5, 2) = "8003"
        Arr(5, 3) = "Nicht Einsatzbereit"

        ArrStatus = Arr


    End Function

End Module

Imports System.Net.Sockets
Imports System.Net
Imports System.Threading
Imports System.Net.WebSockets



Module Module1
    Dim serverTcp As TcpListener
    Dim serverThread As Thread
    Dim ipendpoint As IPEndPoint = New IPEndPoint(IPAddress.Any, 9090)

    Sub Main()
        '' Start server
        serverThread = New Thread(AddressOf serverProc)
        serverThread.Start()

        Dim Text As String = StatusString(0, "3", "4671234")
        'If MsgBox("senden", vbYesNo) = vbYes Then
        'SendMessage(sck:=51783, message:=Text)
        'End If
    End Sub

    Private Sub serverProc()
        '' Listen to port 8181
        serverTcp = New TcpListener(ipendpoint)
        serverTcp.Start()

        Console.WriteLine("Listen to port 8080 ...")

        '' Accept any connection
        While (True)
            'MsgBox("Start")
            Dim curSocket As Socket = serverTcp.AcceptSocket()
            'MsgBox("Verbindung")
            Dim thread As New Thread(AddressOf clientProc)
            'MsgBox("Socket")
            thread.Start(curSocket)

        End While
        MsgBox("Wihle ende")




    End Sub

    Private Sub clientProc(ByVal sck As Socket)
        Dim netStream As New NetworkStream(sck)
        Dim netReader As New IO.StreamReader(netStream)
        Dim netWriter As New IO.StreamWriter(netStream)
        Dim key As String = ""
        Dim t As SocketInformation
        Console.WriteLine("Accept new connection ...")

        '' Reading handshake message
        While (True)
            Dim line As String = netReader.ReadLine()
            If line.Length = 0 Then
                Exit While
            End If

            If (line.StartsWith("Sec-WebSocket-Key: ")) Then
                key = line.Split(":")(1).Trim()
            End If

            Console.WriteLine("Data: " & line)
        End While

        '' Calculate accept-key
        key += "258EAFA5-E914-47DA-95CA-C5AB0DC85B11"
        '258EAFA5-E914-47DA-95CA-C5AB0DC85B11
        key = getSHA1Hash(key)

        ' Response handshake message
        Dim response As String
        response = "HTTP/1.1 101 Switching Protocols" & vbCrLf
        response &= "Upgrade: websocket" & vbCrLf
        response &= "Connection: Upgrade" & vbCrLf
        response &= "Sec-WebSocket-Accept: " & key & vbCrLf & vbCrLf
        netWriter.Write(response)
        netWriter.Flush()
        Console.Write(response)
        Console.WriteLine(sck.AddressFamily)
        Console.WriteLine(sck.Connected)
        'MsgBox(sck.AddressFamily)
        'sck.Accept()
        'MsgBox(sck.Connected)

        'senden eines Test Stauses
        'Dim message As String = "{""type"":""status"",""status"":""2"",""statusCode"":""8004"",""statusText"":""Einsatz-Bereit Wache"",""destSSI"":""Ziel"",""destName"":""NamedesZiels"",""srcSSI"":""Absender"",""srcName"":""FunkrufnameSender"",""ts"":""\/Date(ZeitinSekunden\/"",""radioID"":FunkgerätID"",""radioName"":""Funkgerätname"",""remark"":""}" '"Hello World"
        'Dim message As String = "{""type"": ""status"",""status"": ""1"",""statusCode"": ""8003"",""statusText"": ""Status 1 - E-Bereit Funk"",""destSSI"": ""2669900"",""destName"": ""Daten"",""srcSSI"": ""4671234"",""srcName"": ""GG 2-42-1"",""ts"": ""\/Date(1521653864655)\/"",""radioID"": 1,""radioName"": ""Extern"",""remark"": """"}"
        'Stop

        Dim message As String = StatusString(0, "3", "4671234")
        netWriter.Write(message)
        netWriter.Flush()
        Console.WriteLine(message)



        'message = "{""type"": ""status"",""statusCode"": ""8003"",""srcSSI"": ""4671234"",""}"
        'netWriter.Write(message)
        'netWriter.Flush()
        'Console.WriteLine(message)
        ''nochmal:
        '        message = InputBox("Bitte Jason eingeben")
        '        If message <> "" Then
        '            netWriter.Write(message)
        '            netWriter.Flush()
        '            Console.WriteLine(message)
        '            GoTo nochmal
        '        End If




        'Stop
        ' Sending Hello World message
        'Dim message As String = StatusString(0, "3", "4671234") '{""type"":""status"",""status"":""2"",""statusCode"":""8004"",""statusText"":""Einsatz-Bereit Wache"",""destSSI"":""Ziel"",""destName"":""NamedesZiels"",""srcSSI"":""Absender"",""srcName"":""FunkrufnameSender"",""ts"":""\/Date(ZeitinSekunden\/"",""radioID"":FunkgerätID"",""radioName"":""Funkgerätname"",""remark"":""}" '"Hello World"
        'Dim messageByte() As Byte = System.Text.Encoding.UTF8.GetBytes(message)
        'Dim startByte() As Byte = {&H0}
        'Dim endByte() As Byte = {&HFF}

        'sck.Send(startByte, 1, 0)
        'sck.Send(messageByte)
        'sck.Send(endByte, 1, 0)
        'Console.WriteLine(startByte)
        'Console.WriteLine(messageByte)
        'Console.WriteLine(endByte)


    End Sub

    Function getSHA1Hash(ByVal strToHash As String) As String
        'Dim sha1Obj As New Security.Cryptography.SHA1CryptoServiceProvider
        Dim sha1Obj As New System.Security.Cryptography.SHA1CryptoServiceProvider
        Dim bytesToHash() As Byte = System.Text.Encoding.ASCII.GetBytes(strToHash)
        Dim result As String

        bytesToHash = sha1Obj.ComputeHash(bytesToHash)
        result = Convert.ToBase64String(bytesToHash)

        Return result
    End Function
    Sub SendMessage(sck As Socket, message As String)
        Dim rawData = System.Text.Encoding.UTF8.GetBytes(message)
        MsgBox("er springt")
        Dim frameCount = 0
        Dim frame(10) As Byte

        frame(0) = CByte(129)

        If rawData.Length <= 125 Then
            frame(1) = CByte(rawData.Length)
            frameCount = 2
        ElseIf rawData.Length >= 126 AndAlso rawData.Length <= 65535 Then
            frame(1) = CByte(126)
            Dim len = CByte(rawData.Length)
            frame(2) = CByte(((len >> 8) & CByte(255)))
            frame(3) = CByte((len & CByte(255)))
            frameCount = 4
        Else
            frame(1) = CByte(127)
            Dim len = CByte(rawData.Length)
            frame(2) = CByte(((len >> 56) & CByte(255)))
            frame(3) = CByte(((len >> 48) & CByte(255)))
            frame(4) = CByte(((len >> 40) & CByte(255)))
            frame(5) = CByte(((len >> 32) & CByte(255)))
            frame(6) = CByte(((len >> 24) & CByte(255)))
            frame(7) = CByte(((len >> 16) & CByte(255)))
            frame(8) = CByte(((len >> 8) & CByte(255)))
            frame(9) = CByte((len & CByte(255)))
            frameCount = 10
        End If

        Dim bLength = frameCount + rawData.Length
        Console.WriteLine(frameCount)
        Console.WriteLine(rawData.Length)
        Dim reply(bLength + 1) As Byte

        Dim bLim = 0
        For i = 0 To frameCount - 1
            Console.WriteLine(bLim)
            reply(bLim) = frame(i)
            bLim += 1
        Next

        For i = 0 To rawData.Length - 1
            Console.WriteLine(bLim)
            reply(bLim) = rawData(i)
            bLim += 1
        Next

        sck.Send(reply)
    End Sub