Imports System.IO Imports System.Net.Mail Imports System.Text Imports System.Windows.Forms Imports ClosedXML.Excel 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 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 Sub spireLoadLicense() ''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() End Sub 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(";", ",") 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 IO.File.Exists(filename) filename = sPath & optFileName & Now.ToString("ddMMyyyyHHmmss") & endung '".xlsx" End While Else filename = sPath & "tmp_" & Now.ToString("ddMMyyyyHHmmss") & endung '".xlsx" While 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 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 IO.File.Exists(filename) filename = sPath & optFileName & Now.ToString("ddMMyyyyHHmmss") & endung '".xlsx" End While Else filename = sPath & "tmp_" & Now.ToString("ddMMyyyyHHmmss") & endung '".xlsx" While 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.com" ' myCredentials.Password = "Naq30716" ' myCredentials.UserName = "import@ambarlog.com" myCredentials.Password = "Naq30716" mySmtpsvr.Host = "smtp.office365.com" 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.com" 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 & "

" '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 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) 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:::::::::::::::::::::: 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 & "

" '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 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