edv/SDL
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

20200108

Browse Source
This commit is contained in:
Andreas Luxbauer
2020-01-08 14:52:43 +01:00
parent bea8632eb5
commit f4c1a74870
136 changed files with 11561 additions and 1072 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
VERAG_PROG_ALLGEMEIN/Classes/SQL.vb
View File

@@ -158,7 +158,6 @@ Public Class SQL
Public Shared Function GetNewOpenConnectionATLAS() As SqlConnection
Dim cn As New SqlConnection()
cn.ConnectionString = GetATLASConnectionString()
cn.Open()
Return cn
End Function

3
VERAG_PROG_ALLGEMEIN/Classes/cAdressen.vb
View File

@@ -58,6 +58,9 @@ Public Class cAdressen
End If
End Sub
Public Function FullName() As String
Return (If(Name_1, "") & " " & If(Name_2, "")).ToString.Replace(" ", " ")
End Function
Public Shared Function getHoechsteKdNr(NrKr_von As Integer, NrKr_bis As Integer) As Integer
Try

3
VERAG_PROG_ALLGEMEIN/Classes/cClasses.vb
View File

@@ -26,9 +26,6 @@ Public Class MyListItem
End Function
End Class

132
VERAG_PROG_ALLGEMEIN/Classes/cKundenDatenblatt.vb Normal file
View File

@@ -0,0 +1,132 @@
Imports System.Data.SqlClient
Imports System.Reflection
Public Class cKundenDatenblatt
Property kdb_KundenNr As Integer
Property kdb_route As Object = Nothing
Property kdb_buergschaftsgeber As Object = Nothing
Property kdb_anzahlLKW As Object = Nothing
Property kdb_anzahlMA As Object = Nothing
Property kdb_bestimmungslandEU As Object = Nothing
Property kdb_grosskunden As Object = Nothing
Property kdb_gueter As Object = Nothing
Property kdb_grenzen As Object = Nothing
Property kdb_verhaltenAvisierung As Object = Nothing
Property kdb_sonstiges As Object = Nothing
Dim SQL As New SQL
Sub New(kdb_KundenNr)
Me.kdb_KundenNr = kdb_KundenNr
LOAD()
End Sub
Public Function getParameterList() As List(Of VERAG_PROG_ALLGEMEIN.SQLVariable)
Dim list As New List(Of VERAG_PROG_ALLGEMEIN.SQLVariable)
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("kdb_KundenNr", kdb_KundenNr))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("kdb_route", kdb_route))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("kdb_buergschaftsgeber", kdb_buergschaftsgeber))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("kdb_anzahlLKW", kdb_anzahlLKW))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("kdb_anzahlMA", kdb_anzahlMA))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("kdb_bestimmungslandEU", kdb_bestimmungslandEU))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("kdb_grosskunden", kdb_grosskunden))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("kdb_gueter", kdb_gueter))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("kdb_grenzen", kdb_grenzen))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("kdb_verhaltenAvisierung", kdb_verhaltenAvisierung))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("kdb_sonstiges", kdb_sonstiges))
Return list
End Function
Public Function SAVE() As Boolean
Dim list As List(Of VERAG_PROG_ALLGEMEIN.SQLVariable) = getParameterList()
Dim sqlstr = " BEGIN TRAN IF EXISTS(SELECT * FROM tblKundenDatenblatt WHERE kdb_KundenNr=@kdb_KundenNr) " &
" BEGIN " & getUpdateCmd() & " END " &
" Else " &
" BEGIN " & getInsertCmd() & " END " &
" commit tran "
kdb_KundenNr = SQL.doSQLVarListID(kdb_KundenNr, sqlstr, "FMZOLL", , list)
Return kdb_KundenNr > 0
End Function
Public Sub LOAD()
Try
Using conn As SqlConnection = SQL.GetNewOpenConnectionFMZOLL()
Using cmd As New SqlCommand("SELECT * FROM tblKundenDatenblatt WHERE kdb_KundenNr=@kdb_KundenNr ", conn)
cmd.Parameters.AddWithValue("@kdb_KundenNr", kdb_KundenNr)
Dim dr = cmd.ExecuteReader()
If dr.Read Then
For Each l In getParameterList()
Dim propInfo As PropertyInfo = Me.GetType.GetProperty(l.Scalarvariable)
If dr.Item(l.Text) Is DBNull.Value Then
propInfo.SetValue(Me, Nothing)
Else
propInfo.SetValue(Me, dr.Item(l.Text))
End If
Next
End If
dr.Close()
End Using
End Using
Catch ex As Exception
MsgBox("Fehler in der Funktion '" & System.Reflection.MethodInfo.GetCurrentMethod.Name & "'" & vbNewLine & vbNewLine & ex.Message & vbNewLine & vbNewLine & ex.StackTrace)
End Try
End Sub
Public Function getUpdateCmd() As String
Try
Dim list As List(Of VERAG_PROG_ALLGEMEIN.SQLVariable) = getParameterList()
Dim str As String = ""
For Each i In list
If Not i.isPrimaryParam Then
str &= "[" & i.Text & "] = @" & i.Scalarvariable & "," '.Replace("-", "").Replace(" ", "") & ","
End If
Next
str = str.Substring(0, str.Length - 1) 'wg. ','
Return (" UPDATE [tblKundenDatenblatt] SET " & str & " WHERE kdb_KundenNr=@kdb_KundenNr ")
Catch ex As Exception
MsgBox("Fehler in der Funktion '" & System.Reflection.MethodInfo.GetCurrentMethod.Name & "'" & vbNewLine & vbNewLine & ex.Message & vbNewLine & vbNewLine & ex.StackTrace)
End Try
Return ""
End Function
Public Function getInsertCmd() As String
Try
Dim list As List(Of VERAG_PROG_ALLGEMEIN.SQLVariable) = getParameterList()
Dim str As String = ""
Dim values As String = ""
For Each i In list
If Not i.isPrimaryParam Then
str &= "[" & i.Text & "],"
values &= "@" & i.Scalarvariable & "," '.Replace("-", "").Replace(" ", "") & ","
End If
Next
str = str.Substring(0, str.Length - 1) 'wg. ','
values = values.Substring(0, values.Length - 1) 'wg. ','
Return (" INSERT INTO tblKundenDatenblatt (" & str & ") VALUES(" & values & ") ")
Catch ex As Exception
MsgBox("Fehler in der Funktion '" & System.Reflection.MethodInfo.GetCurrentMethod.Name & "'" & vbNewLine & vbNewLine & ex.Message & vbNewLine & vbNewLine & ex.StackTrace)
End Try
Return ""
End Function
Public Function DELETE() As Boolean 'obj As Object, tablename As String, where As String) As Boolean
Dim sqlstr = " DELETE FROM [tblKundenDatenblatt] WHERE kdb_KundenNr=" & Me.kdb_KundenNr
Return SQL.doSQL(sqlstr, "FMZOLL")
End Function
End Class

16
VERAG_PROG_ALLGEMEIN/Classes/cKundenKontakte.vb
View File

