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

neu

Browse Source
This commit is contained in:
Andreas Luxbauer
2020-03-12 14:49:31 +01:00
parent f4c1a74870
commit cc28d5a6cf
197 changed files with 37402 additions and 4503 deletions
Download Patch File Download Diff File Expand all files Collapse all files

55
VERAG_PROG_ALLGEMEIN/Classes/SQL.vb
View File

@@ -27,18 +27,41 @@ Public Class SQL
End If
End Function
Public Shared Function GetFMZOLLConnectionString() As String
'Properties.Settings.Default.
If VERAG_PROG_ALLGEMEIN.cAllgemein.TESTSYSTEM Then
Return My.MySettings.Default.FMZOLLConnectionString
Else
Return My.MySettings.Default.FMZOLL_PRODConnectionString
Try
Return My.MySettings.Default.FMZOLL_PRODConnectionString
Catch ex As Exception
Return "Data Source=192.168.0.91\SQLFMZOLL;Initial Catalog=VERAG;Integrated Security=false;User ID=test;Password=BmWr501956;"
End Try
End If
End Function
Public Shared Function GetWEBConnectionString() As String
'Properties.Settings.Default.
If VERAG_PROG_ALLGEMEIN.cAllgemein.TESTSYSTEM Then
Return "Data Source=192.168.0.90\DEVSQL;Initial Catalog=VERAG_HOMEPAGE;Integrated Security=false;User ID=sa;Password=BmWr501956;"
Else
Return "Data Source=192.168.0.91\SQLFMZOLL;Initial Catalog=VERAG_HOMEPAGE;Integrated Security=false;User ID=sa;Password=BmWr501956;"
End If
End Function
Public Shared Function GetFMZOLLConnectionString(TESTSYSTEM) As String
If TESTSYSTEM Then
Return My.MySettings.Default.FMZOLLConnectionString
Else
Return My.MySettings.Default.FMZOLL_PRODConnectionString
Try
Return My.MySettings.Default.FMZOLL_PRODConnectionString
Catch ex As Exception
Return "Data Source=192.168.0.91\SQLFMZOLL;Initial Catalog=VERAG;Integrated Security=false;User ID=test;Password=BmWr501956;"
End Try
End If
End Function
@@ -89,7 +112,11 @@ Public Class SQL
If VERAG_PROG_ALLGEMEIN.cAllgemein.FIRMA = "ATILLA" Then
Return My.MySettings.Default.AVISO_ATILLAConnectionString
Else
Return My.MySettings.Default.AVISOConnectionString
Try
Return My.MySettings.Default.AVISOConnectionString
Catch ex As Exception
Return "Data Source=SQLGUIDE01.verag.ost.dmn\SQLEXPRESS;Initial Catalog=AVISO;Integrated Security=false;User ID=sa;Password=BmWr501956;Pooling=true;Min Pool Size=5;Max Pool Size=200"
End Try
End If
End If
End Function
@@ -142,6 +169,12 @@ Public Class SQL
cn.Open()
Return cn
End Function
Public Shared Function GetNewOpenConnectionWEB(Optional pooling As Boolean = True) As SqlConnection
Dim cn As New SqlConnection()
cn.ConnectionString = GetWEBConnectionString() & IIf(pooling, "", ";pooling=false")
cn.Open()
Return cn
End Function
Public Shared Function GetNewOpenConnectionFMZOLL_SYSTEM(TESTSYSTEM As Boolean, Optional pooling As Boolean = True) As SqlConnection
Dim cn As New SqlConnection()
cn.ConnectionString = GetFMZOLLConnectionString(TESTSYSTEM) & IIf(pooling, "", ";pooling=false")
@@ -281,6 +314,7 @@ Public Class SQL
Case "AVISO" : conn = GetNewOpenConnectionAVISO()
Case "VERAG" : conn = GetNewOpenConnectionFMZOLL()
Case "FD" : conn = GetNewOpenConnectionFD()
Case "WEB" : conn = GetNewOpenConnectionWEB()
Case "AVISO_ATILLA"
conn.ConnectionString = "Data Source=172.16.0.98;Initial Catalog=AVISO_ATILLA;Integrated Security=false;User ID=sa;Password=BmWr501956;Pooling=true;Min Pool Size=5;Max Pool Size=200"
@@ -321,6 +355,7 @@ Public Class SQL
Case "EZOLL" : conn = GetNewOpenConnectionEZOLL()
Case "AVISO" : conn = GetNewOpenConnectionAVISO()
Case "VERAG" : conn = GetNewOpenConnectionFMZOLL()
Case "WEB" : conn = GetNewOpenConnectionWEB()
End Select
' Using conn As SqlConnection = GetNewOpenConnection()
@@ -355,6 +390,7 @@ Public Class SQL
Case "AVISO" : conn = GetNewOpenConnectionAVISO()
Case "VERAG" : conn = GetNewOpenConnectionFMZOLL()
Case "DISPO" : conn = GetNewOpenConnectionDISPO()
Case "WEB" : conn = GetNewOpenConnectionWEB()
End Select
Using cmd As New SqlCommand(sql, conn)
@@ -407,6 +443,7 @@ Public Class SQL
Case "AVISO" : conn = GetNewOpenConnectionAVISO()
Case "VERAG" : conn = GetNewOpenConnectionFMZOLL()
Case "SCANCANON" : conn = GetNewOpenConnectionSCANCANON()
Case "WEB" : conn = GetNewOpenConnectionWEB()
End Select
End If
@@ -452,6 +489,7 @@ Public Class SQL
Case "EZOLL" : conn = GetNewOpenConnectionEZOLL()
Case "AVISO" : conn = GetNewOpenConnectionAVISO()
Case "VERAG" : conn = GetNewOpenConnectionFMZOLL()
Case "WEB" : conn = GetNewOpenConnectionWEB()
End Select
Using cmd As New SqlCommand(sql, conn)
@@ -494,6 +532,7 @@ Public Class SQL
Case "AVISO" : conn = GetNewOpenConnectionAVISO()
Case "VERAG" : conn = GetNewOpenConnectionFMZOLL()
Case "DISPO" : conn = GetNewOpenConnectionDISPO()
Case "WEB" : conn = GetNewOpenConnectionWEB()
Case "AVISO_ATILLA"
conn.ConnectionString = "Data Source=172.16.0.98;Initial Catalog=AVISO_ATILLA;Integrated Security=false;User ID=sa;Password=BmWr501956;Pooling=true;Min Pool Size=5;Max Pool Size=200"
@@ -532,6 +571,7 @@ Public Class SQL
Case "AVISO" : conn = GetNewOpenConnectionAVISO()
Case "DISPO" : conn = GetNewOpenConnectionDISPO()
Case "VERAG" : conn = GetNewOpenConnectionFMZOLL()
Case "WEB" : conn = GetNewOpenConnectionWEB()
End Select
Try
' MsgBox(sql)
@@ -565,6 +605,7 @@ Public Class SQL
Case "AVISO" : conn = GetNewOpenConnectionAVISO()
Case "DISPO" : conn = GetNewOpenConnectionDISPO()
Case "VERAG" : conn = GetNewOpenConnectionFMZOLL()
Case "WEB" : conn = GetNewOpenConnectionWEB()
End Select
Try
Using cmd As New SqlCommand(sql, conn)
@@ -626,6 +667,7 @@ Public Class SQL
Case "EZOLL" : conn = GetNewOpenConnectionEZOLL()
Case "AVISO" : conn = GetNewOpenConnectionAVISO()
Case "VERAG" : conn = GetNewOpenConnectionFMZOLL()
Case "WEB" : conn = GetNewOpenConnectionWEB()
End Select
' Using conn As SqlConnection = GetNewOpenConnection()
@@ -968,12 +1010,14 @@ Public Class SQL
Public Function getATLASNacherfassungAdresseNCTS(ByVal basman_nr As String, ByVal basman_nl As String, ByVal veoant_beznr As String, ByVal intLfdNr As String, ByVal intPosNr As String, lngTyp As String, connArt As String) As String
Dim s As String = ""
Try
Dim conn As SqlConnection
Dim conn As SqlConnection = Nothing
Select Case connArt
Case "ATLAS" : conn = SQL.GetNewOpenConnectionATLAS
Case "ATLAS_SBG" : conn = SQL.GetNewOpenConnectionATLAS_SBG
End Select
Using cmd As New SqlCommand("SELECT veoadr_name1, baslnd_alpha, veoadr_plz, veoadr_ort " &
If conn IsNot Nothing Then
Using cmd As New SqlCommand("SELECT veoadr_name1, baslnd_alpha, veoadr_plz, veoadr_ort " &
" FROM veoadr WHERE basman_nr='" & basman_nr & "' And basman_nl='" & basman_nl & "' And veoant_beznr='" & veoant_beznr & "' " &
" And veoant_lfdnr=" & intLfdNr & " And veopos_posnr=" & intPosNr & " And veoadr_typ=" & lngTyp & " " &
" ORDER BY basman_nr, basman_nl, veoant_beznr, veoant_lfdnr, veopos_posnr, veoadr_typ ", conn)
@@ -986,6 +1030,7 @@ Public Class SQL
End Using
conn.Close()
End If
Return s
Catch ex As Exception
MsgBox("Fehler in der Funktion '" & System.Reflection.MethodInfo.GetCurrentMethod.Name & "'" & vbNewLine & vbNewLine & ex.Message)

7
VERAG_PROG_ALLGEMEIN/Classes/cAdressen.vb
View File

@@ -78,7 +78,9 @@ Public Class cAdressen
End Using
Catch ex As Exception
MsgBox("Fehler in der Funktion '" & System.Reflection.MethodInfo.GetCurrentMethod.Name & "'" & vbNewLine & vbNewLine & ex.Message)
VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex.Message, ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name)
' MsgBox("Fehler in der Funktion '" & System.Reflection.MethodInfo.GetCurrentMethod.Name & "'" & vbNewLine & vbNewLine & ex.Message)
End Try
Return -1
End Function
@@ -218,7 +220,8 @@ Public Class cAdressen
End Using
'Return Nothing
Catch ex As Exception
MsgBox(test & "Fehler in der Funktion '" & System.Reflection.MethodInfo.GetCurrentMethod.Name & "'" & vbNewLine & vbNewLine & ex.Message & vbNewLine & vbNewLine & ex.StackTrace)
VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex.Message, ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name)
' MsgBox(test & "Fehler in der Funktion '" & System.Reflection.MethodInfo.GetCurrentMethod.Name & "'" & vbNewLine & vbNewLine & ex.Message & vbNewLine & vbNewLine & ex.StackTrace)
End Try
' Return Nothing
End Sub

