710 lines
38 KiB
VB.net
710 lines
38 KiB
VB.net
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 ThoughtWorks.QRCode.Codec
|
|
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 String 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 getISO2LandFromISO3Land(Iso3Land As String)
|
|
If Iso3Land Is Nothing Then Return Nothing
|
|
If Iso3Land.Length <> 3 Then Return Nothing
|
|
Dim sqlstr = "SELECT TOP 1 isnull(LandKz,'') AS LandKzISO2 from [Länderverzeichnis für die Außenhandelsstatistik] where LandKz_ISO_3 = '" & Iso3Land & "' "
|
|
Dim SQL As New VERAG_PROG_ALLGEMEIN.SQL
|
|
Return SQL.getValueTxtBySql(sqlstr, "FMZOLL")
|
|
End Function
|
|
|
|
Shared Function getISO2LandFromLandNr(LandNr As Integer)
|
|
If Not IsNumeric(LandNr) Then Return Nothing
|
|
If LandNr = 0 Then Return Nothing
|
|
Dim sqlstr = "SELECT TOP 1 isnull(LandKz,'') AS LandKzISO2 from [Länderverzeichnis für die Außenhandelsstatistik] where LandNr = '" & LandNr & "' "
|
|
Dim SQL As New VERAG_PROG_ALLGEMEIN.SQL
|
|
Return SQL.getValueTxtBySql(sqlstr, "FMZOLL")
|
|
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
|
|
|
|
|
|
Shared Function getQRCode(QRtext As String, Optional QZSize As Integer = 4, Optional QRVersion As Integer = 7, Optional CorrectionLevel As QRCodeEncoder.ERROR_CORRECTION = QRCodeEncoder.ERROR_CORRECTION.M, Optional encoding As QRCodeEncoder.ENCODE_MODE = QRCodeEncoder.ENCODE_MODE.BYTE) As Image
|
|
Dim qrCodeEncoder As QRCodeEncoder = New QRCodeEncoder()
|
|
|
|
qrCodeEncoder.QRCodeEncodeMode = encoding
|
|
|
|
Try
|
|
Dim scale As Integer = Convert.ToInt16(QZSize)
|
|
qrCodeEncoder.QRCodeScale = scale
|
|
Catch ex As Exception
|
|
MessageBox.Show("Invalid size!")
|
|
Return Nothing
|
|
End Try
|
|
|
|
Try
|
|
Dim version As Integer = Convert.ToInt16(QRVersion)
|
|
qrCodeEncoder.QRCodeVersion = version
|
|
Catch ex As Exception
|
|
MessageBox.Show("Invalid version !")
|
|
End Try
|
|
|
|
Dim errorCorrect As String = CorrectionLevel
|
|
|
|
qrCodeEncoder.QRCodeErrorCorrect = CorrectionLevel
|
|
Dim image As Image
|
|
Dim data As String = QRtext
|
|
|
|
|
|
qrCodeEncoder.QRCodeVersion = 0
|
|
|
|
' qrCodeEncoder.QRCodeEncodeMode = QRCodeEncoder.ENCODE_MODE.ALPHA_NUMERIC
|
|
qrCodeEncoder.QRCodeErrorCorrect = QRCodeEncoder.ERROR_CORRECTION.M
|
|
|
|
|
|
image = qrCodeEncoder.Encode(data, System.Text.Encoding.UTF8)
|
|
|
|
Return image
|
|
End Function
|
|
|
|
Shared Function getBARCODEAviso(AvisoID As String) As Image
|
|
Dim barcode As Image = Code128Rendering.MakeBarcodeImage("/" & AvisoID & "/", 1, True, 25)
|
|
' barcode.RotateFlip(RotateFlipType.Rotate90FlipNone)
|
|
|
|
Return barcode
|
|
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 |