@@ -34,7 +34,7 @@ Public Class cKundenKontakteList
Public Sub LOAD_LIST(kkd_KundenNr, Optional firma = "")
Try
LIST.Clear()
Using conn As SqlConnection = SQL.GetNewOpenConnectionFMZOLL
Using conn As SqlConnection = SQL.GetNewOpenConnectionFMZOLL(False)
Using cmd As New SqlCommand("SELECT * FROM [tblKundenKontakt] WHERE kkd_KundenNr=@kkd_KundenNr " & If(firma <> "", " AND kkd_firma=@firma", ""), conn)
cmd.Parameters.AddWithValue("@kkd_KundenNr", kkd_KundenNr)
cmd.Parameters.AddWithValue("@firma", firma)
@@ -248,15 +248,23 @@ Public Class cKundenKontakte
If KMail = "" Then Return -1
If Not KMail.Contains("@") Then Return -1
Dim whereFiliale = ""
If VERAG_PROG_ALLGEMEIN.cAllgemein.FIRMA <> "VERAG" And VERAG_PROG_ALLGEMEIN.cAllgemein.FIRMA <> "ATILLA" Then
whereFiliale = " AND [FilialenNr]='" & VERAG_PROG_ALLGEMEIN.cAllgemein.STAMMFILIALE & "' "
Else
'SQLstr &= " AND isnull([FilialenNr],0)<>'5501' "
whereFiliale = " AND isnull([FilialenNr],0) NOT IN ('5501','5601','5701','5801') "
End If
Dim SQL As New SQL
getKdNrFromMailAdress = SQL.getValueTxtBySql("SELECT TOP 1 [kkd_KundenNr] FROM [tblKundenKontakt] where kkd_Email LIKE ('%" & KMail & "%') AND kkd_kkaBez='OUTLOOK_AVISO_Eingang'", "FMZOLL",,, -1)
getKdNrFromMailAdress = SQL.getValueTxtBySql("SELECT TOP 1 [kkd_KundenNr] FROM [tblKundenKontakt] INNER JOIN Kunden ON KundenNr=kkd_KundenNr where kkd_Email LIKE ('%" & KMail & "%') AND kkd_kkaBez='OUTLOOK_AVISO_Eingang' " & whereFiliale, "FMZOLL",,, -1)
If serchInKd AndAlso getKdNrFromMailAdress < 0 Then
getKdNrFromMailAdress = SQL.getValueTxtBySql("SELECT TOP 1 AdressenNr FROM Adressen WHERE [E-Mail] LIKE ('%" & KMail & "%') ", "FMZOLL",,, -1)
getKdNrFromMailAdress = SQL.getValueTxtBySql("SELECT TOP 1 AdressenNr FROM Adressen INNER JOIN Kunden ON KundenNr=AdressenNr WHERE [E-Mail] LIKE ('%" & KMail & "%') " & whereFiliale, "FMZOLL",,, -1)
If getKdNrFromMailAdress < 0 Then
Dim sp = KMail.Split("@")
getKdNrFromMailAdress = SQL.getValueTxtBySql("SELECT TOP 1 AdressenNr FROM Adressen WHERE [E-Mail] LIKE ('%" & sp(1) & "%') ", "FMZOLL",,, -1)
getKdNrFromMailAdress = SQL.getValueTxtBySql("SELECT TOP 1 AdressenNr FROM Adressen INNER JOIN Kunden ON KundenNr=AdressenNr WHERE [E-Mail] LIKE ('%" & sp(1) & "%') " & whereFiliale, "FMZOLL",,, -1)
End If
End If
End Function

463
VERAG_PROG_ALLGEMEIN/Classes/cMessangerListender.vb Normal file
View File

@@ -0,0 +1,463 @@

Imports System.Net, System.Net.Sockets
Imports System.Text
Imports System.Threading
Imports VERAG_PROG_ALLGEMEIN
Public Class cMessangerListender
Dim serverSocket As Socket = Nothing
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
Public Sub START()
DIENST_InitSocket() 'initialisieren
End Sub
Sub DIENST_InitSocket()
If serverSocket IsNot Nothing Then Exit Sub 'Falls es schon läuft
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("MESSSSS:::::::::::: " & msg)
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 "NEW_MESSAGE" 'der Task initAufschubkonten wird aufgerufen
' MsgBox("NEW_MESSAGE!!!!!")
' 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 NEW_MESSAGE)
thread.IsBackground = True
'thread.Start(client)
thread.Start()
'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)
'Send("Task successful", client) 'Client-Mittelung
Return ""
End Select
Return "Task not found"
' Me.writeToFrmLog(client, "", "ERROR: Undefinierter Task: " & msg)
End Function
Sub NEW_MESSAGE()
VERAG_PROG_ALLGEMEIN.cMessenger.NEW_MESSGE = True
MsgBox("jojo")
'For Each openForm In Application.OpenForms()
' If TypeOf (openForm) Is frmMessenger Then
' 'MsgBox("Sendungsfenster bereits geöffnet!")
' 'CType(openForm, frmSendungsdetailsNEU).BringToFront()
' 'Return Nothing
' CType(openForm, frmMessenger).REFRESH_CHAT()
' CType(openForm, frmMessenger).btnTEST.Visible = True
' Exit For
' End If
'Next
End Sub
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
''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 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
Public Sub STOP_MSG_LISTENDER()
clientSocket.Shutdown(SocketShutdown.Both)
clientSocket.Close()
serverSocket.Shutdown(SocketShutdown.Both)
serverSocket.Close()
serverSocket = Nothing
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
End Class
Public Class cServerClient
Dim clientSocket As Socket
Dim byteData(1023) As Byte
Dim doThis As String
Public status As String = "begin"
' Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
' begin()
' End Sub
Public Event FunctionFinished(ByVal sender As Object, ByVal e As FunctionFinishedArgs)
Public Sub begin(ip, doThis_tmp)
doThis = doThis_tmp
Dim timeOut As Integer = 60
Select Case doThis
Case "test" : timeOut = 5 ' nach 5 Sekunden wird abgebrochen
Case "NEW_MESSAGE" : timeOut = 120 ' nach 120 Sekunden wird abgebrochen
'Case "initAufschubkonten" : timeOut = 60 ' nach 60 Sekunden wird abgebrochen
End Select
'Ein 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(1) As Object
'Übergabeparameter des 2. Threads
param_obj(0) = timeOut
st.Start(param_obj)
clientSocket = New Socket(AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.Tcp)
Dim ipAddress As IPAddress = IPAddress.Parse(ip)
' Dim ipAddress As IPAddress = ipAddress.Parse("192.168.0.90")
Dim ipEndPoint As IPEndPoint = New IPEndPoint(ipAddress, 8800)
clientSocket.BeginConnect(ipEndPoint, New AsyncCallback(AddressOf OnConnect), Nothing)
status = "beginConnect"
' endconnect(clientSocket)
End Sub
Public Sub waitTillFinished()
While Not (status = "TaskError" Or status = "TaskSuccess")
'wait
End While
'Return True
End Sub
Private Sub OnConnect(ByVal ar As IAsyncResult)
Try
clientSocket.EndConnect(ar)
clientSocket.BeginReceive(byteData, 0, byteData.Length, SocketFlags.None,
New AsyncCallback(AddressOf OnRecieve), clientSocket)
Catch ex As Exception
' MsgBox("Verbindung zum Server konnte nicht aufgebaut werden!")
End Try
End Sub
Private Sub OnSend(ByVal ar As IAsyncResult)
Dim client As Socket = ar.AsyncState
client.EndSend(ar)
End Sub
Private Sub Send(ByVal msg As String, ByVal client As Socket)
Dim sendBytes As Byte() = Encoding.BigEndianUnicode.GetBytes(msg)
client.BeginSend(sendBytes, 0, sendBytes.Length, SocketFlags.None, New AsyncCallback(AddressOf OnSend), client)
End Sub
Public Function ByteArrayToTextString(ByRef Barr() As Byte) As String
Dim enc As System.Text.Encoding = Encoding.BigEndianUnicode
Return enc.GetString(Barr)
End Function
Private Sub OnRecieve(ByVal ar As IAsyncResult)
Try
Dim client As Socket = ar.AsyncState
client.EndReceive(ar)
Dim bytesRec As Byte() = byteData
Dim message As String = Encoding.BigEndianUnicode.GetString(bytesRec)
' MsgBox("FROM SERVER: " & message)
Dim b(1023) As Byte
' MsgBox("SERVER RECIEVE: " & Encoding.BigEndianUnicode.GetString(b))
byteData = b
Read(message)
clientSocket.BeginReceive(byteData, 0, byteData.Length, SocketFlags.None,
New AsyncCallback(AddressOf OnRecieve), clientSocket)
Catch ex As Exception
' MsgBox("Verbindung zum Server wurde unterbrochen!")
End Try
End Sub
Delegate Sub _Read(ByVal msg As String)
Private Sub Read(ByVal msg As String)
'If frmMain.InvokeRequired Then
' frmMain.Invoke(New _Read(AddressOf Read), msg)
' Exit Sub
'End If
'frmMain.icoVERAGMonitoring.Visible = False
'if richtige nsachricht
' Dim asciis As Byte() = Encoding.BigEndianUnicode.GetBytes(msg)
' Dim a As Char = msg(msg.Length - 1)
' msg = msg.Replace(a, "")
' MsgBox(msg.Length)
' MsgBox(msg(msg.Length - 1))
' MsgBox(msg(msg.Length - 1))
' MsgBox(Asc(msg(msg.Length - 1)))
' MsgBox(Asc(msg(msg.Length - 2)))
msg = msg.Replace(Convert.ToChar(0), "")
Try
' MsgBox("-" & msg & "-" & vbNewLine & "ConSuccess" & "-")
If msg = "ConSuccess" Then
status = "ConSuccess"
Select Case doThis
Case "test"
Send("test", clientSocket)
status = "sendTask"
Case "NEW_MESSAGE"
Send("NEW_MESSAGE", clientSocket)
status = "sendTask"
End Select
' MsgBox("!!!!!ConSuccess --> initAufschubkonten")
' Send("FSSAtlasStart", clientSocket)
'Send("test", clientSocket)
'Send("initAufschubkonten", clientSocket)
ElseIf msg = "Task successful" Then
status = "TaskSuccess"
clientSocket.Disconnect(False)
clientSocket.Shutdown(SocketShutdown.Both)
clientSocket.Close()
'endconnect(clientSocket)'geht ned
' MsgBox("Task erfolgreich!", vbSystemModal, doThis)
RaiseEvent FunctionFinished(Me, New FunctionFinishedArgs(FunctionFinishedArgs.EventResult.OK, "Task erfolgreich!"))
ElseIf msg = "Task not found" Then
MsgBox("SERVERERROR: Der Dienst wurde nicht gefunden!", vbSystemModal, "NEW_MESSAGE")
status = "TaskError"
RaiseEvent FunctionFinished(Me, New FunctionFinishedArgs(FunctionFinishedArgs.EventResult.ERR, "SERVERERROR: Der Dienst wurde nicht gefunden!"))
ElseIf msg = "Task inactive" Then
MsgBox("SERVERERROR: Der Dienste ist nicht aktiv!", vbSystemModal, "NEW_MESSAGE")
status = "TaskError"
RaiseEvent FunctionFinished(Me, New FunctionFinishedArgs(FunctionFinishedArgs.EventResult.ERR, "SERVERERROR: Der Dienste ist nicht aktiv!"))
ElseIf msg = "Task timeout" Then
MsgBox("SERVERERROR: Der Dienst wurde wegen einer Zeitüberschreitung abgebrochen!", vbSystemModal, "NEW_MESSAGE")
status = "TaskError"
RaiseEvent FunctionFinished(Me, New FunctionFinishedArgs(FunctionFinishedArgs.EventResult.ERR, "SERVERERROR: Der Dienst wurde wegen einer Zeitüberschreitung abgebrochen!"))
ElseIf msg = "Task error" Then
MsgBox("SERVERERROR: Server-Fehler!", vbSystemModal, "NEW_MESSAGE")
status = "TaskError"
RaiseEvent FunctionFinished(Me, New FunctionFinishedArgs(FunctionFinishedArgs.EventResult.ERR, "SERVERERROR: Server-Fehler!"))
Else
MsgBox("SERVER_NACHRICHT NICHT VERSTANDEN: " & msg, vbSystemModal)
status = "TaskError"
RaiseEvent FunctionFinished(Me, New FunctionFinishedArgs(FunctionFinishedArgs.EventResult.ERR, "SERVER_NACHRICHT NICHT VERSTANDEN: " & msg))
clientSocket.Shutdown(SocketShutdown.Both)
clientSocket.Close()
End If
Catch ex As Exception
MsgBox("Verbindungs-Fehler beim Senden", vbSystemModal)
status = "TaskError"
RaiseEvent FunctionFinished(Me, New FunctionFinishedArgs(FunctionFinishedArgs.EventResult.ERR, "Verbindungs-Fehler beim Senden"))
clientSocket.Close()
End Try
' byteData = Encoding.BigEndianUnicode.GetBytes("")
End Sub
Sub stopThread(param_obj As Object) 'Stoppt einen Hauptthread nach einer gewissen Anzahl von Sekunden; Übergabeparameter: Object { Tread, clientSocket, SekundenToTimeout }
Thread.Sleep(param_obj(0) * 1000) ' Hier wird soviele Senkunden gewartet, wie in den Übergabeparametern definiert wurde.
If status = "TaskError" Or status = "TaskSuccess" Then Exit Sub
status = "TaskError"
Try
clientSocket.Disconnect(False)
clientSocket.Shutdown(SocketShutdown.Both)
clientSocket.Close()
Catch ex As Exception
MsgBox(ex.Message)
End Try
RaiseEvent FunctionFinished(Me, New FunctionFinishedArgs(FunctionFinishedArgs.EventResult.ERR, "Task wurde aufgrund eines Timeouts vom Client abgebrochen."))
MsgBox("ERROR: Task wurde aufgrund eines Timeouts vom Client abgebrochen.") 'Log-Mittelung
End Sub
End Class
Public Class FunctionFinishedArgs
Inherits EventArgs
'das was man später unter e sehen kann
Public Result As EventResult
'hier - als Beispiel - einfach eine Enum
Public Enum EventResult
OK
ERR
End Enum
Public Message As String
'Zum übergeben der Parameter
Public Sub New(ByVal r As EventResult, m As String)
Result = r
Message = m
End Sub
End Class