215
VERAG_PROG_ALLGEMEIN/Classes/cAvisoBenachrichtigungen.vb Normal file
View File

@@ -0,0 +1,215 @@
Imports System.Data.SqlClient
Imports System.Reflection
Public Class cAvisoBenachrichtigungen
Property ab_id As Integer = -1
Property ab_AvisoID As Integer = -1
Property ab_SendungID As Object = Nothing
Property ab_Art As String
Property ab_Datum As Date
Property ab_Status As Integer
Property ab_BenachrichtigungCode As Integer
Property ab_Beschreibung As String
Property ab_Prioritaet As Integer
Property ab_Mitarbeiter As String
Property ab_MitarbeiterId As Integer
Property ab_TO_Art As Object = Nothing
Property ab_TO_Code As Object = Nothing
Property ab_Bestaetigt_MaId As Object = Nothing
Property ab_Bestaetigt_Datum As Object = Nothing
Property ab_Firma As Object = Nothing
Property ab_Cluster As Object = Nothing
Property ab_collAnhId As Object = Nothing
Property ab_Vermerk As Object = Nothing
Shared SQL As New SQL
Sub New()
End Sub
' ab_TO_Art
'F..irma
'N..iederlassung
'A..bteilung
'T..eam
'B..enutzer
Sub New(ab_id)
Me.ab_id = ab_id
LOAD()
End Sub
Public Shared Function INSERT_BENACHRICHTIGUNG(ab_AvisoID As Integer, ab_SendungID As Object, ab_BenachrichtigungCode As Integer, Optional ab_TO_Art As Object = Nothing, Optional ab_TO_Code As Object = Nothing, Optional ab_Beschreibung As String = "", Optional ab_Prioritaet As Integer = 0, Optional ab_collAnhId As String = "", Optional ab_Vermerk As String = "") As Boolean
Dim AB As New cAvisoBenachrichtigungen
AB.ab_AvisoID = ab_AvisoID
If ab_SendungID IsNot Nothing AndAlso ab_SendungID > 0 Then
AB.ab_SendungID = ab_SendungID
AB.ab_Art = "S"
Else
AB.ab_SendungID = Nothing
AB.ab_Art = "A"
End If
AB.ab_TO_Art = ab_TO_Art
AB.ab_TO_Code = ab_TO_Code
AB.ab_Datum = Now
AB.ab_Status = 0
AB.ab_BenachrichtigungCode = ab_BenachrichtigungCode
If ab_Beschreibung = "" Then ab_Beschreibung = SQL.getValueTxtBySql("SELECT abc_Bezeichnung FROM tblAvisoBenachrichtigungenCodes WHERE abc_id=" & ab_BenachrichtigungCode, "AVISO")
AB.ab_Beschreibung = ab_Beschreibung
AB.ab_Prioritaet = ab_Prioritaet
AB.ab_Mitarbeiter = VERAG_PROG_ALLGEMEIN.cAllgemein.USRNAME
AB.ab_MitarbeiterId = VERAG_PROG_ALLGEMEIN.cAllgemein.USRID
AB.ab_Firma = VERAG_PROG_ALLGEMEIN.cAllgemein.FIRMA
AB.ab_Cluster = VERAG_PROG_ALLGEMEIN.cAllgemein.CLUSTER
AB.ab_Vermerk = ab_Vermerk
AB.ab_collAnhId = ab_collAnhId
Return AB.SAVE
End Function
Public Function BESTAETIGEN_BENACHRICHTIGUNG() As Boolean
Me.ab_Status = 1
Me.ab_Bestaetigt_MaId = VERAG_PROG_ALLGEMEIN.cAllgemein.USRID
Me.ab_Bestaetigt_Datum = Now
Return Me.SAVE
End Function
Public Shared Function BESTAETIGEN_BENACHRICHTIGUNG(ab_id As Integer) As Boolean
Dim AB As New cAvisoBenachrichtigungen(ab_id)
AB.ab_Status = 1
AB.ab_Bestaetigt_MaId = VERAG_PROG_ALLGEMEIN.cAllgemein.USRID
AB.ab_Bestaetigt_Datum = Now
Return AB.SAVE
End Function
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("ab_id", ab_id, , True, True))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("ab_AvisoID", ab_AvisoID)) ' INT NULL,
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("ab_SendungID", ab_SendungID)) ' INT NULL,
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("ab_Art", ab_Art)) ' INT NULL,
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("ab_Datum", ab_Datum)) ' INT NULL,
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("ab_Status", ab_Status)) ' VARCHAR(200) Not NULL,
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("ab_BenachrichtigungCode", ab_BenachrichtigungCode)) ' VARCHAR(40) Not NULL,
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("ab_Beschreibung", ab_Beschreibung)) ' VARCHAR(40) NULL,
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("ab_Prioritaet", ab_Prioritaet)) 'VARCHAR(40) Not NULL,
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("ab_Mitarbeiter", ab_Mitarbeiter)) 'VARCHAR(60) Not NULL,
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("ab_MitarbeiterId", ab_MitarbeiterId))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("ab_TO_Art", ab_TO_Art))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("ab_TO_Code", ab_TO_Code))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("ab_Bestaetigt_MaId", ab_Bestaetigt_MaId))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("ab_Bestaetigt_Datum", ab_Bestaetigt_Datum))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("ab_Firma", ab_Firma))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("ab_Cluster", ab_Cluster))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("ab_collAnhId", ab_collAnhId))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("ab_Vermerk", ab_Vermerk))
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 tblAvisoBenachrichtigungen WITH(updlock,serializable) WHERE ab_id=@ab_id) " &
" BEGIN " & getUpdateCmd() & " END " &
" Else " &
" BEGIN " & getInsertCmd() & " END " &
" commit tran "
ab_id = SQL.doSQLVarListID(ab_id, sqlstr, "AVISO", , list)
Return ab_id > 0
End Function
Public Sub LOAD()
Try
Using conn As SqlConnection = SQL.GetNewOpenConnectionAVISO
Using cmd As New SqlCommand("SELECT * FROM tblAvisoBenachrichtigungen WHERE ab_id=@ab_id ", conn)
cmd.Parameters.AddWithValue("@ab_id", ab_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 [tblAvisoBenachrichtigungen] SET " & str & " WHERE ab_id=@ab_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 tblAvisoBenachrichtigungen (" & 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 [tblAvisoBenachrichtigungen] WITH(updlock,serializable) WHERE ab_id=" & Me.ab_id
Return SQL.doSQL(sqlstr, "AVISO")
End Function
End Class

155
VERAG_PROG_ALLGEMEIN/Classes/cCryptography.vb Normal file
View File

@@ -0,0 +1,155 @@
Imports System.IO
Imports System.Security.Cryptography
Imports System.Text
Public Class cCryptography
'Dim EncryptionKey As String = "$kldfKFSAK37236780!!*+++hHUDO723BNU!$hask+*jhds7!2929j$+jP*!hWrT$kldfKFSAK37236780!!*+++hHUDO723BNU!$hask+*jhds7!2929j$+jP*!hWrT"
Shared EncryptionKey As String = "$kldfKFSAK37236780!!*+++hHUDO723BNU!$hask+*jhds7!2929j$+jP*!hWrT$kldfKFSAK37236780!!*+++hHUDO723BNU!$hask+*jhds7!2929j$+jP*!hWrT"
Public Shared Function Encrypt(clearText As String) As String
Dim clearBytes As Byte() = Encoding.Unicode.GetBytes(clearText)
Using encryptor As Aes = Aes.Create()
Dim pdb As New Rfc2898DeriveBytes(EncryptionKey, New Byte() {&H49, &H76, &H61, &H6E, &H20, &H4D, &H65, &H64, &H76, &H65, &H64, &H65, &H76})
encryptor.Key = pdb.GetBytes(32)
encryptor.IV = pdb.GetBytes(16)
Using ms As New MemoryStream()
Using cs As New CryptoStream(ms, encryptor.CreateEncryptor(), CryptoStreamMode.Write)
cs.Write(clearBytes, 0, clearBytes.Length)
cs.Close()
End Using
clearText = Convert.ToBase64String(ms.ToArray())
End Using
End Using
Return clearText
End Function
Public Shared Function Decrypt(cipherText As String) As String
Dim cipherBytes As Byte() = Convert.FromBase64String(cipherText)
Using encryptor As Aes = Aes.Create()
Dim pdb As New Rfc2898DeriveBytes(EncryptionKey, New Byte() {&H49, &H76, &H61, &H6E, &H20, &H4D, &H65, &H64, &H76, &H65, &H64, &H65, &H76})
encryptor.Key = pdb.GetBytes(32)
encryptor.IV = pdb.GetBytes(16)
Using ms As New MemoryStream()
Using cs As New CryptoStream(ms, encryptor.CreateDecryptor(), CryptoStreamMode.Write)
cs.Write(cipherBytes, 0, cipherBytes.Length)
cs.Close()
End Using
cipherText = Encoding.Unicode.GetString(ms.ToArray())
End Using
End Using
Return cipherText
End Function
End Class
Public Class cCryptography2
Shared _key As String = "!#$a54?3"
Public Shared Function Encrypt(ByVal strQueryString As String) As String
Dim oES As New Encryption64()
Return oES.Encrypt(strQueryString, _key)
End Function
Public Shared Function Decrypt(ByVal strQueryString As String) As String
Dim oES As New Encryption64()
Return oES.Decrypt(strQueryString, _key)
End Function
End Class
Public Class Encryption64
Private key() As Byte = {}
Private IV() As Byte = {&H12, &H34, &H56, &H78, &H90, &HAB, &HCD, &HEF}
Public Function Decrypt(ByVal stringToDecrypt As String,
ByVal sEncryptionKey As String) As String
Dim inputByteArray(stringToDecrypt.Length) As Byte
Try
key = System.Text.Encoding.UTF8.GetBytes(Left(sEncryptionKey, 8))
Dim des As New DESCryptoServiceProvider()
inputByteArray = Convert.FromBase64String(stringToDecrypt)
Dim ms As New MemoryStream()
Dim cs As New CryptoStream(ms, des.CreateDecryptor(key, IV),
CryptoStreamMode.Write)
cs.Write(inputByteArray, 0, inputByteArray.Length)
cs.FlushFinalBlock()
Dim encoding As System.Text.Encoding = System.Text.Encoding.UTF8
Return encoding.GetString(ms.ToArray())
Catch e As Exception
Return e.Message
End Try
End Function
Public Function Encrypt(ByVal stringToEncrypt As String,
ByVal SEncryptionKey As String) As String
Try
key = System.Text.Encoding.UTF8.GetBytes(Left(SEncryptionKey, 8))
Dim des As New DESCryptoServiceProvider()
Dim inputByteArray() As Byte = Encoding.UTF8.GetBytes(
stringToEncrypt)
Dim ms As New MemoryStream()
Dim cs As New CryptoStream(ms, des.CreateEncryptor(key, IV),
CryptoStreamMode.Write)
cs.Write(inputByteArray, 0, inputByteArray.Length)
cs.FlushFinalBlock()
Return Convert.ToBase64String(ms.ToArray())
Catch e As Exception
Return e.Message
End Try
End Function
End Class
Public Class cCryptography3
Shared _key As String = "!#?"
'Public Shared Function Encrypt(ByVal strQueryString As String) As String
' Using hasher As MD5 = MD5.Create() ' create hash object
' ' Convert to byte array and get hash
' Dim dbytes As Byte() =
' hasher.ComputeHash(Encoding.UTF8.GetBytes(strQueryString & _key))
' ' sb to create string from bytes
' Dim sBuilder As New StringBuilder()
' ' convert byte data to hex string
' For n As Integer = 0 To dbytes.Length - 1
' sBuilder.Append(dbytes(n).ToString("X2"))
' Next n
' Return sBuilder.ToString()
' End Using
'End Function
Public Shared Function Encrypt(ByVal input As String) As String
Dim stringBytes As Byte() = System.Text.Encoding.Unicode.GetBytes(input & _key)
Dim sbBytes As StringBuilder = New StringBuilder(stringBytes.Length * 2)
For Each b As Byte In stringBytes
sbBytes.AppendFormat("{0:X2}", b)
Next
Return sbBytes.ToString()
End Function
Public Shared Function Decrypt(ByVal hexInput As String) As String
Dim numberChars As Integer = hexInput.Length
Dim bytes As Byte() = New Byte(numberChars / 2 - 1) {}
For i As Integer = 0 To numberChars - 1 Step 2
bytes(i / 2) = Convert.ToByte(hexInput.Substring(i, 2), 16)
Next
Return System.Text.Encoding.Unicode.GetString(bytes).Replace(_key, "")
End Function
End Class

88
VERAG_PROG_ALLGEMEIN/Classes/cHandlingssaetzeIntern.vb Normal file
View File

@@ -0,0 +1,88 @@

Imports System.Data.SqlClient
Imports System.Reflection
Public Class cHandlingssaetzeInternLIST
Property hs_Bezeichnung As Object = Nothing
' Property OffertenNr As Object = Nothing
Public LIST As New List(Of cHandlingssaetzeIntern)
Dim SQL As New SQL
'Dim listTodelete As New List(Of cHandlingssaetzeIntern)
Sub New(hs_Bezeichnung)
Me.hs_Bezeichnung = hs_Bezeichnung
' Me.OffertenNr = OffertenNr
LOAD_LIST(Me.hs_Bezeichnung)
End Sub
Public Sub CLEAR()
LIST.Clear()
End Sub
Public Sub LOAD_LIST(hs_Bezeichnung)
Try
LIST.Clear()
Using conn As SqlConnection = SQL.GetNewOpenConnectionFMZOLL()
Using cmd As New SqlCommand("SELECT * FROM tblHandlingssaetzeIntern WHERE hs_Bezeichnung=@hs_Bezeichnung ", conn)
cmd.Parameters.AddWithValue("@hs_Bezeichnung", hs_Bezeichnung)
' cmd.Parameters.AddWithValue("@OffertenNr", OffertenNr)
Dim dr = cmd.ExecuteReader()
While dr.Read
Dim l As New cHandlingssaetzeIntern
For Each i In l.getParameterList()
Dim propInfo As PropertyInfo = l.GetType.GetProperty(i.Scalarvariable)
If dr.Item(i.Text) Is DBNull.Value Then
propInfo.SetValue(l, Nothing)
Else
propInfo.SetValue(l, dr.Item(i.Text))
End If
Next
LIST.Add(l)
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
'Function SAVE()
' If SQL.doSQLVarList("DELETE FROM tblEmailBenachrichtigung WHERE eb_KundenNr=" & Me.eb_KundenNr & " and eb_ebartId=" & Me.eb_ebartId & " ", "FMZOLL") Then
' For Each l In LIST
' If Not l.INSERT() Then Return False
' Next
' Return True
' Else
' Return False
' End If
'End Function
End Class
Public Class cHandlingssaetzeIntern
Property hs_Bezeichnung As Object = Nothing
Property hs_RgVon As Object = Nothing
Property hs_RgAn As Object = Nothing
Property hs_Abfertigungsart As Object = Nothing
Property hs_Preis As Object = Nothing
Dim SQL As New SQL
Sub New()
End Sub
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("hs_Bezeichnung", hs_Bezeichnung))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("hs_RgVon", hs_RgVon))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("hs_RgAn", hs_RgAn))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("hs_Abfertigungsart", hs_Abfertigungsart))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("hs_Preis", hs_Preis))
Return list
End Function
End Class

