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

commit

Browse Source
This commit is contained in:
m.ilhan
2024-10-01 16:32:40 +02:00
parent 76fbf96823
commit fad2055152
2987 changed files with 13801 additions and 200 deletions
Download Patch File Download Diff File Expand all files Collapse all files

647
VERAG_PROG_ALLGEMEIN/cProgramFunktions.vb
View File

@@ -1,647 +0,0 @@
Imports System.Drawing
Imports System.IO
Imports System.Net.Mail
Imports System.Reflection
Imports System.Text
Imports System.Windows.Forms
Imports ClosedXML.Excel
Imports Microsoft.Office.Interop
Imports VERAG_PROG_ALLGEMEIN.TESTJSON
Public Class cProgramFunctions
Shared SQL As New VERAG_PROG_ALLGEMEIN.SQL
Public Shared Function fktEuro(varBetrag As Object, varVonWährung As Object, varNachWährung As Object) As Object
'(FixeTaxe, "ATS", RECHNUNG.Währungscode)
'Dim varVonWährung As Object
'Dim varNachWährung As Object
Dim varKurs As Object
If varVonWährung Is Nothing Then Return Nothing
If varNachWährung Is Nothing Then Return Nothing
If varVonWährung = varNachWährung Then ' Sind beide Währungen gleich,
fktEuro = varBetrag ' ist keine Umrechnung erforderlich
Exit Function ' und die Funktion wird beendet
End If
If Not IsNumeric(varVonWährung) Then
varVonWährung = SQL.DLookup("[Währungsschlüssel]", "Währungstabelle", "[Währungscode] = '" & varVonWährung & "' order by Währungsschlüssel DESC", "FMZOLL")
End If
If Not IsNumeric(varNachWährung) Then
varNachWährung = SQL.DLookup("[Währungsschlüssel]", "Währungstabelle", "[Währungscode] = '" & varNachWährung & "' order by Währungsschlüssel DESC", "FMZOLL")
End If
'
'Select Case TypeName(fldVonWährung)
' Case "Integer"
' varVonWährung = fldVonWährung
' Case "String", "Textbox", "Field", "Field2"
' varVonWährung = SQL.DLookup("[Währungsschlüssel]", "Währungstabelle", "[Währungscode] = '" & fldVonWährung & "'", "FMZOLL")
' If varVonWährung = "" Then
' MsgBox("Währungstabelle![Währung] enthält keinen Eintrag " & fldVonWährung, , "fktEuro")
' fktEuro = Nothing
' Exit Function
' End If
' Case Else
' MsgBox("Datentyp " & TypeName(fldVonWährung) & " ist für fldVonWährung ungültig.", , "fktEuro")
' fktEuro = Nothing
' Exit Function
'End Select
'Select Case TypeName(fldNachWährung)
' Case "Integer"
' varNachWährung = fldNachWährung
' Case "String", "Textbox", "Field", "Field2"
' varNachWährung = SQL.DLookup("[Währungsschlüssel]", "Währungstabelle", " [Währungscode] = '" & fldNachWährung & "'", "FMZOLL")
' If varNachWährung = "" Then
' MsgBox("Währungstabelle![Währung] enthält keinen Eintrag " & fldNachWährung, , "fktEuro")
' fktEuro = Nothing
' Exit Function
' End If
' Case Else
' MsgBox("Datentyp " & TypeName(fldNachWährung) & " ist für fldNachWährung ungültig.", , "fktEuro")
' fktEuro = Nothing
' Exit Function
' End Select
'If varVonWährung = varNachWährung Then ' Sind beide Währungen gleich,
' fktEuro = varBetrag ' ist keine Umrechnung erforderlich
' Exit Function ' und die Funktion wird beendet
'End If
If varVonWährung <> 900 Then ' Eingangswährung in Euro umrechnen.
varKurs = SQL.DLookup("[Eurokurs]", "Währungstabelle", "[Währungsschlüssel] = " & varVonWährung & " order by Währungsschlüssel DESC", "FMZOLL")
If varKurs = "" OrElse varKurs = 0 Then
MsgBox("(1) Die Währungstabelle enthält keinen Umrechnungskurs für den Währungsschlüssel " & varVonWährung, , "fktEuro")
fktEuro = Nothing
Exit Function
End If
varBetrag = Int(varBetrag / varKurs * 100 + 0.5) / 100
End If
If varNachWährung <> 900 Then ' Euro In Ausgangswährung umrechnen.
varKurs = SQL.DLookup("[Eurokurs]", "Währungstabelle", "[Währungsschlüssel] = " & varNachWährung & " order by Währungsschlüssel DESC", "FMZOLL")
If varKurs = "" OrElse varKurs = 0 Then
MsgBox("(2) Die Währungstabelle enthält keinen Umrechnungskurs für den Währungsschlüssel " & varNachWährung, , "fktEuro")
fktEuro = Nothing
Exit Function
End If
varBetrag = Int(varBetrag * varKurs * 100 + 0.5) / 100
End If
fktEuro = varBetrag
End Function
Public Shared Sub SetDoubleBuffered([Control] As Control)
[Control].GetType().InvokeMember("DoubleBuffered", BindingFlags.SetProperty Or
BindingFlags.Instance Or BindingFlags.NonPublic, Nothing, [Control], New Object() {True})
End Sub
Public Shared Function fktEuroKurs(varVonWährung As Object, Rechnungsdatum As Date) As Object 'Funktioniert nciht mit datum!!!!!!!!!!!!!!!!!!!
'(FixeTaxe, "ATS", RECHNUNG.Währungscode)
'Dim varVonWährung As Object
'Dim varNachWährung As Object
Dim varKurs As Object
If varVonWährung Is Nothing Then Return Nothing
If varVonWährung = "EUR" Then ' Sind beide Währungen gleich,
Return 1 ' ist keine Umrechnung erforderlich
Exit Function ' und die Funktion wird beendet
End If
If Not IsNumeric(varVonWährung) Then
varVonWährung = SQL.DLookup("[Währungsschlüssel]", "Währungstabelle", "[Währungscode] = '" & varVonWährung & "' order by Währungsschlüssel DESC", "FMZOLL")
End If
Dim varBetrag = 1
If varVonWährung <> 900 Then ' Eingangswährung in Euro umrechnen.
varKurs = SQL.DLookup("[Eurokurs]", "Währungstabelle", "[Währungsschlüssel] = " & varVonWährung & " order by Währungsschlüssel DESC", "FMZOLL")
If varKurs = "" OrElse varKurs = 0 Then
MsgBox("(1) Die Währungstabelle enthält keinen Umrechnungskurs für den Währungsschlüssel " & varVonWährung, , "fktEuro")
fktEuroKurs = Nothing
Exit Function
End If
varBetrag = Int(varBetrag / varKurs * 100 + 0.5) / 100
End If
fktEuroKurs = varBetrag
End Function
Public Shared Function spireLoadLicense() As Boolean
Try
''Nicht notwendig --> license.elic hat beide drinnen.
'Spire.License.LicenseProvider.SetLicenseKey("MkctkXG06cMhlK6LAQCVDXFpzaLd8k9flTIXzX2vqnaj15/RjBiXqzJFPI5Ay0WJO+ng6Fwgb1s0Owoicm6acvP5dL8R/rHMlEAIQmWgY231zrrzVcbfujmJLyeYq1bwdbZY8vAtegSo3uhg8MruQ0NwF8OwrmrRTQzW8VkBRePb6jhCAWqMyr4Ho/d06JN3ngF3ulN/aNkFIWTHBvPG+M0CWuhudGhNtyDcnWPHDHm1+qigpwwnh69s8A4romdnSDQpFa2/LG5KAzwVmcjKSfVZs6e497ydRBFpggoe8d4J0FnRW//ROJOraTklVBMcGNZm9plWQvA23wxAhaVQHPINx/ecdTb9NIAeQajYyghx/tA+XVQ5uessceZW4LWZ4cnq6nhsBS4Y6oZ76/pHw1cUSfOHFCVi++X+2JYatsUJcAn2QXM6qpul7MpKCdDtT+yE94umhllKK7oBA8TMVFntgRfSZU+fftgMB+Nrs91UqM52OQsM4f0Q/dQvLGL/gr7NYE7QBQRV8ersUHls2s/7NHJ1VSoXKO9bghFaqzWoMGJ1UM/DvgdMg+URo6F9yanH4dEv8XDpTgx82f4pwncquCZJoPTdlXVhF4mK6/euo5Od3pmO9ZTqY+DxNwpgBIvkWTTvZiqkq4aDhNR5fhoihtAIWDiaHxMhlXxKTeK8z6n3puusWs0ZcXXaXb1jfUi7L9v8tWavr7Kag89coCXv7q5ejJ+mxTH9N6wIA029crL1+xyWSMOIaU6Iav8nrro5Xhdt14abW+458iqjVQRL1l6ZUkZjXaJHjoqy1aKg1OafFAGjULuOp8ozBJwQbRD0y5czx60NFjKlxR01SrfMrHV8uCjJXWm4BquAQPlHq6gfqSdXjmv/ZgKiKnXu+2FelPHK96IRK+y+pSv0hUx9JJ+9zL0JdAdwKmm2rRGk2KTKKfJ8jB+FdTpp61ecYsM2XB+GqZvLgJx6DUFklevpLG8XuKxcJFJGyAEhUzeUYhjUv60gSRKKAs8XlOmP35fBP2Gd2X6H1cUJFEdam62dDnE9ZBRyBlwA2n7iFav3s7+PzSuEACBG8R1nky52Ye9qE6zM8Plw0boPIoOueKYQIO+9wDLZyhHYjwc/6h3snP76tjsra7IS1c0Yx/P2lMx8C9LogL4c7Hyo7DH/bmn7Kx1C3eYH7IMY2uXoRfJ2tEtJ8MxvD1Xm4ZU1rL/BWpiwTi2rHNl/ikBteyZ7D4YlfoiEpB7P4UksR/SLYS1gpmeh3py7dQytQg8tfq7Ylyn+4umppvhi2ZBhJKElo7DdRegYofwM4XZW5eyWV0Qq7WoBs7YGwq0SHcuUEsgq9mW3j4a7g5/kuTkZSXxVXFKmYEHo+CLJvcbyeWrYeSfgdWd914iiNOzCo/mufmYsOxndMUCUEv9DeKS/zIu7OKM0OIE1O62kt7rBfRyJ5tLcoPKhCaU2y2sa4bsw59YAXq09Maj136qUjLiOfyROIvxlQ30zaydZnn/pqoseHtklySmgCnbO2uQ2vl5RHnv0AbOT7UgLFmQv4x3HL2M5ezEW+3POA1OuEW/TlAvMiaE=")
'Spire.License.LicenseProvider.LoadLicense()
'Spire.License.LicenseProvider.SetLicenseKey("DqgBAA7OVWqLrl0/vKFRQ3B4fULEZEi+uN7wMgS475TeA6kOemBFjzZEG9fkW/Bgn5JDj2f9fGF9/QZ3jnik3iDgvDkaWO3yrb0V+5OaXxviTkoSVmCxzBNhsfNre2Q9BkETcd3DCYew7psFTdQvVKTtugehhx5bhxitSH6q16Vvdma8/EvVg7dsYajEq+Bjxi5Ibe5Q3po5SnZBnvrbegroXy34zuauqFiKnuaIdSFlmqjuf59veZvss6mIqSZSW9IsyfyKRjLupvFZcsH5yKPOuzmoL00KQ2OqxToVvD45IEUEvjNqdWeUKLPx/JVgaV3RmsxqPWd9Bm6zb7h04OBOKNVRtSSmjX2KnBRXdQgXfSGF1uIDlvLNtpD5AOYxKPOIfJ/AFxi9m8pYKnzqSMbpaxxlOqy9Y03EXkrko3SOzhyg+k6ZyebbqMrzeOzJ7f5cl9TfttlADwnoLa42No35+xkYI3tF/kALsrWWGcVsUWK78cg2w2s79y4ERBbgZlbYqVpdsOyKBO7k1ujA83J2MUYfoSydNivNYM05Ll1UJzbMY0sxb6HGWwVHl3t7aVwioZbmonI90fmrZpfjrpkzlL0MvjY5LxL1JXcv5xJ/oXaLN/q1GxCuFvSDroV3uKRbGhonGmTroQpp7AMFoah8Bg+glLFL2ibSoJ16dlvmxwBuZM0uDMCMfJhsFRSEzUEHbX0gv8MTNC3ROmM81Rrm7klfKrsJD3FrBlf13q6yIpxo+qp0/AgkovpjsBv8y8dxEJs37C0PHcvkCr/kA0HDDTH+Rstx8EelQzOv5dcr6CgW1VWW3+dyPjHjADlRPXd+bo+gquT6NMezbQOUdm3wMNbpCQ/qwcZ5bzEXGmdhWcEs/Z+QmXRJvhBbEf3WQrlLSuzVIooL/nXo5MG8XooWPZHURz1g92vvqA2H6FU+DLJkiNp/OI5Xzp0NNqhOubcSX70noHx7SdgQrnAIGZtE90/MzLBPFZMIv1yjaDyoZsTA3nSatae4w7PvN6cXtacLZl5GnAJIRxlmjR+OvwbfXhAcbVeNYtRYXhExR9B4fxKp8/eXZorvzW7yFH8cSopnqSjmw6ywqx0u2upOuuNeGp5/kMP4QC+SMRruXWQM46Ed168OaU1GJ0PpHr+W2EWZLbqqNhrYct1FpOnVxJjA90DOKsbXFzbLGC83YgZdVo9AAIzMYu8RIhbn6ACJQlC+d9nn0S/wZPtX+PUZK1ACCCDdfm/0jwvUEb8Us2pWn6qA/ZHtkk4a/iII8F9hrDMVOQYJBJQ/IPnyJneHfqjtfB/Hw/1/KdHJYnyWg5KXaZWz+Ut4Vc48ZJCt3B6Izaf2wD68iYaDeemnJAFI3OcsjAzNx54kxs5VBJ4VtsFYPMN3SnovtfEVis3mLlKqzy0EdTOOIm0ZkgxCDHS3KogjOp2SI0kvAxxD1jE1IOKpgLkRo6mfjCzjS6RmZ/vBoBbx1OGqqxUlkD+2TyfQUGggoEX8XtYykiVoMuVUdikUQtHP12gq2aYzS9rKpaIINaEpcqU+vQlIumrlsL2MFIdvcdTEBhfoPtq4j9GZkOY=")
'Spire.License.LicenseProvider.LoadLicense()
' Exit Sub
'wegen Problemen die extra Aktivierung pro Lizenzkey wieder eingebaut.
Spire.PdfViewer.License.LicenseProvider.ClearLicense()
Spire.PdfViewer.License.LicenseProvider.SetLicenseKey("PxZCqGgHjS0Z4zNNAQDYLGI8+G/4QDVnRpJiYlpVAqRX+ha8wFRosyGISZ5CPT3vynGVEGAvrIGhSkRoenn1mCFwM2ENrXh6RbuSldb6QQBTrKEI3cFhMH0tdzCDazkOkVXwO72bqBRE45Z1DHfTBejGcWnZXdI52fSI0EdLNX6tFU5NxSYrU0EsFHpN8jWoTGwnLPSXHLdhQ284JnkMl8WLbJDzphene90MyxglJxhaq2SQ2FMe/NE7TtsJR5rtFQw8G7RlQMY/hfIKGoU0jVYtHprlw7bL/eZM9krw3MgxbbD5fUsWO33XwM2Fl2Omjp7FNHRVLhQtUWjOdi8rV5QEq+jmv5qMIhlxtOIc4QiPySo44++s08pVN5cthZaG033EbLiJAwi8JbY1G2Ms37sFH3kr0ldz5m4fjDrldgdq1NYe8yoTEuFg6fBJxSJ0HIMkBkjPBaptgEgdZP+heowTknRg9seErhwmQy+MLc4GjCnjOxkzvLoTYqatfq8u9abaVd5EegYgzZR0t1OfanDv765Rp+kEFgvkBzHWn55Pw1KghVG0xfd5E7+mGx6560Y4z5oTFyDLldORXgFp9/K4f80pb9/jIHSDemB8x0Ed3YlBxuTmZLHgcXPwVHc/UZiNsN0A3uWZB2GqgZWpY4ICWayb5ZghqOyHiKYZTdCxtCsOWf+9TwKDvgPXqdx0swdwa7IEIjxNUzCWq0rAtcyiN8XpH1fZZVONPJ5Zhyl4dib/bnCez6VfrwUFuKZF6NKskMWgCx393B2HGN+5N1ce5WiABot0dz4SinrRH70qrHSvSzAfeWS3vxRCu9XY5iO48voTzHLcJ0yBD+Vvz3o8TYOYmgCyI663zoAI3BLtdCKPBFEa1htZESQwB1bA2MGYpfikoA6ssKMRAzBR2Z+9JNCgYv7vMcrac6Cn9N1+IpnJmUBB+OHfLLLlqKVud0Rlpe2NGXD66QLjHZZsvIuZ0XZamg7mw2eSEGQO/GZjvAtdjzAXP3lpMT9ZPUctCGUeJboSLITik4Z/JABqIwiMLJ0t75o2AryhjhAy5po6fM3Xng97BJ3e9WN6EmpZxxJDCvtOBo7aUMceqsfYWt4/ubHhag/FnP+3bvzFPmFHjy6gyvWVh0evgDtcs8TeI8DbTfEWzcB1DRxAIPK9hyEq6Bc52DxzS0FppzAp8LLvVIwa0NlG/ey4sT8LOg2mwVoZxQHliej2B2sRnzA481Vcpaxs0jiN6s7fBOepyx4wgjJPFcl45RQVht/kqBQXPQ94V1WqOuDzTZT+lS7thxO2LwyMZtTSUn3soecmuLsZJFgIABw9s6u/GEtyt+8M8K/41a/mQqwCTGXBFZsnmYTkWM1OIURc3848P0CzJraWuZhOjgbADJhiP6DRaEU6AW95bQzPAcELvrDhURBwC4vsYcWLFtuKuNzKbArHb9megBYrnjqwnbO3/XqiH1HyBYqbfN7Jn0mS3QbTzMNoGVOjmpxWnjK5tm8TQnopT2k+1lQ9W8slj0RgAX/h7s4qSpTkl1hWYjoY/6MzURxpcJWuxRS2gd8cWmp7TnB4DXBhjH3Gfqhp7IXoTvDWIV+/")
Spire.PdfViewer.License.LicenseProvider.LoadLicense()
Spire.Pdf.License.LicenseProvider.ClearLicense()
Spire.Pdf.License.LicenseProvider.SetLicenseKey("H+L0V/UZAQAvjnENiqh4GJWlFzzfcxZc+pOA5cYh4RfLjFGHfYAaT0E6wK2A0nBI8H7P71m+C+huUWVSKLQllk0/SfP8S6Ct4tv0SYlBL4Y/MtnVg5mm9Wn4NNIRRzPbGnH5I0xTFZVurffXte14YiUxvoNDkoY9AtZPyxJqiFzQ//etqxSNs68OBHQqQ13iBRBt8N8dS6naLe8TpkDoGvSpBmeOOkGGwVH9SzQV+FVc9cQn8j1P8yra+yMSESwlLQkeLkn4T17utlhs5STs/Lc5IlO64Fb1EuhLASSaaqVX3MsMJPr8G8a0TU4chSDGAJcRhgSX57TYLhYywo8meDdMa3hKi466w2CQ9eiphAjWbIeu1gdsiRtdOkxhhczUUyqWSAn7ju3paTI0TZfK8tLI4lwcBWso5sBkAfWGPPeybCQDsyPmnxEjwF+5n4zSt/jVtQvAiWB2GOHBAHBS/zcYVWoDN8oAGgy5rjH2bGjV0E506/8jG9mlpfJMlPhZSEw3iab14wIOXX/Koijl/pykzZ/TTw+5RrOvIKxriq8ADiP+pbUNAp16TKlvEUiGc9fWQsQ3+a7kObnst4jVoo98jXSC9oeWzFGWLclUHkaUIvQYaoieCxzzLzqOSl8NFjILhQ/Ew7YCUrEAu947qyHH8LYURRGjQGlCEnmD68eNRIXRT39jMrKCsHlhOjvZnJzO9+oJ2yTxcatzsClBccPjix2cuEFb/qmzUvA+0ElSfJfwXhLjWGxc7m11bbGADVvj5uVtZAfMbI8ifECiuRfXcNME+X7ErgP8lRyh9tTkAkmwrso3obUwgCvcMRvqE3w0D4oPJegHmhyShzd3b1zss+8cvyo68sfXotPePD1neJGSM4XWmZrZJeNNe8F+x86sMqMmYBAqkybA13gW01pmHYE/fPte1TKNJz5O8tMujcxdlm/7C6vO+o6Tyh3EIdQ3P2Wu5BjxWbtcvQHVhLXv3F6dbouXyrueOPW/MQrug1pBinxoE5xCLFbU1nWUdDH6/mQJGRRVK7Tm/oEFMGhM6xXBC74udg0VPdPhSsRXIM2B1TNKiBSmaUFWyPlrdaUqxvFIitWRYc5uRKFSdxKbpzpbq9T0g3pxfdqkq4cLd4ZWK450Eh07szHcYiTYwRqLLHWjgVF8EIzNvpT51XCFEv6bmxW6HiaONZ+Vh8NsnchIdMuQOCGRB8hU/x1JK8culq8msO+J0ArhF8E5zXN3EgWpcAMMCeEiCeNf9Wyh1axxxFHzIRsYoIb85XnUyPJakgT2J3uWRCyikg4yqWbxWboO4dM1IjtbirVYeQrlzGk7AkWjC5IGe5bTVUOU2AMi+AH5zi2cxEmcZS1NrNOIdiaDkYYVp6I5nd0Xt5sCP765xRoXuxKv+SCQEUwVIDjUi1IkRPbjq5rBRXcJZ8UI5myMjPTU3zXvw+gpJHajfP1Fx13nRwN0ffCafBLGmMoZNOUtAT9xAjBfdYyR2ukQDbxnj+d2+R6j2RFHHiNcNs+8x0o9hmIW+iuwf6q3hzfqVLi4l+G/3F+awlFRQfF7huYpzfg0mg+6CGry4cfg3lw23k5GzX6bZ2fQF8Rk")
Spire.Pdf.License.LicenseProvider.LoadLicense()
'Spire.PdfViewer.License.LicenseProvider.SetLicenseFileName("licensePDFViewer.elic.xml")
'Spire.PdfViewer.License.LicenseProvider.LoadLicense()
'Spire.Pdf.License.LicenseProvider.SetLicenseFileName("licensePDFPro.elic.xml")
'Spire.Pdf.License.LicenseProvider.LoadLicense()
'Spire.Pdf.License.LicenseProvider.SetLicenseFileName("license.elic.xml")
'Spire.Pdf.License.LicenseProvider.LoadLicense()
Return True
Catch ex As Exception
VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex.Message, ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name)
Return False
End Try
End Function
Public Shared Function genCSVFromDT(dt As DataTable, Optional openCSV As Boolean = False, Optional showColumnName As Boolean = True, Optional optFileName As String = "") As String
Try
Dim sPath As String = Environment.GetFolderPath(Environment.SpecialFolder.Personal) & "\VERAG\SDL\tmp\" ' My.Computer.FileSystem.GetTempFileName
If Not My.Computer.FileSystem.DirectoryExists(sPath) Then
My.Computer.FileSystem.CreateDirectory(sPath)
End If
Dim txt As String = ""
If showColumnName Then
Dim line As String = ""
For Each column As DataColumn In dt.Columns
'Add ColumnName
line += ";" & column.ColumnName.Replace(";", ",")
Next
'Add new line
txt += line.Substring(1) & vbCrLf
End If
For Each row As DataRow In dt.Rows
Dim line As String = ""
For Each column As DataColumn In dt.Columns
'Add the Data rows.
line += ";" & row(column.ColumnName).ToString().Replace(";", ",").Replace(vbNewLine, "").Replace(vbCr, "").Replace(vbLf, "").Replace(vbCrLf, "").Replace(System.Environment.NewLine, " ")
Next
'Add new line
txt += line.Substring(1) & vbCrLf
Next
Dim endung = ".csv"
Dim filename As String = ""
If optFileName <> "" Then
filename = sPath & optFileName & endung '".xlsx"
While System.IO.File.Exists(filename)
filename = sPath & optFileName & Now.ToString("ddMMyyyyHHmmss") & endung '".xlsx"
End While
Else
filename = sPath & "tmp_" & Now.ToString("ddMMyyyyHHmmss") & endung '".xlsx"
While System.IO.File.Exists(filename)
filename = sPath & "tmp_" & Now.ToString("ddMMyyyyHHmmss") & endung '".xlsx"
End While
End If
Using sw As StreamWriter = New StreamWriter(filename, False, System.Text.Encoding.UTF8)
sw.WriteLine(txt)
End Using
If openCSV Then Process.Start(filename)
Return filename
Catch ex As Exception
VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex.Message, ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name)
Return Nothing
End Try
End Function
Public Shared Function genExcelFromDT_NEW(dt As DataTable, Optional rangeAsWaehrung() As String = Nothing, Optional ShowAutoFilter As Boolean = True, Optional HeaderTxt As String = "", Optional HeaderTxt2 As String = "", Optional openPDF As Boolean = True, Optional optFileName As String = "", Optional endung As String = ".xlsx", Optional autoAdjust As Boolean = True) As String
Try
Dim sPath As String = Environment.GetFolderPath(Environment.SpecialFolder.Personal) & "\VERAG\SDL\tmp\" ' My.Computer.FileSystem.GetTempFileName
If Not My.Computer.FileSystem.DirectoryExists(sPath) Then
My.Computer.FileSystem.CreateDirectory(sPath)
End If
Dim wb As New XLWorkbook
' Dim dt As DataTable = (dgv.DataSource)
' Dim dt As DataTable = TryCast(dgv., DataTable)
wb.Worksheets.Add(dt, "DATEN")
wb.Worksheets(0).Tables.FirstOrDefault().ShowAutoFilter = ShowAutoFilter
If rangeAsWaehrung IsNot Nothing Then
For Each r As IXLRangeAddress In rangeAsWaehrung
Try
wb.Worksheets(0).Range(r).Style.NumberFormat.SetFormat("###,###,##0.00 €")
Catch ex As Exception
VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex.Message, ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name)
End Try
Next
End If
If HeaderTxt <> "" Then
wb.Worksheets(0).FirstRow.InsertRowsAbove(2)
wb.Worksheets(0).Range("A1").Value = HeaderTxt
wb.Worksheets(0).Range("A1").Style.Font.Bold = True
If HeaderTxt2 <> "" Then
wb.Worksheets(0).Range("A2").Value = HeaderTxt2
wb.Worksheets(0).Row(2).InsertRowsBelow(1)
End If
End If
If autoAdjust Then
'Spaltenbreite auto:
wb.Worksheets(0).Columns().AdjustToContents()
End If
Dim filename As String = ""
If optFileName <> "" Then
filename = sPath & optFileName & endung '".xlsx"
While System.IO.File.Exists(filename)
filename = sPath & optFileName & Now.ToString("ddMMyyyyHHmmss") & endung '".xlsx"
End While
Else
filename = sPath & "tmp_" & Now.ToString("ddMMyyyyHHmmss") & endung '".xlsx"
While System.IO.File.Exists(filename)
filename = sPath & "tmp_" & Now.ToString("ddMMyyyyHHmmss") & endung '".xlsx"
End While
End If
wb.SaveAs(filename)
If openPDF Then Process.Start(filename)
Return filename
Catch ex As Exception
VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex.Message, ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name)
Return Nothing
End Try
End Function
Public Shared Function sendMail(eMailTo, betreff, text, Optional eMailfrom = "support@verag.ag", Optional prio = False, Optional uhrzeitAngeben = True, Optional cc = "", Optional bcc = "", Optional anhaenge = Nothing, Optional art = 0)
Dim Msg As New MailMessage
Dim myCredentials As New System.Net.NetworkCredential
Msg.IsBodyHtml = True
Dim mySmtpsvr As New SmtpClient()
Select Case VERAG_PROG_ALLGEMEIN.cAllgemein.FIRMA
Case "IMEX"
myCredentials.UserName = "support@verag.ag"
myCredentials.Password = "$up0Rt2809!"
mySmtpsvr.Host = "owa.verag.ag"
mySmtpsvr.Port = 587
Case "ATILLA"
myCredentials.UserName = "support@verag.ag"
myCredentials.Password = "$up0Rt2809!"
mySmtpsvr.Host = "owa.verag.ag"
mySmtpsvr.Port = 587
Case "AMBAR"
Select Case art
Case "3", "4" 'Export
myCredentials.UserName = "office@ambarlog.de"
' myCredentials.Password = "Naq30716"
' myCredentials.UserName = "import@ambarlog.com"
myCredentials.Password = "Naq30716"
mySmtpsvr.Host = "owa.verag.ag" '"smtp.office365.com" -> office365 deaktiviert!
mySmtpsvr.Port = 587
'mySmtpsvr.EnableSsl = True
'text = text.replace("import@ambarlog.com", "office@ambarlog.com")
'text = text.replace("import@ambarlog.de", "office@ambarlog.com")
eMailfrom = "office@ambarlog.de"
Case Else
' myCredentials.UserName = "import@ambarlog.com"
'myCredentials.UserName = "import@ambarlog.de"
'myCredentials.Password = "Meh062020"
'mySmtpsvr.Host = "smtp.office365.com"
'mySmtpsvr.Port = 587
'mySmtpsvr.EnableSsl = True
myCredentials.UserName = "import@ambarlog.de"
myCredentials.Password = "Meh062020"
mySmtpsvr.Host = "owa.verag.ag"
mySmtpsvr.Port = 587
' mySmtpsvr.EnableSsl = True
' eMailfrom = "import@ambarlog.com"
End Select
Case "UNISPED"
myCredentials.UserName = "no-reply@unisped.at"
myCredentials.Password = "GL5unisped!KNL3"
mySmtpsvr.Host = "owa.verag.ag"
mySmtpsvr.Port = 587 '25 '587 '25
Case Else
myCredentials.UserName = "support@verag.ag"
myCredentials.Password = "$up0Rt2809!"
mySmtpsvr.Host = "owa.verag.ag"
mySmtpsvr.Port = 587 '25 '587 '25
End Select
mySmtpsvr.UseDefaultCredentials = False
mySmtpsvr.Credentials = myCredentials
Try
'Msg.BodyEncoding = System.Text.Encoding.GetEncoding("UTF-8")
Msg.BodyEncoding = System.Text.Encoding.GetEncoding("ISO-8859-1")
Msg.From = New MailAddress(eMailfrom)
If eMailTo IsNot Nothing Then
For Each s In eMailTo.ToString.Split(";")
If s <> "" Then Msg.To.Add(convertToIso(s).ToString.Trim())
Next
End If
If cc IsNot Nothing Then
For Each s In cc.ToString.Split(";")
If s <> "" Then Msg.CC.Add(convertToIso(s).ToString.Trim())
Next
End If
If bcc IsNot Nothing Then
For Each s In bcc.ToString.Split(";")
If s <> "" Then Msg.Bcc.Add(convertToIso(s).ToString.Trim())
Next
End If
Msg.Subject = betreff '"ERROR - DAKOSY Einarbeitung"
If uhrzeitAngeben Then
Msg.Body &= "Zeitpunkt: " & Now.ToShortDateString & " " & Now.ToShortTimeString & "<br><br>"
'Msg.Body &= vbNewLine & vbNewLine
End If
Msg.Body &= text
If prio Then Msg.Priority = MailPriority.High
If anhaenge IsNot Nothing Then
For Each aa In DirectCast(anhaenge, List(Of String))
If aa IsNot Nothing AndAlso aa <> "" Then Msg.Attachments.Add(New System.Net.Mail.Attachment(aa))
Next
End If
Catch ex As Exception
Try
VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR("MAIL ERROR - VOR SENDEN" & ex.Message, "TO: " & eMailTo & vbNewLine & "SUBJ: " & betreff & vbNewLine & "TXT: " & text, ex.StackTrace, System.Reflection.MethodBase.GetCurrentMethod.Name, VERAG_PROG_ALLGEMEIN.ERROR_OP.MAIL)
Catch ex2 As Exception
VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR("MAIL ERROR - VOR SENDEN LOG! " & ex2.Message, "TO: " & eMailTo & vbNewLine & "SUBJ: " & betreff & vbNewLine & "TXT: " & text, ex2.StackTrace, System.Reflection.MethodBase.GetCurrentMethod.Name, VERAG_PROG_ALLGEMEIN.ERROR_OP.LOG)
End Try
End Try
'Prüfen, ob Empfänger angegeben:
If Msg.To.Count = 0 And Msg.CC.Count = 0 And Msg.Bcc.Count = 0 Then
VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR("Kein Empfänger!", "TO: " & eMailTo & vbNewLine & "SUBJ: " & betreff & vbNewLine & "TXT: " & text, System.Reflection.MethodBase.GetCurrentMethod.Name, VERAG_PROG_ALLGEMEIN.ERROR_OP.MAIL)
Return False
End If
'Msg.To.Clear()
'Msg.CC.Clear()
'Msg.Bcc.Clear()
'Msg.To.Add("al@verag.ag")
Try
'SENDEN::::::::::::::::::::::
'Dim mailItem As Outlook.MailItem = TryCast(Msg, Outlook.MailItem)
' mailItem.Display()
mySmtpsvr.Send(Msg)
Catch ex As Exception
Try 'Falls Fehler nicht beim Senden, sonder was anderes.
VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex.Message, "TO: " & eMailTo & vbNewLine & "SUBJ: " & betreff & vbNewLine & "TXT: " & text, ex.StackTrace, System.Reflection.MethodBase.GetCurrentMethod.Name, VERAG_PROG_ALLGEMEIN.ERROR_OP.MAIL)
Catch ex3 As Exception
End Try
Try
mySmtpsvr.Port = 25
mySmtpsvr.Send(Msg)
Catch ex2 As Exception
If VERAG_PROG_ALLGEMEIN.cAllgemein.FIRMA = "UNISPED" Then ' ERST DEN SERVER EINRICHTEN!
Return False
End If
Try
mySmtpsvr.Host = "192.168.0.69"
mySmtpsvr.Port = 25
mySmtpsvr.Send(Msg)
Catch ex3 As Exception
MsgBox(ex3.Message & ex3.StackTrace & vbNewLine & vbNewLine & "TO: " & eMailTo & vbNewLine & "cc: " & cc & vbNewLine & "bcc: " & bcc)
Return False
End Try
End Try
End Try
Return True
End Function
Shared Function getISO2Land(LandKz As String)
If LandKz Is Nothing Then Return Nothing
Dim sqlstr = "SELECT TOP 1 isnull([Länderverzeichnis für die Außenhandelsstatistik].LandKz,'') AS LandKzISO2 FROM [Länderverzeichnis für die Außenhandelsstatistik] LEFT JOIN Währungstabelle ON [Länderverzeichnis für die Außenhandelsstatistik].LandNr = Währungstabelle.Währungsschlüssel WHERE Währungstabelle.LandKz='" & LandKz & "' "
Dim SQL As New VERAG_PROG_ALLGEMEIN.SQL
Return SQL.getValueTxtBySql(sqlstr, "FMZOLL")
End Function
Shared Function getISO1Land(LandKz As String)
Dim sqlstr = "SELECT TOP 1 isnull(Währungstabelle.LandKz,'') AS LandKzISO1 FROM [Länderverzeichnis für die Außenhandelsstatistik] LEFT JOIN Währungstabelle ON [Länderverzeichnis für die Außenhandelsstatistik].LandNr = Währungstabelle.Währungsschlüssel WHERE [Länderverzeichnis für die Außenhandelsstatistik].LandKz='" & LandKz & "' "
Dim SQL As New VERAG_PROG_ALLGEMEIN.SQL
Return SQL.getValueTxtBySql(sqlstr, "FMZOLL")
End Function
Shared Function convertToIso(s) As String
Return s
Dim converted As Byte() = Encoding.Convert(Encoding.UTF8, Encoding.GetEncoding("iso-8859-1"), s) 'Encoding.Convert(Encoding.UTF8, Encoding.GetEncoding("iso-8859-1"), s)
Return converted.ToString
End Function
Public Shared Sub sendMailTEST(eMailTo, betreff, text, Optional eMailfrom = "support@verag.ag", Optional prio = False, Optional uhrzeitAngeben = True)
Dim Msg As New MailMessage
Dim myCredentials As New System.Net.NetworkCredential
myCredentials.UserName = "support@verag.ag"
myCredentials.Password = "$up0Rt2809!"
Msg.IsBodyHtml = True
Dim mySmtpsvr As New SmtpClient()
mySmtpsvr.Host = "owa.verag.ag"
mySmtpsvr.Port = 25 '587 '25
mySmtpsvr.UseDefaultCredentials = False
mySmtpsvr.Credentials = myCredentials
Try
Msg.From = New MailAddress(eMailfrom)
Msg.To.Add(eMailTo)
Msg.BodyEncoding = System.Text.Encoding.GetEncoding("ISO-8859-1")
Msg.Subject = betreff '"ERROR - DAKOSY Einarbeitung"
If uhrzeitAngeben Then
Msg.Body = "Zeitpunkt: " & Now.ToShortDateString & " " & Now.ToShortTimeString & "<br><br>"
'Msg.Body &= vbNewLine & vbNewLine
End If
Msg.Body &= text
If prio Then Msg.Priority = MailPriority.High
mySmtpsvr.Send(Msg)
Catch ex As Exception
Try
mySmtpsvr.Host = "192.168.0.107"
mySmtpsvr.Send(Msg)
Catch ex2 As Exception
VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex.Message, ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name)
End Try
End Try
End Sub
Public Shared Function getFilePathTypeValid(filePath) As String
Dim Typ = ""
If filePath <> "" Then
Dim fi As New FileInfo(filePath)
Dim filename = fi.Name
Select Case fi.Extension.ToString.Replace(".", "").ToUpper
Case "PDF" : Typ = "PDF"
Case "XLS", "XLM", "XLSM", "XLSX", "CSV" : Typ = "EXCEL"
Case "DOC", "DOCX" : Typ = "WORD"
Case "TXT" : Typ = "TEXT"
Case "JPEG", "JPG", "GIF", "TFF" : Typ = "BILD"
Case "EXE" : MsgBox("Aviso-Anhänge: Ungültiges Datei-Format!") : Return False
Case Else : Typ = "SONSTIGES"
End Select
End If
Return Typ
End Function
Shared Function EmAilAttach(e As DragEventArgs) As String
Try
' We have a embedded file. First lets try to get the file name out of memory
Dim theStream As System.IO.Stream = CType(e.Data.GetData("FileGroupDescriptor"), System.IO.Stream)
Dim fileGroupDescriptor(512) As Byte
theStream.Read(fileGroupDescriptor, 0, 512)
Dim fileName As System.Text.StringBuilder = New System.Text.StringBuilder("")
Dim i As Integer = 76
While Not (fileGroupDescriptor(i) = 0)
fileName.Append(Convert.ToChar(fileGroupDescriptor(i)))
System.Math.Min(System.Threading.Interlocked.Increment(i), i - 1)
End While
theStream.Close()
' We should have the file name or if its an email, the subject line. Create our temp file based on the temp path and this info
Dim myTempFile As String = System.IO.Path.GetTempPath & VERAG_PROG_ALLGEMEIN.cDATENSERVER.replaceInvalidCahr(fileName.ToString)
' Look to see if this is a email message. If so save that temporarily and get the temp file.
If InStr(myTempFile, ".msg") > 0 Then
Dim objOL As New Microsoft.Office.Interop.Outlook.Application
Dim objMI As Microsoft.Office.Interop.Outlook.MailItem
If objOL.ActiveExplorer.Selection.Count > 1 Then
MsgBox("Es kann nur ein Element übertagen werden.", MsgBoxStyle.OkOnly Or MsgBoxStyle.Information, "Ein Element pro Vorgang")
End If
For Each objMI In objOL.ActiveExplorer.Selection()
objMI.SaveAs(myTempFile)
Exit For
Next
objOL = Nothing
objMI = Nothing
Else
' If its a attachment we need to pull the file itself out of memory
Dim ms As System.IO.MemoryStream = CType(e.Data.GetData("FileContents", True), System.IO.MemoryStream)
Dim FileBytes(CInt(ms.Length)) As Byte
' read the raw data into our variable
ms.Position = 0
ms.Read(FileBytes, 0, CInt(ms.Length))
ms.Close()
' save the raw data into our temp file
Dim fs As System.IO.FileStream = New System.IO.FileStream(myTempFile, System.IO.FileMode.OpenOrCreate, System.IO.FileAccess.Write)
fs.Write(FileBytes, 0, FileBytes.Length)
fs.Close()
End If
' Make sure we have a actual file and also if we do make sure we erase it when done
If System.IO.File.Exists(myTempFile) Then
' Assign the file name to the add dialog
EmAilAttach = myTempFile
Else
EmAilAttach = String.Empty
End If
Catch ex As Exception
VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex.Message, ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name)
EmAilAttach = String.Empty
End Try
End Function
Public Function MakeScreenshot()
Dim form As New Form
form = form.ActiveForm
Dim bounds As Rectangle
Dim screenshot As System.Drawing.Bitmap
Dim graph As Graphics
If form Is Nothing Then Return ""
bounds = form.Bounds 'Screen.PrimaryScreen.Bounds
screenshot = New System.Drawing.Bitmap(bounds.Width, bounds.Height, System.Drawing.Imaging.PixelFormat.Format32bppArgb)
graph = Graphics.FromImage(screenshot)
graph.CopyFromScreen(bounds.X, bounds.Y, 0, 0, bounds.Size, CopyPixelOperation.SourceCopy)
' PictureBox1.Image = screenshot
If Not My.Computer.FileSystem.DirectoryExists(My.Computer.FileSystem.SpecialDirectories.Temp & "\Screenshots_" & My.Application.Info.AssemblyName & "\") Then
My.Computer.FileSystem.CreateDirectory(My.Computer.FileSystem.SpecialDirectories.Temp & "\Screenshots_" & My.Application.Info.AssemblyName & "\")
End If
Dim cnt As Integer = 1
Dim strname As String = My.Computer.FileSystem.SpecialDirectories.Temp & "\Screenshots_" & My.Application.Info.AssemblyName & "\" & form.Name & "_" & Now.ToString("ddMMyyyy_HHmm_")
While System.IO.File.Exists(strname & cnt & ".bmp") : cnt += 1 : End While
screenshot.Save(strname & cnt & ".bmp")
Return strname & cnt & ".bmp"
End Function
Public Function TakeScreenShot(ByVal Control As Control) As Bitmap
Dim tmpImg As New Bitmap(Control.Width, Control.Height)
Using g As Graphics = Graphics.FromImage(tmpImg)
g.CopyFromScreen(Control.PointToScreen(New Point(0, 0)), New Point(0, 0), New Size(Control.Width, Control.Height))
End Using
Return tmpImg
End Function
End Class
Public Class SDL_Functions
Shared Function SDL_GueltigBis_UTA_IDS()
Dim SQL As New VERAG_PROG_ALLGEMEIN.SQL
Return SQL.doSQL("UPDATE SDL SET Archiviert=1 where SDLNr IN(212,100) AND (Archiviert is null OR Archiviert = 0) AND [GültigBis] is not null AND [GültigBis] < dateadd(month,-2,CAST(SUBSTRING(CAST((DATEADD(d,-DAY(GETDATE()),GETDATE()) + 1) AS BINARY(8)),1,4) + 0x00000000 AS DATETIME))", "SDL")
End Function
End Class