759
VERAG_PROG_ALLGEMEIN/Classes/cMessenger.vb Normal file
View File

@@ -0,0 +1,759 @@
Imports System.Data.SqlClient
Imports System.Reflection
Public Class cMessenger
Public Shared NEW_MESSGE As Boolean = False
Public Shared UNREAD_MESAGES As Integer = 0
Shared SQL As New SQL
Public Shared Function GEN_NEW_CHAT(chat_name As String, MaIds As List(Of Integer), Optional ByRef CHAT As VERAG_PROG_ALLGEMEIN.cMessenger.cMessenger_Chat = Nothing) As Boolean
CHAT = New VERAG_PROG_ALLGEMEIN.cMessenger.cMessenger_Chat
CHAT.chat_erstelltAm = Now
CHAT.chat_erstelltMaId = VERAG_PROG_ALLGEMEIN.cAllgemein.USRID
CHAT.chat_name = chat_name
For Each maId In MaIds
Dim MB As New VERAG_PROG_ALLGEMEIN.cMessenger.cMessenger_ChatMembers(CHAT.chat_id, maId)
MB.chatMb_maId = maId
CHAT.CHAT_MEMBERS.Add(MB)
Next
Return CHAT.SAVE(True)
End Function
Public Shared Function GET_CHAT_LIST() As List(Of cMessenger_Chat)
Dim LIST As New List(Of cMessenger_Chat)
Dim dt = SQL.loadDgvBySql("SELECT [chat_id] FROM [tblMessenger_Chat] WHERE (SELECT COUNT(*) FROM tblMessenger_ChatMembers WHERE chatMB_chatId=chat_id AND chatMB_maId=" & VERAG_PROG_ALLGEMEIN.cAllgemein.USRID & ")>0", "ADMIN")
For Each r In dt.Rows
Dim CHAT As New VERAG_PROG_ALLGEMEIN.cMessenger.cMessenger_Chat(r("chat_id"))
LIST.Add(CHAT)
Next
Return LIST
End Function
Public Class cMessenger_Chat
Property chat_id As Integer = -1
Property chat_name As String
Property chat_erstelltAm As Date = Now
Property chat_erstelltMaId As Integer
Property chat_aktiv As Boolean = True
Public CHAT_MEMBERS As New List(Of cMessenger_ChatMembers)
Public CHAT_MESSAGES As New List(Of cMessenger_ChatMessages)
Dim SQL As New SQL
Sub New()
Me.chat_erstelltMaId = VERAG_PROG_ALLGEMEIN.cAllgemein.USRID
Me.chat_erstelltAm = Now
LOAD()
End Sub
Sub New(chat_id)
Me.chat_id = chat_id
Me.chat_erstelltMaId = VERAG_PROG_ALLGEMEIN.cAllgemein.USRID
Me.chat_erstelltAm = Now
LOAD()
End Sub
Public Function getParameterList() As List(Of VERAG_PROG_ALLGEMEIN.SQLVariable)
Dim list As New List(Of VERAG_PROG_ALLGEMEIN.SQLVariable)
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("chat_id", chat_id,, True))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("chat_name", chat_name))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("chat_erstelltAm", chat_erstelltAm))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("chat_erstelltMaId", chat_erstelltMaId))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("chat_aktiv", chat_aktiv))
Return list
End Function
Public Function SAVE(saveAll As Boolean) As Boolean
Dim list As List(Of VERAG_PROG_ALLGEMEIN.SQLVariable) = getParameterList()
Dim sqlstr = " BEGIN TRAN IF EXISTS(SELECT * FROM tblMessenger_Chat WHERE chat_id=@chat_id) " &
" BEGIN " & getUpdateCmd() & " End " &
" Else " &
" BEGIN " & getInsertCmd() & " End " &
" commit tran "
chat_id = SQL.doSQLVarListID(chat_id, sqlstr, "ADMIN", , list)
If saveAll Then
SAVE_MEMBERS()
End If
Return chat_id > 0
End Function
Public Sub LOAD()
Try
Using conn As SqlConnection = SQL.GetNewOpenConnectionADMIN()
Using cmd As New SqlCommand("Select * FROM tblMessenger_Chat WHERE chat_id=@chat_id ", conn)
cmd.Parameters.AddWithValue("@chat_id", chat_id)
Dim dr = cmd.ExecuteReader()
If dr.Read Then
For Each l In getParameterList()
Dim propInfo As PropertyInfo = Me.GetType.GetProperty(l.Scalarvariable)
If dr.Item(l.Text) Is DBNull.Value Then
propInfo.SetValue(Me, Nothing)
Else
propInfo.SetValue(Me, dr.Item(l.Text))
End If
Next
Me.LOAD_MEMBERS()
Me.LOAD_MESSAGES()
End If
dr.Close()
End Using
End Using
Catch ex As Exception
MsgBox("Fehler in der Funktion '" & System.Reflection.MethodInfo.GetCurrentMethod.Name & "'" & vbNewLine & vbNewLine & ex.Message & vbNewLine & vbNewLine & ex.StackTrace)
End Try
End Sub
Public Sub SAVE_MEMBERS()
Try
DELETE_MEMBERS()
For Each MB In Me.CHAT_MEMBERS
MB.chatMb_chatId = Me.chat_id
MB.SAVE()
Next
Catch ex As Exception
MsgBox("Fehler in der Funktion '" & System.Reflection.MethodInfo.GetCurrentMethod.Name & "'" & vbNewLine & vbNewLine & ex.Message & vbNewLine & vbNewLine & ex.StackTrace)
End Try
End Sub
Public Function DELETE_MEMBERS() As Boolean 'obj As Object, tablename As String, where As String) As Boolean
Dim sqlstr = " DELETE FROM [tblMessenger_ChatMembers] WHERE chatMb_chatId=" & Me.chat_id
Return SQL.doSQL(sqlstr, "ADMIN")
End Function
Public Sub LOAD_MEMBERS()
Try
Me.CHAT_MEMBERS.Clear()
Using conn As SqlConnection = SQL.GetNewOpenConnectionADMIN()
Using cmd As New SqlCommand("SELECT * FROM tblMessenger_ChatMembers WHERE chatMb_chatId=@chat_id ", conn)
cmd.Parameters.AddWithValue("@chat_id", chat_id)
Dim dr = cmd.ExecuteReader()
While dr.Read
Dim MB As New cMessenger_ChatMembers(Me.chat_id, dr.Item("chatMb_maId"))
Me.CHAT_MEMBERS.Add(MB)
End While
dr.Close()
End Using
End Using
Catch ex As Exception
MsgBox("Fehler in der Funktion '" & System.Reflection.MethodInfo.GetCurrentMethod.Name & "'" & vbNewLine & vbNewLine & ex.Message & vbNewLine & vbNewLine & ex.StackTrace)
End Try
End Sub
Public Sub LOAD_MESSAGES(Optional top As Integer = 100)
Try
Me.CHAT_MESSAGES.Clear()
Using conn As SqlConnection = SQL.GetNewOpenConnectionADMIN()
Using cmd As New SqlCommand("SELECT TOP " & top & " * FROM [tblMessenger_ChatMessages] WHERE chatMg_chatId=@chat_id order by chatMg_datetime", conn)
cmd.Parameters.AddWithValue("@chat_id", chat_id)
Dim dr = cmd.ExecuteReader()
While dr.Read
Dim MSG As New cMessenger_ChatMessages(dr.Item("chatMg_id")) 'Me.chat_id, dr.Item("chatMb_maId")) 'yxc
Me.CHAT_MESSAGES.Add(MSG)
End While
dr.Close()
End Using
End Using
Catch ex As Exception
MsgBox("Fehler in der Funktion '" & System.Reflection.MethodInfo.GetCurrentMethod.Name & "'" & vbNewLine & vbNewLine & ex.Message & vbNewLine & vbNewLine & ex.StackTrace)
End Try
End Sub
Public Function getUpdateCmd() As String
Try
Dim list As List(Of VERAG_PROG_ALLGEMEIN.SQLVariable) = getParameterList()
Dim str As String = ""
For Each i In list
If Not i.isPrimaryParam Then
str &= "[" & i.Text & "] = @" & i.Scalarvariable & "," '.Replace("-", "").Replace(" ", "") & ","
End If
Next
str = str.Substring(0, str.Length - 1) 'wg. ','
Return (" UPDATE [tblMessenger_Chat] SET " & str & " WHERE chat_id=@chat_id ")
Catch ex As Exception
MsgBox("Fehler in der Funktion '" & System.Reflection.MethodInfo.GetCurrentMethod.Name & "'" & vbNewLine & vbNewLine & ex.Message & vbNewLine & vbNewLine & ex.StackTrace)
End Try
Return ""
End Function
Public Function getInsertCmd() As String
Try
Dim list As List(Of VERAG_PROG_ALLGEMEIN.SQLVariable) = getParameterList()
Dim str As String = ""
Dim values As String = ""
For Each i In list
If Not i.isPrimaryParam Then
str &= "[" & i.Text & "],"
values &= "@" & i.Scalarvariable & "," '.Replace("-", "").Replace(" ", "") & ","
End If
Next
str = str.Substring(0, str.Length - 1) 'wg. ','
values = values.Substring(0, values.Length - 1) 'wg. ','
Return (" INSERT INTO tblMessenger_Chat (" & str & ") VALUES(" & values & ") ")
Catch ex As Exception
MsgBox("Fehler in der Funktion '" & System.Reflection.MethodInfo.GetCurrentMethod.Name & "'" & vbNewLine & vbNewLine & ex.Message & vbNewLine & vbNewLine & ex.StackTrace)
End Try
Return ""
End Function
Public Function DELETE() As Boolean 'obj As Object, tablename As String, where As String) As Boolean
Dim sqlstr = " DELETE FROM [tblMessenger_Chat] WHERE chat_id=" & Me.chat_id
Return SQL.doSQL(sqlstr, "ADMIN")
End Function
End Class
Public Class cMessenger_ChatMembers
Property chatMb_chatId As Integer = -1
Property chatMb_maId As Integer = -1
Property chatMb_beitritt As Date = Now
Dim SQL As New SQL
Sub New(chatMb_chatId, chatMb_maId)
Me.chatMb_chatId = chatMb_chatId
Me.chatMb_maId = chatMb_maId
Me.chatMb_beitritt = Now
End Sub
Public Function getParameterList() As List(Of VERAG_PROG_ALLGEMEIN.SQLVariable)
Dim list As New List(Of VERAG_PROG_ALLGEMEIN.SQLVariable)
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("chatMb_chatId", chatMb_chatId))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("chatMb_maId", chatMb_maId))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("chatMb_beitritt", chatMb_beitritt))
Return list
End Function
Public Function SAVE() As Boolean
Dim list As List(Of VERAG_PROG_ALLGEMEIN.SQLVariable) = getParameterList()
Dim sqlstr = " BEGIN TRAN IF EXISTS(SELECT * FROM [tblMessenger_ChatMembers] WHERE chatMb_chatId=@chatMb_chatId AND chatMb_maId=@chatMb_maId) " &
" BEGIN " & getUpdateCmd() & " END " &
" Else " &
" BEGIN " & getInsertCmd() & " END " &
" commit tran "
Return SQL.doSQLVarList(sqlstr, "ADMIN", , list)
End Function
Public Sub LOAD()
Try
Using conn As SqlConnection = SQL.GetNewOpenConnectionADMIN()
Using cmd As New SqlCommand("SELECT * FROM [tblMessenger_ChatMembers] WHERE chatMb_chatId=@chatMb_chatId AND chatMb_maId=@chatMb_maId ", conn)
cmd.Parameters.AddWithValue("@chatMb_chatId", chatMb_chatId)
cmd.Parameters.AddWithValue("@chatMb_maId", chatMb_maId)
Dim dr = cmd.ExecuteReader()
If dr.Read Then
For Each l In getParameterList()
Dim propInfo As PropertyInfo = Me.GetType.GetProperty(l.Scalarvariable)
If dr.Item(l.Text) Is DBNull.Value Then
propInfo.SetValue(Me, Nothing)
Else
propInfo.SetValue(Me, dr.Item(l.Text))
End If
Next
End If
dr.Close()
End Using
End Using
Catch ex As Exception
MsgBox("Fehler in der Funktion '" & System.Reflection.MethodInfo.GetCurrentMethod.Name & "'" & vbNewLine & vbNewLine & ex.Message & vbNewLine & vbNewLine & ex.StackTrace)
End Try
End Sub
Public Function getUpdateCmd() As String
Try
Dim list As List(Of VERAG_PROG_ALLGEMEIN.SQLVariable) = getParameterList()
Dim str As String = ""
For Each i In list
If Not i.isPrimaryParam Then
str &= "[" & i.Text & "] = @" & i.Scalarvariable & "," '.Replace("-", "").Replace(" ", "") & ","
End If
Next
str = str.Substring(0, str.Length - 1) 'wg. ','
Return (" UPDATE [tblMessenger_ChatMembers] SET " & str & " WHERE chatMb_chatId=@chatMb_chatId AND chatMb_maId=@chatMb_maId ")
Catch ex As Exception
MsgBox("Fehler in der Funktion '" & System.Reflection.MethodInfo.GetCurrentMethod.Name & "'" & vbNewLine & vbNewLine & ex.Message & vbNewLine & vbNewLine & ex.StackTrace)
End Try
Return ""
End Function
Public Function getInsertCmd() As String
Try
Dim list As List(Of VERAG_PROG_ALLGEMEIN.SQLVariable) = getParameterList()
Dim str As String = ""
Dim values As String = ""
For Each i In list
If Not i.isPrimaryParam Then
str &= "[" & i.Text & "],"
values &= "@" & i.Scalarvariable & "," '.Replace("-", "").Replace(" ", "") & ","
End If
Next
str = str.Substring(0, str.Length - 1) 'wg. ','
values = values.Substring(0, values.Length - 1) 'wg. ','
Return (" INSERT INTO [tblMessenger_ChatMembers] (" & str & ") VALUES(" & values & ") ")
Catch ex As Exception
MsgBox("Fehler in der Funktion '" & System.Reflection.MethodInfo.GetCurrentMethod.Name & "'" & vbNewLine & vbNewLine & ex.Message & vbNewLine & vbNewLine & ex.StackTrace)
End Try
Return ""
End Function
Public Function DELETE([chatMb_maId]) As Boolean 'obj As Object, tablename As String, where As String) As Boolean
Dim sqlstr = " DELETE FROM [tblMessenger_ChatMembers] WHERE [chatMb_chatId]=" & Me.[chatMb_chatId] & " AND [chatMb_maId] ='" & [chatMb_maId] & "'"
Return SQL.doSQL(sqlstr, "ADMIN")
End Function
End Class
Public Class cMessenger_ChatStatus
Property chatMgSt_chatMsgId As Integer
Property chatMgSt_MaId As Integer
Property chatMgSt_gelesen As Boolean = False
Property chatMgSt_datetime As Date = Now
Dim SQL As New SQL
Sub New(chatMgSt_chatMsgId, chatMgSt_MaId, chatMgSt_gelesen)
Me.chatMgSt_chatMsgId = chatMgSt_chatMsgId
Me.chatMgSt_MaId = chatMgSt_MaId
Me.chatMgSt_gelesen = chatMgSt_gelesen
Me.chatMgSt_datetime = Now
End Sub
Public Function getParameterList() As List(Of VERAG_PROG_ALLGEMEIN.SQLVariable)
Dim list As New List(Of VERAG_PROG_ALLGEMEIN.SQLVariable)
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("chatMgSt_chatMsgId", chatMgSt_chatMsgId))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("chatMgSt_MaId", chatMgSt_MaId))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("chatMgSt_gelesen", chatMgSt_gelesen))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("chatMgSt_datetime", chatMgSt_datetime))
Return list
End Function
Public Function SAVE() As Boolean
Dim list As List(Of VERAG_PROG_ALLGEMEIN.SQLVariable) = getParameterList()
Dim sqlstr = " BEGIN TRAN IF EXISTS(SELECT * FROM tblMessenger_ChatMessages WHERE chatMgSt_chatMsgId=@chatMgSt_chatMsgId AND chatMgSt_MaId=@chatMgSt_MaId) " &
" BEGIN " & getUpdateCmd() & " END " &
" Else " &
" BEGIN " & getInsertCmd() & " END " &
" commit tran "
Return SQL.doSQLVarList(sqlstr, "ADMIN", , list)
End Function
Public Sub LOAD()
Try
Using conn As SqlConnection = SQL.GetNewOpenConnectionADMIN()
Using cmd As New SqlCommand("SELECT * FROM tblMessenger_ChatMessages WHERE chatMgSt_chatMsgId=@chatMgSt_chatMsgId AND chatMgSt_MaId=@chatMgSt_MaId ", conn)
cmd.Parameters.AddWithValue("@chatMgSt_chatMsgId", chatMgSt_chatMsgId)
cmd.Parameters.AddWithValue("@chatMgSt_MaId", chatMgSt_MaId)
Dim dr = cmd.ExecuteReader()
If dr.Read Then
For Each l In getParameterList()
Dim propInfo As PropertyInfo = Me.GetType.GetProperty(l.Scalarvariable)
If dr.Item(l.Text) Is DBNull.Value Then
propInfo.SetValue(Me, Nothing)
Else
propInfo.SetValue(Me, dr.Item(l.Text))
End If
Next
End If
dr.Close()
End Using
End Using
Catch ex As Exception
MsgBox("Fehler in der Funktion '" & System.Reflection.MethodInfo.GetCurrentMethod.Name & "'" & vbNewLine & vbNewLine & ex.Message & vbNewLine & vbNewLine & ex.StackTrace)
End Try
End Sub
Public Function getUpdateCmd() As String
Try
Dim list As List(Of VERAG_PROG_ALLGEMEIN.SQLVariable) = getParameterList()
Dim str As String = ""
For Each i In list
If Not i.isPrimaryParam Then
str &= "[" & i.Text & "] = @" & i.Scalarvariable & "," '.Replace("-", "").Replace(" ", "") & ","
End If
Next
str = str.Substring(0, str.Length - 1) 'wg. ','
Return (" UPDATE tblMessenger_ChatMessages SET " & str & " WHERE chatMgSt_chatMsgId=@chatMgSt_chatMsgId AND chatMgSt_MaId=@chatMgSt_MaId ")
Catch ex As Exception
MsgBox("Fehler in der Funktion '" & System.Reflection.MethodInfo.GetCurrentMethod.Name & "'" & vbNewLine & vbNewLine & ex.Message & vbNewLine & vbNewLine & ex.StackTrace)
End Try
Return ""
End Function
Public Function getInsertCmd() As String
Try
Dim list As List(Of VERAG_PROG_ALLGEMEIN.SQLVariable) = getParameterList()
Dim str As String = ""
Dim values As String = ""
For Each i In list
If Not i.isPrimaryParam Then
str &= "[" & i.Text & "],"
values &= "@" & i.Scalarvariable & "," '.Replace("-", "").Replace(" ", "") & ","
End If
Next
str = str.Substring(0, str.Length - 1) 'wg. ','
values = values.Substring(0, values.Length - 1) 'wg. ','
Return (" INSERT INTO tblMessenger_ChatMessages (" & str & ") VALUES(" & values & ") ")
Catch ex As Exception
MsgBox("Fehler in der Funktion '" & System.Reflection.MethodInfo.GetCurrentMethod.Name & "'" & vbNewLine & vbNewLine & ex.Message & vbNewLine & vbNewLine & ex.StackTrace)
End Try
Return ""
End Function
Public Function DELETE([chatMgSt_MaId]) As Boolean 'obj As Object, tablename As String, where As String) As Boolean
Dim sqlstr = " DELETE FROM tblMessenger_ChatMessages WHERE [chatMgSt_chatMsgId]=" & Me.chatMgSt_chatMsgId & " AND [chatMgSt_MaId] ='" & chatMgSt_MaId & "'"
Return SQL.doSQL(sqlstr, "ADMIN")
End Function
End Class
Public Class cMessenger_ChatMessages
Property chatMg_id As Integer ' INT Not NULL PRIMARY KEY IDENTITY,
Property chatMg_chatId As Integer ' INT Not NULL,
Property chatMg_maId As Integer ' INT Not NULL,
Property chatMg_datetime As Date = Now
Property chatMg_maName As String = VERAG_PROG_ALLGEMEIN.cAllgemein.MITARBEITER.Fullname
Property chatMg_maFirma As String = VERAG_PROG_ALLGEMEIN.cAllgemein.FIRMA
Property chatMg_type As String = "TEXT"
Property chatMg_text As String = ""
Property chatMg_anhang_docId As Integer ' int NULL,
Property chatMg_referenz_AvisoId As Integer ' int NULL,
Property chatMg_referenz_SendungsId As Integer ' int NULL,
Property chatMg_referenz_KundenNr As Integer ' int NULL
Public CHAT_MESSAGES_STATUS_LIST As New List(Of cMessenger_ChatMessageStatus)
Dim SQL As New SQL
Sub New(chatMg_id)
Me.chatMg_id = chatMg_id
LOAD()
End Sub
Sub New(chatMg_chatId, chatMg_maId)
Me.chatMg_chatId = chatMg_chatId
Me.chatMg_maId = chatMg_maId
End Sub
Public Function getParameterList() As List(Of VERAG_PROG_ALLGEMEIN.SQLVariable)
Dim list As New List(Of VERAG_PROG_ALLGEMEIN.SQLVariable)
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("chatMg_id", chatMg_id,, True))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("chatMg_maId", chatMg_maId))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("chatMg_chatId", chatMg_chatId))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("chatMg_datetime", chatMg_datetime))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("chatMg_type", chatMg_type))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("chatMg_text", chatMg_text))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("chatMg_anhang_docId", chatMg_anhang_docId))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("chatMg_referenz_AvisoId", chatMg_referenz_AvisoId))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("chatMg_referenz_SendungsId", chatMg_referenz_SendungsId))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("chatMg_referenz_KundenNr", chatMg_referenz_KundenNr))
Return list
End Function
Public Function SAVE() As Boolean
Dim list As List(Of VERAG_PROG_ALLGEMEIN.SQLVariable) = getParameterList()
Dim sqlstr = " BEGIN TRAN IF EXISTS(SELECT * FROM tblMessenger_ChatMessages WHERE chatMg_id=@chatMg_id) " &
" BEGIN " & getUpdateCmd() & " END " &
" Else " &
" BEGIN " & getInsertCmd() & " END " &
" commit tran "
Return SQL.doSQLVarList(sqlstr, "ADMIN", , list)
End Function
Public Sub LOAD()
Try
Using conn As SqlConnection = SQL.GetNewOpenConnectionADMIN()
Using cmd As New SqlCommand("SELECT * FROM tblMessenger_ChatMessages WHERE chatMg_id=@chatMg_id ", conn)
cmd.Parameters.AddWithValue("@chatMg_id", chatMg_id)
Dim dr = cmd.ExecuteReader()
If dr.Read Then
For Each l In getParameterList()
Dim propInfo As PropertyInfo = Me.GetType.GetProperty(l.Scalarvariable)
If dr.Item(l.Text) Is DBNull.Value Then
propInfo.SetValue(Me, Nothing)
Else
propInfo.SetValue(Me, dr.Item(l.Text))
End If
Next
End If
dr.Close()
End Using
End Using
Catch ex As Exception
MsgBox("Fehler in der Funktion '" & System.Reflection.MethodInfo.GetCurrentMethod.Name & "'" & vbNewLine & vbNewLine & ex.Message & vbNewLine & vbNewLine & ex.StackTrace)
End Try
End Sub
Public Function getUpdateCmd() As String
Try
Dim list As List(Of VERAG_PROG_ALLGEMEIN.SQLVariable) = getParameterList()
Dim str As String = ""
For Each i In list
If Not i.isPrimaryParam Then
str &= "[" & i.Text & "] = @" & i.Scalarvariable & "," '.Replace("-", "").Replace(" ", "") & ","
End If
Next
str = str.Substring(0, str.Length - 1) 'wg. ','
Return (" UPDATE tblMessenger_ChatMessages SET " & str & " WHERE chatMg_id=@chatMg_id ")
Catch ex As Exception
MsgBox("Fehler in der Funktion '" & System.Reflection.MethodInfo.GetCurrentMethod.Name & "'" & vbNewLine & vbNewLine & ex.Message & vbNewLine & vbNewLine & ex.StackTrace)
End Try
Return ""
End Function
Public Function getInsertCmd() As String
Try
Dim list As List(Of VERAG_PROG_ALLGEMEIN.SQLVariable) = getParameterList()
Dim str As String = ""
Dim values As String = ""
For Each i In list
If Not i.isPrimaryParam Then
str &= "[" & i.Text & "],"
values &= "@" & i.Scalarvariable & "," '.Replace("-", "").Replace(" ", "") & ","
End If
Next
str = str.Substring(0, str.Length - 1) 'wg. ','
values = values.Substring(0, values.Length - 1) 'wg. ','
Return (" INSERT INTO tblMessenger_ChatMessages (" & str & ") VALUES(" & values & ") ")
Catch ex As Exception
MsgBox("Fehler in der Funktion '" & System.Reflection.MethodInfo.GetCurrentMethod.Name & "'" & vbNewLine & vbNewLine & ex.Message & vbNewLine & vbNewLine & ex.StackTrace)
End Try
Return ""
End Function
Public Function DELETE([chatMgSt_MaId]) As Boolean 'obj As Object, tablename As String, where As String) As Boolean
Dim sqlstr = " DELETE FROM tblMessenger_ChatMessages WHERE [chatMg_id]=" & Me.chatMg_id & " "
Return SQL.doSQL(sqlstr, "ADMIN")
End Function
'Public Sub SAVE_STATUS()
' Try
' Dim CHAT As New cMessenger_Chat(Me.chatMg_chatId)
' 'DELETE_STATUS()
' For Each MB In CHAT.CHAT_MEMBERS
' Dim STAT As New cMessenger_ChatMessageStatus(Me.chatMg_id, MB.chatMb_maId)
' MB.chatMb_chatId = Me.chat_id
' MB.SAVE()
' Next
' Catch ex As Exception
' MsgBox("Fehler in der Funktion '" & System.Reflection.MethodInfo.GetCurrentMethod.Name & "'" & vbNewLine & vbNewLine & ex.Message & vbNewLine & vbNewLine & ex.StackTrace)
' End Try
'End Sub
'Public Function DELETE_MEMBERS() As Boolean 'obj As Object, tablename As String, where As String) As Boolean
' Dim sqlstr = " DELETE FROM [tblMessenger_ChatMessageStatus] WHERE chatMb_chatId=" & Me.chat_id
' Return SQL.doSQL(sqlstr, "ADMIN")
'End Function
Public Sub LOAD_STATUS()
Try
Me.CHAT_MESSAGES_STATUS_LIST.Clear()
Using conn As SqlConnection = SQL.GetNewOpenConnectionADMIN()
Using cmd As New SqlCommand("SELECT * FROM tblMessenger_ChatMessageStatus WHERE chatMgSt_chatMsgId=@chatMg_id ", conn)
cmd.Parameters.AddWithValue("@chatMg_id", Me.chatMg_id)
Dim dr = cmd.ExecuteReader()
While dr.Read
Dim MB As New cMessenger_ChatMessageStatus(Me.chatMg_id, dr.Item("chatMgSt_MaId"))
Me.CHAT_MESSAGES_STATUS_LIST.Add(MB)
End While
dr.Close()
End Using
End Using
Catch ex As Exception
MsgBox("Fehler in der Funktion '" & System.Reflection.MethodInfo.GetCurrentMethod.Name & "'" & vbNewLine & vbNewLine & ex.Message & vbNewLine & vbNewLine & ex.StackTrace)
End Try
End Sub
End Class
Public Class cMessenger_ChatMessageStatus
Property chatMgSt_chatMsgId As Integer
Property chatMgSt_MaId As Integer
Property chatMgSt_datetime As Date = Now
Property chatMgSt_gelesen As Boolean = False
Dim SQL As New SQL
Sub New(chatMgSt_chatMsgId, chatMgSt_MaId)
Me.chatMgSt_chatMsgId = chatMgSt_chatMsgId
Me.chatMgSt_MaId = chatMgSt_MaId
LOAD()
End Sub
Sub New(chatMgSt_chatMsgId, chatMgSt_MaId, chatMgSt_gelesen)
Me.chatMgSt_chatMsgId = chatMgSt_chatMsgId
Me.chatMgSt_MaId = chatMgSt_MaId
Me.chatMgSt_gelesen = chatMgSt_gelesen
End Sub
Public Function getParameterList() As List(Of VERAG_PROG_ALLGEMEIN.SQLVariable)
Dim list As New List(Of VERAG_PROG_ALLGEMEIN.SQLVariable)
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("chatMgSt_chatMsgId", chatMgSt_chatMsgId))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("chatMgSt_MaId", chatMgSt_MaId))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("chatMgSt_datetime", chatMgSt_datetime))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("chatMgSt_gelesen", chatMgSt_gelesen))
Return list
End Function
Public Function SAVE() As Boolean
Dim list As List(Of VERAG_PROG_ALLGEMEIN.SQLVariable) = getParameterList()
Dim sqlstr = " BEGIN TRAN IF EXISTS(SELECT * FROM tblMessenger_ChatMessageStatus WHERE chatMgSt_chatMsgId=@chatMgSt_chatMsgId AND chatMgSt_MaId=@chatMgSt_MaId) " &
" BEGIN " & getUpdateCmd() & " END " &
" Else " &
" BEGIN " & getInsertCmd() & " END " &
" commit tran "
Return SQL.doSQLVarList(sqlstr, "ADMIN", , list)
End Function
Public Sub LOAD()
Try
Using conn As SqlConnection = SQL.GetNewOpenConnectionADMIN()
Using cmd As New SqlCommand("SELECT * FROM tblMessenger_ChatMessageStatus WHERE chatMgSt_chatMsgId=@chatMgSt_chatMsgId AND chatMgSt_MaId=@chatMgSt_MaId ", conn)
cmd.Parameters.AddWithValue("@chatMgSt_chatMsgId", chatMgSt_chatMsgId)
cmd.Parameters.AddWithValue("@chatMgSt_MaId", chatMgSt_MaId)
Dim dr = cmd.ExecuteReader()
If dr.Read Then
For Each l In getParameterList()
Dim propInfo As PropertyInfo = Me.GetType.GetProperty(l.Scalarvariable)
If dr.Item(l.Text) Is DBNull.Value Then
propInfo.SetValue(Me, Nothing)
Else
propInfo.SetValue(Me, dr.Item(l.Text))
End If
Next
End If
dr.Close()
End Using
End Using
Catch ex As Exception
MsgBox("Fehler in der Funktion '" & System.Reflection.MethodInfo.GetCurrentMethod.Name & "'" & vbNewLine & vbNewLine & ex.Message & vbNewLine & vbNewLine & ex.StackTrace)
End Try
End Sub
Public Function getUpdateCmd() As String
Try
Dim list As List(Of VERAG_PROG_ALLGEMEIN.SQLVariable) = getParameterList()
Dim str As String = ""
For Each i In list
If Not i.isPrimaryParam Then
str &= "[" & i.Text & "] = @" & i.Scalarvariable & "," '.Replace("-", "").Replace(" ", "") & ","
End If
Next
str = str.Substring(0, str.Length - 1) 'wg. ','
Return (" UPDATE tblMessenger_ChatMessageStatus SET " & str & " WHERE chatMgSt_chatMsgId=@chatMgSt_chatMsgId AND chatMgSt_MaId=@chatMgSt_MaId ")
Catch ex As Exception
MsgBox("Fehler in der Funktion '" & System.Reflection.MethodInfo.GetCurrentMethod.Name & "'" & vbNewLine & vbNewLine & ex.Message & vbNewLine & vbNewLine & ex.StackTrace)
End Try
Return ""
End Function
Public Function getInsertCmd() As String
Try
Dim list As List(Of VERAG_PROG_ALLGEMEIN.SQLVariable) = getParameterList()
Dim str As String = ""
Dim values As String = ""
For Each i In list
If Not i.isPrimaryParam Then
str &= "[" & i.Text & "],"
values &= "@" & i.Scalarvariable & "," '.Replace("-", "").Replace(" ", "") & ","
End If
Next
str = str.Substring(0, str.Length - 1) 'wg. ','
values = values.Substring(0, values.Length - 1) 'wg. ','
Return (" INSERT INTO tblMessenger_ChatMessageStatus (" & str & ") VALUES(" & values & ") ")
Catch ex As Exception
MsgBox("Fehler in der Funktion '" & System.Reflection.MethodInfo.GetCurrentMethod.Name & "'" & vbNewLine & vbNewLine & ex.Message & vbNewLine & vbNewLine & ex.StackTrace)
End Try
Return ""
End Function
Public Function DELETE([chatMgSt_MaId]) As Boolean 'obj As Object, tablename As String, where As String) As Boolean
Dim sqlstr = " DELETE FROM tblMessenger_ChatMessageStatus WHERE [chatMgSt_chatMsgId]=" & Me.chatMgSt_chatMsgId & " AND [chatMgSt_MaId]=" & Me.chatMgSt_MaId & " "
Return SQL.doSQL(sqlstr, "ADMIN")
End Function
End Class
End Class