3
VERAG_PROG_ALLGEMEIN/Classes/cKundenErweitert.vb
View File

@@ -49,6 +49,8 @@ Public Class cKundenErweitert
Property kde_Inkasso_GemeldeterBetrag As Object = Nothing
Property AutoFakturierung As Boolean = False
Property Anmerkungen_Warnhinweis As Object = Nothing
Property kde_VERAG_INTERFACE_ID As Object = Nothing
Dim SQL As New SQL
@@ -99,6 +101,7 @@ Public Class cKundenErweitert
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("kde_Inkasso_GemeldeterBetrag", kde_Inkasso_GemeldeterBetrag))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("AutoFakturierung", AutoFakturierung))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("Anmerkungen_Warnhinweis", Anmerkungen_Warnhinweis))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("kde_VERAG_INTERFACE_ID", kde_VERAG_INTERFACE_ID))
Return list
End Function

172
VERAG_PROG_ALLGEMEIN/Classes/cLanguageText.vb Normal file
View File

@@ -0,0 +1,172 @@
Imports System.Data.SqlClient
Imports System.Reflection
Public Class cLanguageText_LIST
Dim LIST As New List(Of cLanguageText)
Sub New(tlan_kategorie, tlan_ukategorie1, tlan_ukategorie2, tlan_ukategorie3)
LOAD_LIST(tlan_kategorie, tlan_ukategorie1, tlan_ukategorie2, tlan_ukategorie3)
End Sub
Public Sub LOAD_LIST(tlan_kategorie, tlan_ukategorie1, tlan_ukategorie2, tlan_ukategorie3)
Try
List.Clear()
Using conn As SqlConnection = SQL.GetNewOpenConnectionWEB()
Using cmd As New SqlCommand("SELECT * FROM tblLanguageText WHERE tlan_kategorie=@tlan_kategorie AND tlan_ukategorie1=@tlan_ukategorie1 AND tlan_ukategorie2=@tlan_ukategorie2 AND tlan_ukategorie3=@tlan_ukategorie3 ", conn)
cmd.Parameters.AddWithValue("@tlan_kategorie", tlan_kategorie)
cmd.Parameters.AddWithValue("@tlan_ukategorie1", tlan_ukategorie1)
cmd.Parameters.AddWithValue("@tlan_ukategorie2", tlan_ukategorie2)
cmd.Parameters.AddWithValue("@tlan_ukategorie3", tlan_ukategorie3)
' cmd.Parameters.AddWithValue("@OffertenNr", OffertenNr)
Dim dr = cmd.ExecuteReader()
While dr.Read
Dim l As New cLanguageText
For Each i In l.getParameterList()
Dim propInfo As PropertyInfo = l.GetType.GetProperty(i.Scalarvariable)
If dr.Item(i.Text) Is DBNull.Value Then
propInfo.SetValue(l, Nothing)
Else
propInfo.SetValue(l, dr.Item(i.Text))
End If
Next
LIST.Add(l)
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 getTxt(tlan_Id, tlan_language, defaultTXT) As String
For Each l In LIST
If l.tlan_Id = tlan_Id And l.tlan_language = tlan_language Then
Return l.tlan_TEXT
End If
Next
Return defaultTXT
End Function
End Class
Public Class cLanguageText
Property tlan_Id As Integer
Property tlan_kategorie As String = ""
Property tlan_ukategorie1 As String = ""
Property tlan_ukategorie2 As String = ""
Property tlan_ukategorie3 As String = ""
Property tlan_language As String = ""
Property tlan_TEXT As String = ""
Dim SQL As New SQL
Sub New()
End Sub
Sub New(tlan_Id, tlan_language)
Me.tlan_Id = tlan_Id
Me.tlan_language = tlan_language
LOAD()
End Sub
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("tlan_Id", tlan_Id))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("tlan_kategorie", tlan_kategorie))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("tlan_ukategorie1", tlan_ukategorie1))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("tlan_ukategorie2", tlan_ukategorie2))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("tlan_ukategorie3", tlan_ukategorie3))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("tlan_language", tlan_language))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("tlan_TEXT", tlan_TEXT))
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 tblLanguageText WHERE tlan_Id=@tlan_Id AND tlan_language=@tlan_language) " &
" BEGIN " & getUpdateCmd() & " END " &
" Else " &
" BEGIN " & getInsertCmd() & " END " &
" commit tran "
Return SQL.doSQLVarList(sqlstr, "WEB", , list)
End Function
Public Sub LOAD()
Try
Using conn As SqlConnection = SQL.GetNewOpenConnectionWEB()
Using cmd As New SqlCommand("SELECT * FROM tblLanguageText WHERE tlan_Id=@tlan_Id AND tlan_language=@tlan_language ", conn)
cmd.Parameters.AddWithValue("@tlan_Id", tlan_Id)
cmd.Parameters.AddWithValue("@tlan_language", tlan_language)
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 [tblLanguageText] SET " & str & " WHERE tlan_Id=@tlan_Id AND tlan_language=@tlan_language ")
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 tblLanguageText (" & 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
End Class

129
VERAG_PROG_ALLGEMEIN/Classes/cMessangerListender.vb
View File

@@ -22,12 +22,22 @@ Public Class cMessangerListender
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)
Try
If serverSocket IsNot Nothing AndAlso serverSocket.IsBound Then
Else
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 If
Catch ex As Exception
'LEIDER KEINE ANDRES LÖSUNG
End Try
End Sub
Private Sub OnAccept(ByVal ar As IAsyncResult)
@@ -99,14 +109,14 @@ Public Class cMessangerListender
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)
'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
@@ -121,7 +131,7 @@ Public Class cMessangerListender
Sub NEW_MESSAGE()
VERAG_PROG_ALLGEMEIN.cMessenger.NEW_MESSGE = True
MsgBox("jojo")
' MsgBox("jojo")
'For Each openForm In Application.OpenForms()
' If TypeOf (openForm) Is frmMessenger Then
' 'MsgBox("Sendungsfenster bereits geöffnet!")
@@ -263,32 +273,37 @@ Public Class cServerClient
Public Sub begin(ip, doThis_tmp)
doThis = doThis_tmp
Try
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 "NEW_MESSAGE" : timeOut = 5 ' 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)
'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)
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)
' endconnect(clientSocket)
Catch ex As Exception
MsgBox(ex.Message & ex.StackTrace)
End Try
End Sub
@@ -382,37 +397,37 @@ Public Class cServerClient
'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))
'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()
' clientSocket.Shutdown(SocketShutdown.Both)
' clientSocket.Close()
End If
Catch ex As Exception
@@ -435,7 +450,7 @@ Public Class cServerClient
clientSocket.Shutdown(SocketShutdown.Both)
clientSocket.Close()
Catch ex As Exception
MsgBox(ex.Message)
MsgBox(ex.Message & ex.StackTrace)
End Try
RaiseEvent FunctionFinished(Me, New FunctionFinishedArgs(FunctionFinishedArgs.EventResult.ERR, "Task wurde aufgrund eines Timeouts vom Client abgebrochen."))

