297 lines
13 KiB
VB.net
297 lines
13 KiB
VB.net
Imports System.Net.Mail
|
|
Imports System.Text
|
|
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 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) 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
|
|
MsgBox(ex.Message & ex.StackTrace)
|
|
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
|
|
|
|
|
|
|
|
Dim filename As String = sPath & "tmp_" & Now.ToString("ddMMyyyyHHmmss") & ".xlsx"
|
|
wb.SaveAs(filename)
|
|
|
|
If openPDF Then Process.Start(filename)
|
|
|
|
Return filename
|
|
Catch ex As Exception
|
|
MsgBox(ex.Message & ex.StackTrace)
|
|
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)
|
|
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 = "support"
|
|
mySmtpsvr.Host = "owa.verag.ag"
|
|
mySmtpsvr.Port = 587
|
|
Case "ATILLA"
|
|
myCredentials.UserName = "support@verag.ag"
|
|
myCredentials.Password = "support"
|
|
mySmtpsvr.Host = "owa.verag.ag"
|
|
mySmtpsvr.Port = 587
|
|
Case Else
|
|
myCredentials.UserName = "support@verag.ag"
|
|
myCredentials.Password = "support"
|
|
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)
|
|
|
|
For Each s In eMailTo.ToString.Split(";")
|
|
If s <> "" Then Msg.To.Add(convertToIso(s).ToString.Trim())
|
|
Next
|
|
|
|
For Each s In cc.ToString.Split(";")
|
|
If s <> "" Then Msg.CC.Add(convertToIso(s).ToString.Trim())
|
|
Next
|
|
|
|
For Each s In bcc.ToString.Split(";")
|
|
If s <> "" Then Msg.Bcc.Add(convertToIso(s).ToString.Trim())
|
|
Next
|
|
|
|
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 a In DirectCast(anhaenge, List(Of String))
|
|
If a IsNot Nothing AndAlso a <> "" Then Msg.Attachments.Add(New System.Net.Mail.Attachment(a))
|
|
Next
|
|
End If
|
|
mySmtpsvr.Send(Msg)
|
|
|
|
Catch ex As Exception
|
|
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.107"
|
|
mySmtpsvr.Port = 25
|
|
mySmtpsvr.Send(Msg)
|
|
|
|
Catch ex3 As Exception
|
|
MsgBox(ex3.Message & ex3.StackTrace)
|
|
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 = "support"
|
|
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
|
|
MsgBox(ex.Message & ex.StackTrace)
|
|
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 |