8
VERAG_PROG_ALLGEMEIN/Classes/cMitarbeiter.vb
View File

@@ -36,6 +36,7 @@ Public Class cMitarbeiter
Property mit_FMZollPersIDSpedBuch As Object = Nothing
Property mit_DpUserStandardDP As Object = Nothing
Property mit_DpUserStandardFirma As Object = Nothing
Property mit_DpUserStandardFirma2 As Object = Nothing
Property mit_EZOLL_SB As Object = Nothing
Property mit_ATLAS_SB As Object = Nothing
@@ -63,6 +64,11 @@ Public Class cMitarbeiter
End Sub
' Dim SQL As New SQL
Public Function Fullname() As String
Return (If(mit_vname, "") & " " & If(mit_nname, "")).Trim
End Function
Public Function LOAD(ByVal id As Integer) As Boolean
Dim sqlstr As String = "SELECT * FROM tblMitarbeiter WHERE mit_id = " & id & ""
' adasdas()
@@ -100,6 +106,8 @@ Public Class cMitarbeiter
If Not dr.Item("mit_FMZollPersIDSpedBuch") Is DBNull.Value Then Me.mit_FMZollPersIDSpedBuch = dr.Item("mit_FMZollPersIDSpedBuch")
If Not dr.Item("mit_DpUserStandardDP") Is DBNull.Value Then Me.mit_DpUserStandardDP = dr.Item("mit_DpUserStandardDP")
If Not dr.Item("mit_DpUserStandardFirma") Is DBNull.Value Then Me.mit_DpUserStandardFirma = dr.Item("mit_DpUserStandardFirma")
If Not dr.Item("mit_DpUserStandardFirma2") Is DBNull.Value Then Me.mit_DpUserStandardFirma2 = dr.Item("mit_DpUserStandardFirma2")
If Not dr.Item("mit_standartFiliale") Is DBNull.Value Then Me.mit_standartFiliale = dr.Item("mit_standartFiliale")
If Not dr.Item("mit_standardPreisliste") Is DBNull.Value Then Me.mit_standardPreisliste = dr.Item("mit_standardPreisliste")