76
VERAG_PROG_ALLGEMEIN/Classes/cMessenger.vb
View File

@@ -23,7 +23,10 @@ Public Class cMessenger
End Function
Public Shared Function GET_NewMSG_COUNT(Optional maId = -1) As Integer
If maId < 0 Then maId = VERAG_PROG_ALLGEMEIN.cAllgemein.USRID
Return SQL.getValueTxtBySql("SELECT isnull(COUNT(*),0) FROM tblMessenger_ChatMessages INNER JOIN tblMessenger_ChatMessageStatus ON chatMgSt_chatMsgId=chatMg_id WHERE chatMgSt_MaId=" & VERAG_PROG_ALLGEMEIN.cAllgemein.USRID & " AND chatMgSt_gelesen=0", "ADMIN",,, 0)
End Function
Public Shared Function GET_CHAT_LIST() As List(Of cMessenger_Chat)
Dim LIST As New List(Of cMessenger_Chat)
@@ -56,11 +59,11 @@ Public Class cMessenger
End Sub
Sub New(chat_id)
Sub New(chat_id As Integer, Optional topMax As String = "")
Me.chat_id = chat_id
Me.chat_erstelltMaId = VERAG_PROG_ALLGEMEIN.cAllgemein.USRID
Me.chat_erstelltAm = Now
LOAD()
LOAD(topMax)
End Sub
Public Function getParameterList() As List(Of VERAG_PROG_ALLGEMEIN.SQLVariable)
@@ -94,8 +97,8 @@ Public Class cMessenger
Return chat_id > 0
End Function
Public Sub LOAD()
Try
Public Sub LOAD(Optional topMax As String = "")
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)
@@ -112,7 +115,7 @@ Public Class cMessenger
Next
Me.LOAD_MEMBERS()
Me.LOAD_MESSAGES()
Me.LOAD_MESSAGES(topMax)
End If
dr.Close()
End Using
@@ -135,6 +138,12 @@ Public Class cMessenger
MsgBox("Fehler in der Funktion '" & System.Reflection.MethodInfo.GetCurrentMethod.Name & "'" & vbNewLine & vbNewLine & ex.Message & vbNewLine & vbNewLine & ex.StackTrace)
End Try
End Sub
Public Function READ_ALL_MESSAGES() As Boolean
Dim sqlstr = "UPDATE tblMessenger_ChatMessageStatus SET chatMgSt_gelesen=1 FROM [tblMessenger_Chat] INNER JOIN tblMessenger_ChatMessages ON [chat_id]=chatMg_chatId INNER JOIN tblMessenger_ChatMessageStatus ON chatMgSt_chatMsgId=chatMg_id WHERE chat_id=" & Me.chat_id & " AND chatMgSt_MaId=" & VERAG_PROG_ALLGEMEIN.cAllgemein.USRID & " AND chatMgSt_gelesen=0 "
Return SQL.doSQL(sqlstr, "ADMIN")
End Function
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")
@@ -161,7 +170,7 @@ Public Class cMessenger
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)
Using cmd As New SqlCommand("SELECT * FROM(SELECT TOP " & top & " * FROM [tblMessenger_ChatMessages] WHERE chatMg_chatId=@chat_id order by chatMg_datetime desc) as T order by chatMg_datetime asc", conn)
cmd.Parameters.AddWithValue("@chat_id", chat_id)
Dim dr = cmd.ExecuteReader()
While dr.Read
@@ -498,6 +507,9 @@ Public Class cMessenger
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_maName", chatMg_maName))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("chatMg_maFirma", chatMg_maFirma))
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))
@@ -510,15 +522,23 @@ Public Class cMessenger
Public Function SAVE() As Boolean
Public Function SAVE(saveStat As Boolean, Optional CHAT_MEMBERS As List(Of cMessenger_ChatMembers) = Nothing) 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 "
Dim tmp_id = SQL.doSQLVarListID(Me.chatMg_id, sqlstr, "ADMIN", , list)
If tmp_id > 0 Then
Me.chatMg_id = tmp_id
If saveStat Then SAVE_STATUS_FIRST(CHAT_MEMBERS)
Return True
Else
Return False
End If
Return SQL.doSQLVarList(sqlstr, "ADMIN", , list)
''Return SQL.doSQLVarList(sqlstr, "ADMIN", , list)
End Function
Public Sub LOAD()
@@ -538,7 +558,7 @@ Public Class cMessenger
End If
Next
LOAD_STATUS()
End If
dr.Close()
End Using
@@ -595,23 +615,29 @@ Public Class cMessenger
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
Public Sub SAVE_STATUS_FIRST(CHAT_MEMBERS As List(Of cMessenger_ChatMembers))
Try
If CHAT_MEMBERS IsNot Nothing Then
For Each MB In CHAT_MEMBERS
Dim gelesen = False
If MB.chatMb_maId = VERAG_PROG_ALLGEMEIN.cAllgemein.USRID Then
gelesen = True
End If
Dim STAT As New cMessenger_ChatMessageStatus(Me.chatMg_id, MB.chatMb_maId, gelesen)
STAT.SAVE()
Next
End If
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_STATUS() As Boolean 'obj As Object, tablename As String, where As String) As Boolean
' Dim sqlstr = " DELETE FROM [tblMessenger_ChatMessageStatus] WHERE chatMb_chatId=" & Me.chatMg_chatId
' Return SQL.doSQL(sqlstr, "ADMIN")
'End Function
Public Sub LOAD_STATUS()
Try
Me.CHAT_MESSAGES_STATUS_LIST.Clear()