6
VERAG_PROG_ALLGEMEIN/Classes/cOfferte.vb
View File

@@ -117,8 +117,8 @@ Public Class cOfferte
cmd.Parameters.AddWithValue("@OffertenNr", OffertenNr)
Dim dr = cmd.ExecuteReader()
If dr.Read Then
Dim l As New cOfferte
For Each i In l.getParameterList()
'Dim l As New cOfferte
For Each i In getParameterList()
Dim propInfo As PropertyInfo = Me.GetType.GetProperty(i.Scalarvariable)
If dr.Item(i.Text) Is DBNull.Value Then
propInfo.SetValue(Me, Nothing)
@@ -126,7 +126,7 @@ Public Class cOfferte
propInfo.SetValue(Me, dr.Item(i.Text))
End If
Next
If loadPos Then l.LOAD_POSITIONEN()
If loadPos Then LOAD_POSITIONEN()
End If
dr.Close()
End Using

6
VERAG_PROG_ALLGEMEIN/Classes/cRechnungsausgang.vb
View File

@@ -100,6 +100,9 @@ Public Class cRechnungsausgang
Property EMailRechnungstext As Object = Nothing
Property AvisoID As Object = Nothing
Property KdAuftragsNr As Object = Nothing
Property Handling As Object = Nothing
' FROM [VERAG as object=nothing.[dbo as object=nothing.[Rechnungsausgang as object=nothing
@@ -226,7 +229,8 @@ Public Class cRechnungsausgang
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("Avisierer", Avisierer))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("EMailRechnungstext", EMailRechnungstext))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("AvisoID", AvisoID))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("KdAuftragsNr", KdAuftragsNr))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("KdAuftragsNr", KdAuftragsNr))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("Handling", Handling))
Return list
End Function