5
VERAG_PROG_ALLGEMEIN/Classes/cMitarbeiter.vb
View File

@@ -51,7 +51,10 @@ Public Class cMitarbeiter
Property mit_AliasAD_Domain As Object = Nothing
Property mit_AliasAD_Username As Object = Nothing
Property mit_teamId As Object = Nothing
Property mit_ChatBenutzer As Boolean = True
Property mit_FirmaHaupt As Object = Nothing
Sub New()
@@ -133,6 +136,8 @@ Public Class cMitarbeiter
If Not dr.Item("mit_teamId") Is DBNull.Value Then Me.mit_teamId = dr.Item("mit_teamId")
Me.mit_ChatBenutzer = dr.Item("mit_ChatBenutzer")
If Not dr.Item("mit_FirmaHaupt") Is DBNull.Value Then Me.mit_FirmaHaupt = dr.Item("mit_FirmaHaupt")
Catch ex As Exception

13
VERAG_PROG_ALLGEMEIN/Classes/cSpeditionsbuch.vb
View File

@@ -70,7 +70,7 @@ Public Class cSpeditionsbuch
Property FilialenNr As Integer = -1
Property AbfertigungsNr As Integer = -1
Property UnterNr As Integer = -1
Property Abfertigungsdatum As Object = Nothing
Property Abfertigungsdatum As Object = CDate(Now.ToShortDateString)
Property Bar As Boolean = False
Property Fakturiert As Boolean = False
Property BelegNr As String = ""
@@ -138,6 +138,7 @@ Public Class cSpeditionsbuch
Property Versendungsland As String = ""
Property SB_CMR As Boolean = False
Property SB_CMRDatum As Object = Nothing
Property SB_CMRNr As Object = Nothing
Property veoerz_basbtg As Double = 0
Property Zucker_MRN_Nr As Object = Nothing
Property Zucker_MRN_Datum As Object = Nothing
@@ -173,6 +174,10 @@ Public Class cSpeditionsbuch
Property DokumentId_Steuerbeleg As Object = Nothing
Property DokumentId_Mitteilung As Object = Nothing
Property DokumentId_VBD As Object = Nothing
Property FilialenNrHandling As Object = Nothing
Property HandlingZuKassieren As Double = 0
Property UNTERPOS As New List(Of cSpeditionsbuchUnterPos)
Property VORKOSTEN As New List(Of cVorkosten)
@@ -322,7 +327,10 @@ Public Class cSpeditionsbuch
Me.DokumentId_Steuerbeleg = SQL.checkNullReturnValue(dr.Item("DokumentId_Steuerbeleg"), Nothing)
Me.DokumentId_Mitteilung = SQL.checkNullReturnValue(dr.Item("DokumentId_Mitteilung"), Nothing)
Me.DokumentId_VBD = SQL.checkNullReturnValue(dr.Item("DokumentId_VBD"), Nothing)
Me.FilialenNrHandling = SQL.checkNullReturnValue(dr.Item("FilialenNrHandling"), Nothing)
Me.HandlingZuKassieren = SQL.checkNulDbl(dr.Item("HandlingZuKassieren"))
Me.SB_CMRNr = SQL.checkNullReturnValue(dr.Item("SB_CMRNr"), Nothing)
LOAD_VORKOSTEN()
@@ -426,6 +434,9 @@ Public Class cSpeditionsbuch
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("DokumentId_Steuerbeleg", DokumentId_Steuerbeleg))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("DokumentId_Mitteilung", DokumentId_Mitteilung))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("DokumentId_VBD", DokumentId_VBD))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("FilialenNrHandling", FilialenNrHandling))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("HandlingZuKassieren", HandlingZuKassieren))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("SB_CMRNr", SB_CMRNr))
Return list