55
VERAG_PROG_ALLGEMEIN/Classes/cSendungen.vb
View File

@@ -73,6 +73,17 @@ Public Class cSendungen
Property LetzterMitarbeiter As Object = Nothing
Property LetzterMitarbeiterId As Object = Nothing
Property tblSnd_VG_MA As Object = Nothing
Property tblSnd_NCTSaufDISPO As Boolean = True
Property tblSnd_AvisiererKdNr As Object = Nothing
Property tblSnd_Avisierer As Object = Nothing
Property tblSnd_FrachtfuehrerKdNr As Object = Nothing
Property tblSnd_Frachtfuehrer As Object = Nothing
Property tblSnd_DakosyRef As Object = Nothing
Property tblSnd_TeamId As Object = Nothing
Public saveSachbearbeiter As Boolean = False
Property ABRECHNUNG As New List(Of cSendungAbrechnung)
Property HANDLING As New List(Of cSendHandling)
@@ -145,10 +156,6 @@ Public Class cSendungen
Public Function SAVE() As Boolean 'obj As Object, tablename As String, where As String) As Boolean
Dim list As List(Of VERAG_PROG_ALLGEMEIN.SQLVariable) = getParameterList()
@@ -225,7 +232,7 @@ Public Class cSendungen
Me.NCTS_ngaId = SQL.checkNullReturnValue(dr.Item("NCTS_ngaId"), Nothing)
Me.NCTS_Bestimmungszollstelle = SQL.checkNullReturnValue(dr.Item("NCTS_Bestimmungszollstelle"), Nothing)
Me.tblSnd_Endempfaenger = SQL.checkNullReturnValue(dr.Item("tblSnd_Endempfaenger"), Nothing)
Me.tblSnd_EndempfaengerKdNr = SQL.checkNullReturnValue(dr.Item("tblSnd_EndempfaengerKdNr"), Nothing)
Me.tblSnd_EUFiskalEmpfaenger = SQL.checkNullReturnValue(dr.Item("tblSnd_EUFiskalEmpfaenger"), Nothing)
@@ -249,8 +256,17 @@ Public Class cSendungen
Me.LetzterMitarbeiter = SQL.checkNullReturnValue(dr.Item("LetzterMitarbeiter"), Nothing)
Me.LetzterMitarbeiterId = SQL.checkNullReturnValue(dr.Item("LetzterMitarbeiterId"), Nothing)
Me.tblSnd_VG_MA = SQL.checkNullReturnValue(dr.Item("tblSnd_VG_MA"), Nothing)
Me.tblSnd_NCTSaufDISPO = SQL.checkNullReturnValue(dr.Item("tblSnd_NCTSaufDISPO"), Nothing)
Me.tblSnd_AvisiererKdNr = SQL.checkNullReturnValue(dr.Item("tblSnd_AvisiererKdNr"), Nothing)
Me.tblSnd_Avisierer = SQL.checkNullReturnValue(dr.Item("tblSnd_Avisierer"), Nothing)
Me.tblSnd_FrachtfuehrerKdNr = SQL.checkNullReturnValue(dr.Item("tblSnd_FrachtfuehrerKdNr"), Nothing)
Me.tblSnd_Frachtfuehrer = SQL.checkNullReturnValue(dr.Item("tblSnd_Frachtfuehrer"), Nothing)
Me.tblSnd_DakosyRef = SQL.checkNullReturnValue(dr.Item("tblSnd_DakosyRef"), Nothing)
Me.tblSnd_TeamId = SQL.checkNullReturnValue(dr.Item("tblSnd_TeamId"), Nothing)
End If
dr.Close()
' End Using
@@ -365,7 +381,6 @@ Public Class cSendungen
' list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("tblSnd_betrag", tblSnd_betrag))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("tblSnd_Fremdspedition", tblSnd_Fremdspedition))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("tblSnd_FremdspeditionText", tblSnd_FremdspeditionText))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("tblSnd_QS_MA", tblSnd_QS_MA))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("tblSnd_KdAuftragsNr", tblSnd_KdAuftragsNr))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("tblSnd_NCTSVerzollungsadresse", tblSnd_NCTSVerzollungsadresse))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("tblSnd_NCTSVerzollungsadresseKdNr", tblSnd_NCTSVerzollungsadresseKdNr))
@@ -394,12 +409,24 @@ Public Class cSendungen
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("tblSnd_ATCMRN_Fremd", tblSnd_ATCMRN_Fremd))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("tblSnd_Warenwert", tblSnd_Warenwert))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("tblSnd_WarenwertWaehrung", tblSnd_WarenwertWaehrung))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("tblSnd_Status", tblSnd_Status))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("tblSnd_Vorbereitet", tblSnd_Vorbereitet))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("tblSnd_Vorgeschrieben", tblSnd_Vorgeschrieben))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("LetzterMitarbeiter", LetzterMitarbeiter))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("LetzterMitarbeiterId", LetzterMitarbeiterId))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("tblSnd_VG_MA", tblSnd_VG_MA))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("tblSnd_QS_MA", tblSnd_QS_MA,,, Not saveSachbearbeiter))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("tblSnd_Status", tblSnd_Status,,, Not saveSachbearbeiter))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("tblSnd_Vorbereitet", tblSnd_Vorbereitet,,, Not saveSachbearbeiter))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("tblSnd_Vorgeschrieben", tblSnd_Vorgeschrieben,,, Not saveSachbearbeiter))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("tblSnd_VG_MA", tblSnd_VG_MA,,, Not saveSachbearbeiter))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("LetzterMitarbeiter", LetzterMitarbeiter,,, Not saveSachbearbeiter))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("LetzterMitarbeiterId", LetzterMitarbeiterId,,, Not saveSachbearbeiter))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("tblSnd_NCTSaufDISPO", tblSnd_NCTSaufDISPO))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("tblSnd_AvisiererKdNr", tblSnd_AvisiererKdNr))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("tblSnd_Avisierer", tblSnd_Avisierer))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("tblSnd_FrachtfuehrerKdNr", tblSnd_FrachtfuehrerKdNr))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("tblSnd_Frachtfuehrer", tblSnd_Frachtfuehrer))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("tblSnd_DakosyRef", tblSnd_DakosyRef))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("tblSnd_TeamId", tblSnd_TeamId))
Return list
@@ -412,7 +439,7 @@ Public Class cSendungen
Dim str As String = ""
For Each i In list
If Not i.isPrimaryParam Then
If Not i.isPrimaryParam And Not i.isonlyForLoad Then
str &= "[" & i.Text & "] = @" & i.Text.Replace("-", "").Replace(" ", "") & ","
End If
Next
@@ -432,7 +459,7 @@ Public Class cSendungen
Dim str As String = ""
Dim values As String = ""
For Each i In list
If Not i.isPrimaryParam Then
If Not i.isPrimaryParam And Not i.isonlyForLoad Then
str &= "[" & i.Text & "],"
values &= "@" & i.Text.Replace("-", "").Replace(" ", "") & ","
End If

19
VERAG_PROG_ALLGEMEIN/Classes/cSession.vb
View File

@@ -14,6 +14,10 @@ Public Class cSession
Property sess_firma As String = ""
Property sess_niederlassung As String = ""
Property sess_ipAddress As String = ""
Property sess_PCName As String = ""
Property sess_PCUserName As String = ""
Property sess_login As Object = Nothing = Now
Property sess_logout As Object = Nothing
@@ -37,6 +41,9 @@ Public Class cSession
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("sess_progVersion", sess_progVersion))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("sess_firma", sess_firma))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("sess_niederlassung", sess_niederlassung))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("sess_ipAddress", sess_ipAddress))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("sess_PCName", sess_PCName))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("sess_PCUserName", sess_PCUserName))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("sess_maName", sess_maName))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("sess_maId", sess_maId))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("sess_login", sess_login))
@@ -108,6 +115,12 @@ Public Class cSession
End Function
Public Shared Function GET_IP_FROM_MAID(sess_maId) As String
Dim SQL As New SQL
Return SQL.getValueTxtBySql(" SELECT TOP 1 isnull(sess_ipaddress,'') as sess_ipaddress FROM [tblSessions] where sess_lastRm > DATEADD(SECOND,-70, GETDATE()) AND sess_maId=" & sess_maId, "ADMIN")
End Function
Public Function LOGIN() As String
Me.sess_system = (If(VERAG_PROG_ALLGEMEIN.cAllgemein.TESTSYSTEM, "T", "E"))
Me.sess_login = Now
@@ -115,6 +128,12 @@ Public Class cSession
Me.sess_maName = VERAG_PROG_ALLGEMEIN.cAllgemein.USRKURZNAME
Me.sess_firma = VERAG_PROG_ALLGEMEIN.cAllgemein.FIRMA
Me.sess_niederlassung = VERAG_PROG_ALLGEMEIN.cAllgemein.NIEDERLASSUNG
Try
Me.sess_ipAddress = System.Net.Dns.GetHostByName(System.Net.Dns.GetHostName()).AddressList(0).ToString()
Me.sess_PCName = System.Environment.MachineName
Me.sess_PCUserName = My.User.Name.ToString
Catch ex As Exception
End Try
Me.sess_lastRm = Now
Me.sess_progId = Nothing
Me.sess_progName = VERAG_PROG_ALLGEMEIN.cAllgemein.PROGNAME