172
VERAG_PROG_ALLGEMEIN/Classes/cTextkonserve.vb Normal file
View File

@@ -0,0 +1,172 @@

Imports System.Data.SqlClient
Imports System.Reflection
Public Class cTextkonserve
Property txt_Id As Integer
Property txt_kategorie As String
Property txt_bezeichnung As String
Property txt_sprache As String
Property txt_text As String
Property txt_betreff As String
Public hasEntry As Boolean = False
Dim SQL As New SQL
Sub New()
End Sub
Sub New(txt_Id)
' If txt_Id IsNot Nothing Then
Me.txt_Id = txt_Id
LOAD()
' End If
End Sub
Sub New(txt_kategorie, txt_bezeichnung, txt_sprache)
' If txt_Id IsNot Nothing Then
Me.txt_kategorie = txt_kategorie
Me.txt_bezeichnung = txt_bezeichnung
Me.txt_sprache = txt_sprache
LOAD(txt_kategorie, txt_bezeichnung, txt_sprache)
' End If
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("txt_Id", txt_Id, , True, True))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("txt_kategorie", txt_kategorie))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("txt_bezeichnung", txt_bezeichnung))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("txt_sprache", txt_sprache))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("txt_text", txt_text))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("txt_betreff", txt_betreff))
Return list
End Function
Public Function SAVE(Optional errHinweis = "") As Boolean
Dim list As List(Of VERAG_PROG_ALLGEMEIN.SQLVariable) = getParameterList()
Dim sqlstr = " BEGIN TRAN IF EXISTS(SELECT * FROM tblTextkonserve WITH(updlock,serializable) WHERE txt_Id=@txt_Id) " &
" BEGIN " & getUpdateCmd() & " END " &
" Else " &
" BEGIN " & getInsertCmd() & " END " &
" commit tran "
txt_Id = SQL.doSQLVarListID(txt_Id, sqlstr, "FMZOLL", , list,, errHinweis)
Return txt_Id > 0
End Function
Public Sub LOAD()
Try
Using conn As SqlConnection = SQL.GetNewOpenConnectionFMZOLL
Using cmd As New SqlCommand("SELECT * FROM tblTextkonserve WHERE txt_Id=@txt_Id ", conn)
cmd.Parameters.AddWithValue("@txt_Id", txt_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
hasEntry = True
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 Sub LOAD(txt_kategorie, txt_bezeichnung, txt_sprache)
Try
Using conn As SqlConnection = SQL.GetNewOpenConnectionFMZOLL
Using cmd As New SqlCommand("SELECT TOP 1 * FROM tblTextkonserve WHERE txt_kategorie=@txt_kategorie AND txt_bezeichnung=@txt_bezeichnung AND txt_sprache=@txt_sprache ", conn)
cmd.Parameters.AddWithValue("@txt_kategorie", txt_kategorie)
cmd.Parameters.AddWithValue("@txt_bezeichnung", txt_bezeichnung)
cmd.Parameters.AddWithValue("@txt_sprache", txt_sprache)
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
hasEntry = True
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 [tblTextkonserve] SET " & str & " WHERE txt_Id=@txt_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 tblTextkonserve (" & 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 [tblTextkonserve] WITH(updlock,serializable) WHERE txt_Id=" & Me.txt_Id
Return SQL.doSQL(sqlstr, "FMZOLL")
End Function
Public Shared Function DELETE(id As Integer) As Boolean 'obj As Object, tablename As String, where As String) As Boolean
Dim sqlstr = " DELETE FROM [tblTextkonserve] WITH(updlock,serializable) WHERE txt_Id=" & id
Return (New VERAG_PROG_ALLGEMEIN.SQL).doSQL(sqlstr, "FMZOLL")
End Function
End Class

17
VERAG_PROG_ALLGEMEIN/Classes/cVorauskasse.vb
View File

@@ -64,7 +64,10 @@ Public Class cVorauskasse
Property vk_Berechnung_SonstigeKosten As Object = Nothing
Property vk_Berechnung_SonstigeKostenText As Object = Nothing
Property vk_Berechnung_PP As Object = Nothing
Property vk_Freigegeben As Boolean = False
Property vk_SendungId As Object = Nothing
Property vk_AvisoId As Object = Nothing
Property vk_VermerkId As Object = Nothing
Dim SQL As New SQL
@@ -136,6 +139,10 @@ Public Class cVorauskasse
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("vk_Berechnung_SVS", vk_Berechnung_SVS))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("vk_Berechnung_SonstigeKosten", vk_Berechnung_SonstigeKosten))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("vk_Berechnung_PP", vk_Berechnung_PP))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("vk_Freigegeben", vk_Freigegeben))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("vk_SendungId", vk_SendungId))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("vk_AvisoId", vk_AvisoId))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("vk_VermerkId", vk_VermerkId))
Return list
End Function
@@ -190,6 +197,8 @@ Public Class cVorauskasse
Public Function SET_GELDEINGANG(vk_GeldEingetroffen As Boolean, Optional vk_BH_Bemerkung As Object = Nothing) As Boolean
Me.vk_GeldEingetroffen = vk_GeldEingetroffen
Me.vk_Freigegeben = vk_GeldEingetroffen
If Me.vk_GeldEingetroffen Then
Me.vk_BH_DatumGeldeingang = Now
Me.vk_BH_SachbearbeiterId = VERAG_PROG_ALLGEMEIN.cAllgemein.MITARBEITER.mit_id
@@ -204,6 +213,12 @@ Public Class cVorauskasse
Return SAVE()
End Function
Public Function SET_FREIGEGEBEN(vk_Freigegeben As Boolean, Optional vk_BH_Bemerkung As Object = Nothing) As Boolean
Me.vk_Freigegeben = vk_Freigegeben
Me.vk_BH_Bemerkung = vk_BH_Bemerkung
Return SAVE()
End Function
Public Function SET_STORNO() As Boolean
Me.vk_storno = Not Me.vk_storno
Return SAVE()