diff --git a/DataService_Legacy/7z.dll b/DataService_Legacy/7z.dll new file mode 100644 index 0000000..b32d7bf Binary files /dev/null and b/DataService_Legacy/7z.dll differ diff --git a/DataService_Legacy/App.config b/DataService_Legacy/App.config new file mode 100644 index 0000000..eb4f30b --- /dev/null +++ b/DataService_Legacy/App.config @@ -0,0 +1,131 @@ + + + + +
+ + + + + + + + + + + + + + 15 + + + True + + + system@sebastian-fuchs---bad-und-heizung-gmbh-und-co-kg.com + + + 0oT4G3H2 + + + portal.mobilefieldreport.com + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + \ No newline at end of file diff --git a/DataService_Legacy/Fuchs_DataService.vbproj b/DataService_Legacy/Fuchs_DataService.vbproj new file mode 100644 index 0000000..3a383f2 --- /dev/null +++ b/DataService_Legacy/Fuchs_DataService.vbproj @@ -0,0 +1,186 @@ + + + + + Debug + AnyCPU + {7A56E271-A6BE-4C34-A859-DADEBC4C7A54} + Exe + Sub Main + fds + Fuchs_DataService + 512 + Console + v4.8 + true + true + false + publish\ + true + Disk + false + Foreground + 7 + Days + false + false + true + 0 + 1.0.0.%2a + false + true + + + x64 + true + full + true + true + bin\Debug\ + Fuchs_DataService.xml + 42016,41999,42017,42018,42019,42032,42036,42020,42021,42022 + false + + + AnyCPU + pdbonly + false + true + true + bin\Release\ + Fuchs_DataService.xml + 42016,41999,42017,42018,42019,42032,42036,42020,42021,42022 + + + On + + + Binary + + + Off + + + On + + + + ..\..\..\NugetPackages\Microsoft.Web.Infrastructure.2.0.0\lib\net40\Microsoft.Web.Infrastructure.dll + + + ..\..\..\NugetPackages\Newtonsoft.Json.13.0.3\lib\net45\Newtonsoft.Json.dll + + + ..\..\..\NugetPackages\Squid-Box.SevenZipSharp.1.6.1.23\lib\net472\SevenZipSharp.dll + + + + + + + + ..\..\..\NugetPackages\System.Runtime.InteropServices.RuntimeInformation.4.3.0\lib\net45\System.Runtime.InteropServices.RuntimeInformation.dll + True + True + + + + + ..\..\..\NugetPackages\Microsoft.AspNet.Razor.3.2.9\lib\net45\System.Web.Razor.dll + + + + + + + + ..\..\..\NugetPackages\Topshelf.4.3.0\lib\net452\Topshelf.dll + + + + + + + + + + + + + + + + + + + + + True + Application.myapp + True + + + True + True + Resources.resx + + + True + Settings.settings + True + + + + + + VbMyResourcesResXFileCodeGenerator + Resources.Designer.vb + My.Resources + Designer + + + + + + MyApplicationCodeGenerator + Application.Designer.vb + + + SettingsSingleFileGenerator + My + Settings.Designer.vb + + + + + + + + {ac8cba60-d786-48fd-a9f0-8b045a7bd505} + OCMS + + + {00c70b53-516d-4d56-ad25-6757094b4335} + MFR_RESTClient + + + + + Always + + + + + False + Microsoft .NET Framework 4.8 %28x86 and x64%29 + true + + + False + .NET Framework 3.5 SP1 + false + + + + + \ No newline at end of file diff --git a/DataService_Legacy/My Project/Application.Designer.vb b/DataService_Legacy/My Project/Application.Designer.vb new file mode 100644 index 0000000..88dd01c --- /dev/null +++ b/DataService_Legacy/My Project/Application.Designer.vb @@ -0,0 +1,13 @@ +'------------------------------------------------------------------------------ +' +' This code was generated by a tool. +' Runtime Version:4.0.30319.42000 +' +' Changes to this file may cause incorrect behavior and will be lost if +' the code is regenerated. +' +'------------------------------------------------------------------------------ + +Option Strict On +Option Explicit On + diff --git a/DataService_Legacy/My Project/Application.myapp b/DataService_Legacy/My Project/Application.myapp new file mode 100644 index 0000000..e62f1a5 --- /dev/null +++ b/DataService_Legacy/My Project/Application.myapp @@ -0,0 +1,10 @@ + + + false + false + 0 + true + 0 + 2 + true + diff --git a/DataService_Legacy/My Project/AssemblyInfo.vb b/DataService_Legacy/My Project/AssemblyInfo.vb new file mode 100644 index 0000000..e65a15f --- /dev/null +++ b/DataService_Legacy/My Project/AssemblyInfo.vb @@ -0,0 +1,35 @@ +Imports System +Imports System.Reflection +Imports System.Runtime.InteropServices + +' General Information about an assembly is controlled through the following +' set of attributes. Change these attribute values to modify the information +' associated with an assembly. + +' Review the values of the assembly attributes + + + + + + + + + + +'The following GUID is for the ID of the typelib if this project is exposed to COM + + +' Version information for an assembly consists of the following four values: +' +' Major Version +' Minor Version +' Build Number +' Revision +' +' You can specify all the values or you can default the Build and Revision Numbers +' by using the '*' as shown below: +' + + + diff --git a/DataService_Legacy/My Project/Resources.Designer.vb b/DataService_Legacy/My Project/Resources.Designer.vb new file mode 100644 index 0000000..d04821b --- /dev/null +++ b/DataService_Legacy/My Project/Resources.Designer.vb @@ -0,0 +1,63 @@ +'------------------------------------------------------------------------------ +' +' This code was generated by a tool. +' Runtime Version:4.0.30319.42000 +' +' Changes to this file may cause incorrect behavior and will be lost if +' the code is regenerated. +' +'------------------------------------------------------------------------------ + +Option Strict On +Option Explicit On + +Imports System + +Namespace My.Resources + + 'This class was auto-generated by the StronglyTypedResourceBuilder + 'class via a tool like ResGen or Visual Studio. + 'To add or remove a member, edit your .ResX file then rerun ResGen + 'with the /str option, or rebuild your VS project. + ''' + ''' A strongly-typed resource class, for looking up localized strings, etc. + ''' + _ + Friend Module Resources + + Private resourceMan As Global.System.Resources.ResourceManager + + Private resourceCulture As Global.System.Globalization.CultureInfo + + ''' + ''' Returns the cached ResourceManager instance used by this class. + ''' + _ + Friend ReadOnly Property ResourceManager() As Global.System.Resources.ResourceManager + Get + If Object.ReferenceEquals(resourceMan, Nothing) Then + Dim temp As Global.System.Resources.ResourceManager = New Global.System.Resources.ResourceManager("fds.Resources", GetType(Resources).Assembly) + resourceMan = temp + End If + Return resourceMan + End Get + End Property + + ''' + ''' Overrides the current thread's CurrentUICulture property for all + ''' resource lookups using this strongly typed resource class. + ''' + _ + Friend Property Culture() As Global.System.Globalization.CultureInfo + Get + Return resourceCulture + End Get + Set + resourceCulture = value + End Set + End Property + End Module +End Namespace diff --git a/DataService_Legacy/My Project/Resources.resx b/DataService_Legacy/My Project/Resources.resx new file mode 100644 index 0000000..af7dbeb --- /dev/null +++ b/DataService_Legacy/My Project/Resources.resx @@ -0,0 +1,117 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + text/microsoft-resx + + + 2.0 + + + System.Resources.ResXResourceReader, System.Windows.Forms, Version=2.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + + + System.Resources.ResXResourceWriter, System.Windows.Forms, Version=2.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + + \ No newline at end of file diff --git a/DataService_Legacy/My Project/Settings.Designer.vb b/DataService_Legacy/My Project/Settings.Designer.vb new file mode 100644 index 0000000..694c998 --- /dev/null +++ b/DataService_Legacy/My Project/Settings.Designer.vb @@ -0,0 +1,118 @@ +'------------------------------------------------------------------------------ +' +' This code was generated by a tool. +' Runtime Version:4.0.30319.42000 +' +' Changes to this file may cause incorrect behavior and will be lost if +' the code is regenerated. +' +'------------------------------------------------------------------------------ + +Option Strict On +Option Explicit On + + +Namespace My + + _ + Partial Friend NotInheritable Class MySettings + Inherits Global.System.Configuration.ApplicationSettingsBase + + Private Shared defaultInstance As MySettings = CType(Global.System.Configuration.ApplicationSettingsBase.Synchronized(New MySettings()),MySettings) + +#Region "My.Settings Auto-Save Functionality" +#If _MyType = "WindowsForms" Then + Private Shared addedHandler As Boolean + + Private Shared addedHandlerLockObject As New Object + + _ + Private Shared Sub AutoSaveSettings(sender As Global.System.Object, e As Global.System.EventArgs) + If My.Application.SaveMySettingsOnExit Then + My.Settings.Save() + End If + End Sub +#End If +#End Region + + Public Shared ReadOnly Property [Default]() As MySettings + Get + +#If _MyType = "WindowsForms" Then + If Not addedHandler Then + SyncLock addedHandlerLockObject + If Not addedHandler Then + AddHandler My.Application.Shutdown, AddressOf AutoSaveSettings + addedHandler = True + End If + End SyncLock + End If +#End If + Return defaultInstance + End Get + End Property + + _ + Public ReadOnly Property ExecutionFrequency_Minutes() As String + Get + Return CType(Me("ExecutionFrequency_Minutes"),String) + End Get + End Property + + _ + Public ReadOnly Property DebugDetails() As Boolean + Get + Return CType(Me("DebugDetails"),Boolean) + End Get + End Property + + _ + Public ReadOnly Property MFR_UserName() As String + Get + Return CType(Me("MFR_UserName"),String) + End Get + End Property + + _ + Public ReadOnly Property MFR_Password() As String + Get + Return CType(Me("MFR_Password"),String) + End Get + End Property + + _ + Public ReadOnly Property MFR_host() As String + Get + Return CType(Me("MFR_host"),String) + End Get + End Property + End Class +End Namespace + +Namespace My + + _ + Friend Module MySettingsProperty + + _ + Friend ReadOnly Property Settings() As Global.fds.My.MySettings + Get + Return Global.fds.My.MySettings.Default + End Get + End Property + End Module +End Namespace diff --git a/DataService_Legacy/My Project/Settings.settings b/DataService_Legacy/My Project/Settings.settings new file mode 100644 index 0000000..f920057 --- /dev/null +++ b/DataService_Legacy/My Project/Settings.settings @@ -0,0 +1,21 @@ + + + + + + 15 + + + True + + + system@sebastian-fuchs---bad-und-heizung-gmbh-und-co-kg.com + + + 0oT4G3H2 + + + portal.mobilefieldreport.com + + + \ No newline at end of file diff --git a/DataService_Legacy/fds_debug.vb b/DataService_Legacy/fds_debug.vb new file mode 100644 index 0000000..82ef857 --- /dev/null +++ b/DataService_Legacy/fds_debug.vb @@ -0,0 +1,134 @@ +Option Explicit On + + + + +Partial Friend Module fds_debug + + + Public Function LogFile(FileName As String) As IO.FileInfo + Return New IO.FileInfo(AppBaseDirectory().FullName & FileName) + End Function + + + + Public Function AppBaseDirectory() As IO.DirectoryInfo + Dim path As String = AppDomain.CurrentDomain.BaseDirectory + "tmp\" + Dim di As New IO.DirectoryInfo(path) + If di.Exists = True Then + Return di + ElseIf My.Computer.FileSystem.DirectoryExists(AppDomain.CurrentDomain.BaseDirectory) = True Then + di.Create() + Return di + Else : Return Nothing + End If + End Function + + + Public Sub DebugLog_async(CodeReference As String, SQLConnectionString As String, Optional exc As Exception = Nothing, Optional data As String = "", Optional context As Object = Nothing) + If CodeReference = "" OrElse SQLConnectionString = "" Then Exit Sub + Try + Threading.Tasks.Task.Run(Sub() Call DebugLog_sync(CodeReference:=CodeReference, SQLConnectionString:=SQLConnectionString, exc:=exc, data:=data, context:=context)) + Catch ex As Exception + Call DebugLog_sync(CodeReference:="fds_debug DebugLog_async", SQLConnectionString:=SQLConnectionString, exc:=ex, data:="", context:=Nothing) + End Try + End Sub + + + Public Sub DebugLog_sync(CodeReference As String, SQLConnectionString As String, Optional exc As Exception = Nothing, Optional data As String = "", Optional context As Object = Nothing) + If CodeReference = "" OrElse SQLConnectionString = "" Then Exit Sub + Using con As New SqlClient.SqlConnection(SQLConnectionString) + Call DebugLog(CodeReference:=CodeReference, SQLConnection:=con, exc:=exc, data:=data, context:=context) + End Using + End Sub + + + + Public Sub DebugLog(CodeReference As String, SQLConnection As SqlClient.SqlConnection, Optional exc As Exception = Nothing, Optional data As String = "", Optional context As Object = Nothing) + If CodeReference = "" OrElse IsNothing(SQLConnection) = True Then Exit Sub + Dim note As String = Now.ToString("yyyy.MM.dd HH:mm:ss") & " - " & CodeReference + Try + Try + If IsNothing(SQLConnection) = False Then + Dim pl As New List(Of SqlClient.SqlParameter) From { + New SqlClient.SqlParameter("@CodeReference", CodeReference), + New SqlClient.SqlParameter("@ExceptionMessage", If(IsNothing(exc), DBNull.Value, exc.Message)), + New SqlClient.SqlParameter("@StackTrace", If(IsNothing(exc), DBNull.Value, exc.StackTrace.ToString)), + New SqlClient.SqlParameter("@data", If(data, DBNull.Value)) + } + Try + Dim w As Integer = 0 + If SQLConnection.State = ConnectionState.Broken Then SQLConnection.Close() + If SQLConnection.State = ConnectionState.Connecting Then + w = 0 + While SQLConnection.State = ConnectionState.Connecting And w < 10 + System.Threading.Thread.Sleep(100) + w += 1 + End While + ElseIf Not SQLConnection.State = ConnectionState.Open Then + SQLConnection.Open() + End If + w = 0 + While Not SQLConnection.State = ConnectionState.Open And w < 10 + System.Threading.Thread.Sleep(100) + w += 1 + End While + Dim cmd As New SqlClient.SqlCommand("EXECUTE [dbo].[fds__admin_logdebug] @CodeReference,@ExceptionMessage,@StackTrace,@Data;", SQLConnection) + cmd.Parameters.AddRange(pl.ToArray) + Call cmd.ExecuteNonQuery() + 'SQLConnection.Close() + cmd.Parameters.Clear() + + Catch sqlex As Exception + End Try + + End If + Catch dbex As Exception + + End Try + + If IsNothing(exc) = False Then + note &= (vbCrLf & "Exception:" & exc.Message & vbCrLf & "Stack:" & exc.StackTrace.ToString).Replace(vbLf, vbLf & " ") + End If + If data <> "" Then + note &= (vbCrLf & "Data:" & data).Replace(vbLf, vbLf & " ") + End If + note &= vbCrLf + + Dim DebugLogfile As IO.FileInfo = LogFile("DebugLog.txt") + If DebugLogfile.Directory.Exists = True Then + IO.File.AppendAllText(DebugLogfile.FullName, note) + End If + Catch logex As Exception + + Finally + + Console.Write(note) + Debug.Print(note) + End Try + End Sub + + Public Sub DebugToFile(note As String, Optional filename As String = "DebugLog.txt") + Try + Dim DebugLogfile As IO.FileInfo = LogFile(filename) + If DebugLogfile.Directory.Exists = True Then + IO.File.AppendAllText(DebugLogfile.FullName, Now.ToString & ": " & note & vbCrLf) + End If + Catch ex As Exception + End Try + End Sub + Public Sub DebugToFile(CodeReference As String, exc As Exception, data As String, Optional filename As String = "DebugLog.txt") + Dim note As String = CodeReference + If IsNothing(exc) = False Then + note &= (vbCrLf & "Exception:" & exc.Message & vbCrLf & "Stack:" & exc.StackTrace.ToString).Replace(vbLf, vbLf & " ") + End If + If data <> "" Then + note &= (vbCrLf & "Data:" & data).Replace(vbLf, vbLf & " ") + End If + + Call DebugToFile(note, filename:=filename) + End Sub + + + +End Module diff --git a/DataService_Legacy/fds_main.vb b/DataService_Legacy/fds_main.vb new file mode 100644 index 0000000..8d5521c --- /dev/null +++ b/DataService_Legacy/fds_main.vb @@ -0,0 +1,146 @@ + +Imports Topshelf +Imports json = Newtonsoft.Json.JsonConvert + + + +Public Class fds_service + Implements Topshelf.ServiceControl + + Dim WithEvents _timer As System.Timers.Timer + + Public Sub New() + Me._timer = New System.Timers.Timer(My.Settings.ExecutionFrequency_Minutes * 60 * 1000) With {.AutoReset = True} + + End Sub + + + Public Function Start(hostControl As HostControl) As Boolean Implements ServiceControl.Start + Me._timer.Start() + Return True + End Function + Public Function StartImmediately(hostControl As HostControl) As Boolean + Me._timer.Start() + System.Threading.Tasks.Task.Run(Sub() + If My.Settings.DebugDetails = True Then Call DebugToFile("fds__data_service - timer started with interval " & _timer.Interval.ToString, filename:="DebugDetail.txt") + Call update_mfr() 'start right away and do not wait until first intervall period is over + End Sub) + 'do not wait and immediately return + Return True + End Function + + Public Function [Stop](hostControl As HostControl) As Boolean Implements ServiceControl.Stop + Me._timer.Stop() + If My.Settings.DebugDetails = True Then System.Threading.Tasks.Task.Run(Sub() Call DebugToFile("fds__data_service - timer stopped", filename:="DebugDetail.txt")) + + Return True + End Function + + + Public Sub timerElapsed() Handles _timer.Elapsed + Call update_mfr() + End Sub + + Friend Shared Sub update_mfr() + If My.Settings.DebugDetails = True Then Call DebugToFile("fds__data_service update_mfr UpdateIfNecessary - timer elapsed", filename:="DebugDetail.txt") + 'call update to data if necessary + Try + Dim t As Threading.Tasks.Task = Threading.Tasks.Task.Run(Async Function() + 'Await UpdateIfNecessary_Single_async(et:=MFR_RESTClient.generic._generic.EntityTypes.Report, DebugDetails:=My.Settings.DebugDetails) + Await UpdateIfNecessary_async(DebugDetails:=My.Settings.DebugDetails) + Await UpdateRequested_async(DebugDetails:=My.Settings.DebugDetails) + Await GetInvoiceFiles_async(DebugDetails:=My.Settings.DebugDetails) + 'Await getDatevZip() + End Function) + t.Wait() + Catch ex As Exception + Call DebugLog("fds__data_service update_mfr UpdateIfNecessary", SQLConnection:=Nothing, exc:=ex) + If My.Settings.DebugDetails = True Then Call DebugToFile("fds__data_service update_mfr UpdateIfNecessary", exc:=ex, data:="", filename:="DebugDetail.txt") + End Try + End Sub + +End Class + + + +Public Module fds_main + + Sub Main() + Dim clArgs() As String = Environment.GetCommandLineArgs() + + If (New String() {"digital-pc", "digital-dpc"}).Contains(Environment.MachineName.ToLower) = False Then + + HostFactory.Run(Sub(x) + x.Service(Of fds_service)(AddressOf ServiceConfiguratorCallback) + x.EnablePauseAndContinue() + x.StartAutomatically() + x.RunAsLocalSystem() + x.SetDescription("MFR Data Sync") + x.SetDisplayName("MFR Data Sync") + x.SetServiceName("MFR Data Sync") + End Sub) + Else + Call fds_service.update_mfr() + 'Call DEv() + End If + End Sub + + Private Sub ServiceConfiguratorCallback(s As ServiceConfigurators.ServiceConfigurator(Of fds_service)) + s.ConstructUsing(Function(name) New fds_service()) + s.WhenStarted(Function(tc, Host) + Return tc.Start(Host) + End Function) + s.WhenStopped(Function(tc, Host) + Return tc.Stop(Host) + End Function) + s.BeforeStoppingService(Sub(HostStopContext) + If My.Settings.DebugDetails = True Then System.Threading.Tasks.Task.Run(Sub() Call DebugToFile("fds__data_service - beforestop", filename:="DebugDetail.txt")) + End Sub) + s.WhenPaused(Function(tc, Host) + Return tc.Stop(Host) + End Function) + s.WhenContinued(Function(tc, Host) + Return tc.StartImmediately(Host) + End Function) + End Sub + + + + Public Sub DEv() + Using MFR As New fds_MFR_Client() + 'Diagnostics.Debug.Print(MFR.ReadAnything(address:="https://portal.mobilefieldreport.com/odata/$metadata")) + 'Diagnostics.Debug.Print(MFR.ReadAnything(address:="https://portal.mobilefieldreport.com/odata/Companies?$top=5&$expand=Contacts,Tags,ServiceObjects,MainContact")) + 'Diagnostics.Debug.Print(MFR.ReadAnything(address:="https://portal.mobilefieldreport.com/odata/ServiceObjects?$expand=WarehouseManager,CustomValueSteps,Company,Product,Tags,ChildServiceObject,Contacts,Items")) + 'Diagnostics.Debug.Print(MFR.ReadAnything(address:="https://portal.mobilefieldreport.com/odata/Contacts/$count")) + 'Diagnostics.Debug.Print(MFR.getEntities()) + Dim fle As Byte() + Try + fle = MFR.GetFile("https://portal.mobilefieldreport.com/mfr/Report/19584712737/Content/") + System.IO.File.WriteAllBytes("C:\Users\sailo\Desktop\Test.pdf", fle) + Catch ex As Exception + + End Try + End Using + + End Sub + + + + + +End Module + + + +Partial Friend Module fds_debug + + + Public Sub DebugLog(CodeReference As String, Optional exc As Exception = Nothing, Optional data As String = "", Optional context As Object = Nothing, Optional execute_async As Boolean = True) + If execute_async = True Then + Call DebugLog_async(CodeReference:=CodeReference, SQLConnectionString:=FDSConnectionString(), exc:=exc, data:=data, context:=context) + Else + Call DebugLog_sync(CodeReference:=CodeReference, SQLConnectionString:=FDSConnectionString(), exc:=exc, data:=data, context:=context) + End If + End Sub + +End Module diff --git a/DataService_Legacy/fds_mfr.vb b/DataService_Legacy/fds_mfr.vb new file mode 100644 index 0000000..78d2eda --- /dev/null +++ b/DataService_Legacy/fds_mfr.vb @@ -0,0 +1,1046 @@ + + +Imports System.Configuration +Imports MFR_RESTClient +Imports MFR_RESTClient.generic +Imports Newtonsoft.Json.Linq +Imports json = Newtonsoft.Json.JsonConvert +Imports vbs = Microsoft.VisualBasic.Strings +Imports OCMS +Imports OCMS.SQLHandling +Imports System.Text + +Namespace Global.fds + + Public Class fds_SQLOptions + Inherits sqloptions + + Dim baseinfo As New Dictionary(Of String, Object) + + Public Sub New(Optional dic As Dictionary(Of String, Object) = Nothing) + MyBase.New() + Me.baseinfo = dic + Me.OnError = Sub(procedure As String, ex As Exception, data As Object) + Call debug_log(procedure:=procedure, ex:=ex, data:=New With {.ctrl_nfo = dic, .sql = data}) + End Sub + End Sub + End Class + + Public Module fds_mfr + + Friend Function AppDirectory() As String + Return AppDomain.CurrentDomain.BaseDirectory + End Function + + Public Enum UpdateNeed + [Reset] = 5 + [Full] = 2 + [Short] = 1 + [None] = 0 + End Enum + + +#Disable Warning BC42358 + Public Async Function UpdateIfNecessary_async(Optional DebugDetails As Boolean = False) As Threading.Tasks.Task + + Using mfr As New fds_MFR_Client + Try + + If DebugDetails = True Then Call DebugToFile("UpdateIfNecessary_async - unn - start awaited", filename:="DebugDetail.txt") + Await mfr.Update__Entitytables(DebugDetails:=DebugDetails) + If DebugDetails = True Then Call DebugToFile("UpdateIfNecessary_async - unn - completed", filename:="DebugDetail.txt") + + Catch ex As Exception + Call DebugLog("UpdateIfNecessary_async - main unn", exc:=ex) + If DebugDetails = True Then Call DebugToFile("UpdateIfNecessary_async - unn", exc:=ex, data:="", filename:="DebugDetail.txt") + End Try + End Using + + End Function + Public Async Function UpdateRequested_async(Optional DebugDetails As Boolean = False) As Threading.Tasks.Task + + Using mfr As New fds_MFR_Client + Try + + If DebugDetails = True Then Call DebugToFile("UpdateRequested_async - unn - start awaited", filename:="DebugDetail.txt") + Await mfr.Update__EntityRequests(DebugDetails:=DebugDetails) + If DebugDetails = True Then Call DebugToFile("UpdateRequested_async - unn - completed", filename:="DebugDetail.txt") + + Catch ex As Exception + Call DebugLog("UpdateRequested_async - main unn", exc:=ex) + If DebugDetails = True Then Call DebugToFile("UpdateRequested_async - unn", exc:=ex, data:="", filename:="DebugDetail.txt") + End Try + End Using + + End Function + + Public Async Function GetInvoiceFiles_async(Optional DebugDetails As Boolean = False) As Threading.Tasks.Task + + Using mfr As New fds_MFR_Client + Try + + If DebugDetails = True Then Call DebugToFile("GetInvoiceFiles_async - unn - start awaited", filename:="DebugDetail.txt") + Dim dtbl As SQLDataTable = Await getSQLDatatable_async("EXECUTE [dbo].[fds__fn_getMFRInvoicesWithoutfiles];", FDSConnectionString, SqlParameterList:=Nothing, options:=New fds_SQLOptions()) + If dtbl.Count > 0 Then + For Each ivrw As DataRow In dtbl.DataTable.Rows + Dim id As String = ivrw.nz("id"), DocumentName As String = ivrw.nz("DocumentName"), fileurl As String = ivrw.nz("URI") + If id <> "" AndAlso DocumentName <> "" AndAlso fileurl <> "" AndAlso DocumentName.EndsWith("pdf") Then + Dim fl As Byte() = mfr.GetFile(fileurl) + If IsNothing(fl) = False AndAlso fl.Length > 0 Then + Try + Await setSQLValue_async("EXECUTE [dbo].[fds__setMFRInvoiceFile] @Id, @filename, @file;", FDSConnectionString, SqlParameterList:=New ParamList(SQL_VarChar("@Id", id), SQL_VarChar("@filename", DocumentName), New SqlClient.SqlParameter("@file", fl) With {.SqlDbType = SqlDbType.VarBinary}), options:=New fds_SQLOptions()) + Catch fsex As Exception + Call DebugLog("GetInvoiceFiles_async - mfr storefile", exc:=fsex) + End Try + + End If + End If + Next + End If + If DebugDetails = True Then Call DebugToFile("GetInvoiceFiles_async - unn - completed", filename:="DebugDetail.txt") + + Catch ex As Exception + Call DebugLog("GetInvoiceFiles_async - main unn", exc:=ex) + If DebugDetails = True Then Call DebugToFile("GetInvoiceFiles_async - unn", exc:=ex, data:="", filename:="DebugDetail.txt") + End Try + End Using + + End Function + + Public Async Function UpdateIfNecessary_Single_async(et As EntityTypes, Optional DebugDetails As Boolean = False) As Threading.Tasks.Task(Of Boolean) + Dim ret As Boolean = False + Using mfr As New fds_MFR_Client + Try + + If DebugDetails = True Then Call DebugToFile("UpdateIfNecessary_async - unn - start awaited", filename:="DebugDetail.txt") + Await mfr.Update__Entitytables(DebugDetails:=DebugDetails, tgtEntityType:=et) + If DebugDetails = True Then Call DebugToFile("UpdateIfNecessary_async - unn - completed", filename:="DebugDetail.txt") + ret = True + Catch ex As Exception + Call DebugLog("UpdateIfNecessary_async - main unn", exc:=ex) + If DebugDetails = True Then Call DebugToFile("UpdateIfNecessary_async - unn", exc:=ex, data:="", filename:="DebugDetail.txt") + ret = False + End Try + End Using + Return ret + End Function + + Public Async Function getSchema() As Task(Of String) + Dim ret As String = "" + Using mfr As New fds_MFR_Client + ret = Await mfr.ReadAnything(address:=mfr.clientConfig.BaseUrl & "$metadata") + End Using + Return ret + End Function + + Public Async Function getAnything(query As String, Optional throwerror_if_nOK As Boolean = True) As Task(Of String) + Dim ret As String = "" + Using mfr As New fds_MFR_Client + ret = Await mfr.ReadAnything(address:=mfr.clientConfig.BaseUrl & query, throwerror_if_nOK:=throwerror_if_nOK) + End Using + Return ret + End Function + + + Public Function getReportDoc(ByRef file As Byte(), reportid As String, Optional DebugDetails As Boolean = False) As IO.FileInfo + Dim pl As New List(Of SqlClient.SqlParameter) From {SQL_VarChar("@reportid", reportid)} + Dim sqldt As SQLDataTable = System.Threading.Tasks.Task.Run(Async Function() Await getSQLDatatable_async("EXECUTE [dbo].[fds__getReportDocument] @reportid;", FDSConnectionString, SqlParameterList:=pl, options:=New fds_SQLOptions())).Result() + If sqldt.Count > 0 Then + Dim irow As DataRow = sqldt.FirstRow() + Dim fl As Byte() = Nothing, fln As String = irow.nz("DocumentName") + Try + + If fln <> "" AndAlso irow.nz("fds") = False Then + Using mfr As New fds_MFR_Client + fl = mfr.GetFile(irow.nz("URI")) + End Using + If IsNothing(fl) = False AndAlso fl.Length > 0 Then + Try + Dim r = System.Threading.Tasks.Task.Run(Async Function() Await setSQLValue_async("EXECUTE [dbo].[fds__setMFRInvoiceFile] @Id, @filename, @file;", FDSConnectionString, SqlParameterList:=New ParamList(SQL_VarChar("@Id", reportid), SQL_VarChar("@filename", fln), New SqlClient.SqlParameter("@file", fl) With {.SqlDbType = SqlDbType.VarBinary}), options:=New fds_SQLOptions())).Result() + Catch fsex As Exception + Call DebugLog("getReportDoc - mfr storefile", exc:=fsex) + End Try + + End If + Else + fl = irow.no("file", Nothing) + End If + Catch ex As Exception + Call DebugLog("getReportDoc - mfr", exc:=ex) + If DebugDetails = True Then Call DebugToFile("getReportDoc - mfr", exc:=ex, data:="", filename:="DebugDetail.txt") + End Try + If IsNothing(fl) = False Then + file = fl + Dim ReportFile As New IO.FileInfo(IO.Path.GetTempPath & fln.Replace("

", "").Replace("

", "").Replace("=", "_").Replace(">", "_").Replace("|", "_").Replace("!", "_").Replace("<", "_").Replace("/", "_")) + Return ReportFile + Else + Return Nothing + End If + Else + Return Nothing + End If + End Function + Public Function getFDSDoc(ByRef file As Byte(), reportid As String, type As String) As IO.FileInfo + Dim pl As New List(Of SqlClient.SqlParameter) From {SQL_VarChar("@type", type), SQL_VarChar("@reportid", reportid)} + Dim sqldt As SQLDataTable = System.Threading.Tasks.Task.Run(Async Function() Await getSQLDatatable_async("EXECUTE [dbo].[fds__getFDSDocument] @type, @reportid;", FDSConnectionString, SqlParameterList:=pl, options:=New fds_SQLOptions())).Result() + If sqldt.Count > 0 Then + Dim irow As DataRow = sqldt.FirstRow() + Dim fl As Byte() = irow.no("file", Nothing), fln As String = irow.nz("DocumentName") + If IsNothing(fl) = False Then + file = fl + Dim ReportFile As New IO.FileInfo(IO.Path.GetTempPath & fln.Replace("=", "_").Replace(">", "_").Replace("|", "_").Replace("!", "_").Replace("?", "_")) + Return ReportFile + Else + Return Nothing + End If + Else + Return Nothing + End If + End Function + + Public Function DATEV(header As DATEV_HEADER, tbl As DataTable) As String + + Return header.toHeaderstring() & ControlChars.CrLf & tbl.ToCsv(includeHeaders:=True, quoteStrings:=False, fieldDelimiter:=";", cultureinfo:=New Globalization.CultureInfo("de-DE"), quoteHeader:=False) + End Function + Public Class DATEV_HEADER + + 'c.f. https://developer.datev.de/portal/de/dtvf/formate/header + + Public Kennzeichen As DATEV_Kennzeichen = DATEV_Kennzeichen.EXTF + Public Versionsnummer As Integer = 700 + Public Formatkategorie As DATEV_Formatkategorie = DATEV_Formatkategorie.Debitoren__Kreditoren + Public Formatversion As DATEV_Formatversion = DATEV_Formatversion.Debitoren__Kreditoren + Public Beraternummer As Integer + Public Mandantennummer As Integer + Public WJBeginn As Date + Public Sachkontenlänge As Integer + Public Datum_von As Date + Public Datum_bis As Date + Public Bezeichnung As String + Public Buchungstyp As DATEV_Buchungstyp = DATEV_Buchungstyp.Finanzbuchführung + Public Rechnungsslegungszweck As DATEV_Rechnungslegungszweck = DATEV_Rechnungslegungszweck.unabhängig + Public Festschreibung As Boolean = 1 + Public WKZ As String = "EUR" + + + Public created As Date = Now() + Public ReadOnly Property Formatname As String + Get + Return [Enum].GetName(GetType(DATEV_Formatkategorie), Me.Formatkategorie).Replace("__", "/").Replace("_", " ") + End Get + End Property + + Dim EmptyDblQuote As String = Microsoft.VisualBasic.ChrW(34) & Microsoft.VisualBasic.ChrW(34) + + Public ReadOnly Property toHeaderstring As String + Get + Dim sb As New List(Of String) + sb.Add(Microsoft.VisualBasic.ChrW(34) & [Enum].GetName(GetType(DATEV_Kennzeichen), Me.Kennzeichen) & Microsoft.VisualBasic.ChrW(34)) + sb.Add(Me.Versionsnummer.ToString) + sb.Add(CInt(Me.Formatkategorie).ToString) + sb.Add(Microsoft.VisualBasic.ChrW(34) & Me.Formatname & Microsoft.VisualBasic.ChrW(34)) + sb.Add(CInt(Me.Formatversion).ToString) + sb.Add(created.ToString("yyyyMMddHHmmssfff")) + sb.Add("") '7 Leerfeld + sb.Add(EmptyDblQuote) '8 Leerfeld + sb.Add(EmptyDblQuote) '9 Leerfeld + sb.Add(EmptyDblQuote) '10 Leerfeld + sb.Add(Me.Beraternummer.ToString) '11 Beraternummer + sb.Add(Me.Mandantennummer.ToString) '12 Mandantennummer + sb.Add(Me.WJBeginn.ToString("yyyyMMdd")) + sb.Add(Me.Sachkontenlänge.ToString) + sb.Add(Me.Datum_von.ToString("yyyyMMdd")) + sb.Add(Me.Datum_bis.ToString("yyyyMMdd")) + sb.Add(Microsoft.VisualBasic.ChrW(34) & Me.Bezeichnung & Microsoft.VisualBasic.ChrW(34)) + sb.Add(EmptyDblQuote) '18 Diktatkürzel + sb.Add(CInt(Me.Buchungstyp).ToString) + sb.Add(CInt(Me.Rechnungsslegungszweck).ToString) + sb.Add(If(Me.Festschreibung = False, 0, 1)) + sb.Add(Microsoft.VisualBasic.ChrW(34) & Me.WKZ & Microsoft.VisualBasic.ChrW(34)) + sb.Add("") '23 Leerfeld + sb.Add("") '24 Leerfeld + sb.Add("") '25 Leerfeld + sb.Add("") '26 Leerfeld + sb.Add("") '27 Sachkontenrahmen + sb.Add("") '28 ID der Branchenlösung + sb.Add("") '29 Leerfeld + sb.Add("") '30 Leerfeld + sb.Add("") '31 Verarbeitungskennzeichen + Return vbs.Join(sb.ToArray, ";") + End Get + End Property + + + End Class + + + + Public Enum DATEV_Rechnungslegungszweck + unabhängig = 0 + Steuerrecht = 30 + Kalkulatorik = 40 + Handelsrecht = 50 + IFRS = 64 + End Enum + + Public Enum DATEV_Buchungstyp + Finanzbuchführung = 1 + Jahresabschluss = 2 + End Enum + + Public Enum DATEV_Kennzeichen + EXTF + DTVF + End Enum + + Public Enum DATEV_Formatkategorie + [Debitoren__Kreditoren] = 16 + [Sachkontenbeschriftungen] = 20 + [Buchungsstapel] = 21 + [Zahlungsbedingungen] = 46 + [Diverse_Adressen] = 48 + [Wiederkehrende_Buchungen] = 65 + End Enum + Public Enum DATEV_Formatversion + [Debitoren__Kreditoren] = 5 + [Sachkontenbeschriftungen] = 3 + [Buchungsstapel_9] = 9 + [Buchungsstapel] = 12 + [Zahlungsbedingungen] = 2 + [Wiederkehrende_Buchungen] = 4 + [Diverse_Adressen] = 2 + End Enum + + Public Class DATEV_Document + Public guid As String + Public type As Integer = 2 + Public processID As Integer = 2 + Public Filename As String + Public KeyWords As String + Public Repository As String + Public Register As String + Public Sub New(guid As String, filename As String, keywords As String, Repository As String, Register As String) + Me.guid = guid + Me.Filename = filename + Me.KeyWords = keywords + Me.Repository = Repository + Me.Register = Register + End Sub + End Class + + + Public Function getDatevZip(ByRef stream As IO.Stream, ByVal tgtdate As Date, mode As String, ByVal AuthUser As String, ByVal includeFiles As Boolean, Optional DebugDetails As Boolean = False) As IO.FileInfo + + Using mfr As New fds_MFR_Client + Try + Dim DSet As SQLDataSet = System.Threading.Tasks.Task.Run(Async Function() Await getSQLDataSet_async("EXECUTE [dbo].[fds__getDatevExports] @tgtdate, @mode, @files, @authuser;", FDSConnectionString, SqlParameterList:=New List(Of SqlClient.SqlParameter) From {SQL_date("@tgtdate", tgtdate), SQL_VarChar("@mode", mode), SQL_bit("@files", includeFiles), SQL_VarChar("@authuser", AuthUser)}, tablenames:=New String() {"admin", "inv", "buchungen", "debitoren"}, options:=New fds_SQLOptions())).Result() + + Dim bedi_files As New List(Of DATEV_Document) + + If DSet.Count >= 4 Then + Dim admin As Dictionary(Of String, Object) = DSet.Tables("admin").Rows(0).toObjectDictionary() + Dim startdate As Date = admin("startdate"), enddate As Date = admin("enddate") + Dim Datev_Level3_Register As String = tgtdate.ToString("yyyy\/MM") & If(mode.ToLower = "w", "_w" & tgtdate.ToString("dd"), "") + Dim fls As New Dictionary(Of String, Byte()) + Dim header As New DATEV_HEADER With { + .Formatkategorie = DATEV_Formatkategorie.Buchungsstapel, + .Formatversion = DATEV_Formatversion.Buchungsstapel_9, + .Beraternummer = admin("beraternummer"), + .Mandantennummer = admin("mandantennummer"), + .WJBeginn = admin("WJ-Beginn"), + .Sachkontenlänge = admin("Sachkontenlänge"), + .Datum_von = startdate, + .Datum_bis = enddate, + .Bezeichnung = "fds_" & mode & tgtdate.ToString("yyMMdd") + } + fls.Add("EXTF_PCW_Buchungen_0_" & startdate.ToString("yyMMdd HHmmss") & ".csv", DATEV(header, DSet.Tables("buchungen")).ToByteArray(encoding:=Encoding.GetEncoding("ISO-8859-1"))) + + ''only for debug + 'Using fsw As New IO.StreamWriter("C:\Users\sailo\Desktop\Fuchs\DatevUpload_AR 202107_w___DATEVNEU\EXTF_PCW_Buchungen_0_" & startdate.ToString("yyMMdd HHmmss") & ".csv", False, Encoding.GetEncoding("ISO-8859-1")) + ' fsw.Write(value:=DATEV(header, DSet.Tables("buchungen"))) + ' fsw.Close() + 'End Using + + + With header + .Formatkategorie = DATEV_Formatkategorie.Debitoren__Kreditoren + .Formatversion = DATEV_Formatversion.Debitoren__Kreditoren + End With + fls.Add("EXTF_PCW_Debitoren_0_" & startdate.ToString("yyMMdd HHmmss") & ".csv", DATEV(header, DSet.Tables("debitoren")).ToByteArray(encoding:=Encoding.GetEncoding("ISO-8859-1"))) + + + ''only for debug + 'Using fsw As New IO.StreamWriter("C:\Users\sailo\Desktop\Fuchs\DatevUpload_AR 202107_w___DATEVNEU\EXTF_PCW_Debitoren_0_" & startdate.ToString("yyMMdd HHmmss") & ".csv", False, Encoding.GetEncoding("ISO-8859-1")) + ' fsw.Write(value:=DATEV(header, DSet.Tables("debitoren"))) + ' fsw.Close() + 'End Using + + + 'add csv files to bedi list + For Each fl As String In fls.Keys + bedi_files.Add(New DATEV_Document(Guid.NewGuid().ToString.ToLower, filename:=fl, keywords:="", Repository:="Processweb_Daten", Register:=Datev_Level3_Register)) + Next + + If includeFiles = True Then + For Each irow As DataRow In DSet.Tables("inv").Rows + Dim fl As Byte() = Nothing, fln As String = irow.nz("DocumentName") + Try + If fln <> "" AndAlso irow.no("fds", True) = False Then + fl = mfr.GetFile(irow.nz("URI")) + Else + fl = irow.no("file", Nothing) + End If + Catch ex As Exception + + End Try + If IsNothing(fl) = False AndAlso fln <> "" Then + fls.Add(fln, fl) + bedi_files.Add(New DATEV_Document(irow("file_guid"), filename:=fln, keywords:="RgNr: " & irow.nz("InvoiceId") & " RgDatum: " & irow.ndt_string("DateOfCreation", "dd.MM.yyyy"), Repository:="ProcessWeb_Belege", Register:=Datev_Level3_Register)) + End If + 'If fls.Count > 7 Then Exit For + Next + + fls.Add("document.xml", createDATEV_document_xml(bedi_files).ToByteArray()) + End If + + If fls.Count > 0 Then + Dim ArchiveFile As New IO.FileInfo(IO.Path.GetTempPath & "DatevUpload_AR " & startdate.ToString("yyyyMM") & "_" & admin("mode").ToString & ".zip") + Try + Using Archive As New fds.Archive(ArchiveFile, Type:=SevenZip.OutArchiveFormat.Zip) + If Archive.CompressToStream(fls, targetstream:=stream) = True Then + Diagnostics.Debug.Print("ok") + 'Archive.WriteArchiveStreamToDisk() + stream.Position = 0 + Return ArchiveFile + Else + Return Nothing + End If + End Using + Catch aex As Exception + End Try + + End If + + End If + + Catch ex As Exception + Call DebugLog("getDatevZip - mfr", exc:=ex) + If DebugDetails = True Then Call DebugToFile("getDatevZip - mfr", exc:=ex, data:="", filename:="DebugDetail.txt") + End Try + End Using + Return Nothing + End Function +#Enable Warning BC42358 + + Public Function createDATEV_document_xml(files As List(Of DATEV_Document)) As String + Dim xmldoc As New Xml.XmlDocument + + 'Write down the XML declaration + Dim XmlDeclaration As Xml.XmlDeclaration = xmldoc.CreateXmlDeclaration("1.0", "UTF-8", Nothing) + xmldoc.InsertBefore(XmlDeclaration, xmldoc.DocumentElement) + + 'create root + Dim RootNode As Xml.XmlElement = xmldoc.CreateElement("archive", "http://xml.datev.de/bedi/tps/document/v04.0") + xmldoc.AppendChild(RootNode) + + With RootNode + Dim schemaLocation As Xml.XmlAttribute = xmldoc.CreateAttribute("xsi", "schemaLocation", "http://www.w3.org/2001/XMLSchema-instance") + schemaLocation.Value = "http://xml.datev.de/bedi/tps/document/v04.0 document_v040.xsd" + .Attributes.Append(schemaLocation) + .SetAttribute("generatingSystem", "ProcessWeb") + .SetAttribute("version", "4.0") + End With + + Dim header As Xml.XmlElement = xmldoc.CreateElement("header") + xmldoc.DocumentElement.PrependChild(header) + Dim headerelement As Xml.XmlElement = xmldoc.CreateElement("date") + headerelement.InnerText = Now().ToString("yyyy-MM-ddTHH:mm:ss") + header.AppendChild(headerelement) + headerelement = xmldoc.CreateElement("description") + headerelement.InnerText = "DATEV Schnittstelle ProcessWeb" + header.AppendChild(headerelement) + + Dim content As Xml.XmlElement = xmldoc.CreateElement("content") + xmldoc.DocumentElement.AppendChild(content) + For Each fl As DATEV_Document In files + Dim docelement As Xml.XmlElement = xmldoc.CreateElement("document") + docelement.SetAttribute("guid", fl.guid) + docelement.SetAttribute("type", fl.type) + docelement.SetAttribute("processID", fl.processID) + + If If(fl.KeyWords, "") <> "" Then + Dim keyword As Xml.XmlElement = xmldoc.CreateElement("keywords") + keyword.InnerText = fl.KeyWords + docelement.AppendChild(keyword) + End If + + Dim extension As Xml.XmlElement = xmldoc.CreateElement("extension") + Dim ext_attr As Xml.XmlAttribute = xmldoc.CreateAttribute("xsi", "type", "http://www.w3.org/2001/XMLSchema-instance") + ext_attr.Value = "File" + extension.Attributes.Append(ext_attr) + extension.SetAttribute("name", fl.Filename) + docelement.AppendChild(extension) + + Dim repository As Xml.XmlElement = xmldoc.CreateElement("repository") + Dim level As Xml.XmlElement + level = xmldoc.CreateElement("level") + level.SetAttribute("id", "1") 'Kategorie + level.SetAttribute("name", "ProcessWeb") + repository.AppendChild(level) + level = xmldoc.CreateElement("level") + level.SetAttribute("id", "2") 'Ordner + level.SetAttribute("name", fl.Repository) + repository.AppendChild(level) + level = xmldoc.CreateElement("level") + level.SetAttribute("id", "3") 'Register e.g. 2020/12 + level.SetAttribute("name", fl.Register) + repository.AppendChild(level) + docelement.AppendChild(repository) + + content.AppendChild(docelement) + Next + + Dim xmlasstring As String = "" + Using sw As New IO.StringWriter + Using tw As Xml.XmlWriter = Xml.XmlWriter.Create(sw) + xmldoc.WriteTo(tw) + tw.Flush() + xmlasstring = sw.GetStringBuilder().ToString() + End Using + End Using + Return xmlasstring + End Function + + + Public Function UpdateNeedValue(need As String) As UpdateNeed + Return [Enum].Parse(GetType(UpdateNeed), need) + End Function + + + + End Module + + + + + + Public Class fds_MFR_Client + Implements IDisposable + + + Dim MFRClient As Global.MFR_RESTClient.MFRClient + + Private Shared Function DefaultCredentials() + Return New MFRClientCredentials(My.Settings.MFR_UserName, My.Settings.MFR_Password) + End Function + + Public Sub New(Credentials As MFRClientCredentials) + Dim config As New MFRClientConfig(My.Settings.MFR_host) + Me.MFRClient = New MFRClient(config, credentials:=Credentials) + End Sub + Public Sub New() + Me.New(fds_MFR_Client.DefaultCredentials()) + End Sub + + Public Property IsReadonly() As Boolean + Get + Return Me.MFRClient.IsReadonly + End Get + Set(value As Boolean) + Me.MFRClient.IsReadonly = value + End Set + End Property + + Public ReadOnly Property clientConfig As MFRClientConfig + Get + Return Me.MFRClient.clientConfig + End Get + End Property + + Public Async Function ReadAnything(address As String, Optional throwerror_if_nOK As Boolean = True) As Task(Of String) + Return Await Me.MFRClient.ReadAnything(address:=address, throwerror_if_nOK:=throwerror_if_nOK) + End Function + Public Function GetFile(address As String, Optional throwerror_if_nOK As Boolean = True) As Byte() + Return Me.MFRClient.GetFile(address:=address, throwerror_if_nOK:=throwerror_if_nOK) + End Function + Public Async Function ReadOData(address As String, Optional throwerror_if_nOK As Boolean = True) As Task(Of ODataEnvelope) + Return Await Me.MFRClient.ReadOData(address:=address, throwerror_if_nOK:=throwerror_if_nOK) + End Function + Public Async Function getEntities(Optional throwerror_if_nOK As Boolean = True) As Task(Of String) + Return Await Me.MFRClient.getEntities(throwerror_if_nOK:=throwerror_if_nOK) + End Function + + Public Class DatabaseSchema + Private _et As EntityTypes + + Public ReadOnly Property isValid As Boolean = False + Public ReadOnly Property hasEntity As Boolean = False + + Public ReadOnly Property ThisEntityName As String + Get + Return EntityName(Me._et) + End Get + End Property + + Public ReadOnly Property EntityConfig As Dictionary(Of String, String) + Public ReadOnly Property Entitytablename As String + Public ReadOnly Property Complextypes As New Dictionary(Of String, Dictionary(Of String, String)) + Public ReadOnly Property NavProperties As New Dictionary(Of String, Dictionary(Of String, String)) + + Private _tableset As DataSet + + + + Public Sub New(et As EntityTypes) + Me._et = et + Dim DSet As SQLDataSet = System.Threading.Tasks.Task.Run(Async Function() + Return Await getSQLDataSet_async("EXECUTE [dbo].[mfr__getSchema] 'table', @tgttype;", FDSConnectionString, SqlParameterList:=New List(Of SqlClient.SqlParameter) From {New SqlClient.SqlParameter("@tgttype", ThisEntityName)}, tablenames:=New String() {"entity", "complex_types", "navigation_properties", "tables"}, options:=New fds_SQLOptions()) + End Function).Result() + + Me._isValid = DSet.Count > 0 + Me._hasEntity = DSet.Tables("entity").Rows.Count = 1 + + Me._EntityConfig = If(DSet.Tables("entity").Rows.Count > 0, DSet.Tables("entity").Rows(0).toStringDictionary(), New Dictionary(Of String, String)) + Me._Entitytablename = If(Me.EntityConfig.ContainsKey("tablename"), Me.EntityConfig("tablename"), "") + + For Each ctrw As DataRow In DSet.Tables("complex_types").Rows() + Me._Complextypes.Add(ctrw.nz("name").ToLower, ctrw.toStringDictionary()) + Next + For Each nprw As DataRow In DSet.Tables("navigation_properties").Rows() + Me._NavProperties.Add(nprw.nz("name").ToLower, nprw.toStringDictionary()) + Next + Dim sql As New List(Of String) From {newDatatable_SQL(Me.Entitytablename)} 'The target entitytype's table MUST be the first + Dim tablenames As New List(Of String) From {Me.Entitytablename} + + For Each ttrw As DataRow In DSet.Tables("tables").Rows + sql.Add(newDatatable_SQL(ttrw.nz("tablename"))) + tablenames.Add(ttrw.nz("tablename")) + Next + Me._tableset = System.Threading.Tasks.Task.Run(Async Function() + Return Await getSQLDataSet_async(vbs.Join(sql.ToArray(), vbNewLine), FDSConnectionString, tablenames:=tablenames.ToArray, options:=New fds_SQLOptions()) + End Function).Result().DataSet + End Sub + + Public Function tgtDataset(SetID As String) As DataSet + Dim dset As New DataSet + For Each tbl As DataTable In Me._tableset.Tables + Dim t As DataTable = tbl.Clone + If t.Columns.Contains("setid") Then t.Columns("setid").DefaultValue = SetID + dset.Tables.Add(t) + Next + Return dset + End Function + + End Class + + +#Disable Warning BC42356 ' This async method lacks 'Await' operators and so will run synchronously + Public Async Function Update__entitytable(et As EntityTypes, UpdateNeed As fds.fds_mfr.UpdateNeed, EntityID As Long(), Optional DebugDetails As Boolean = False, Optional SchemaDic As Dictionary(Of String, DatabaseSchema) = Nothing, Optional AdditionalCommandAfter As String = "") As Threading.Tasks.Task(Of Boolean) + If et = EntityTypes.none Then Return False + EntityID = If(EntityID, New Long() {}) ''make sure is not nothing + If UpdateNeed = UpdateNeed.None AndAlso If(EntityID, New Long() {}).Length = 0 Then Return True + + Dim StartTime As DateTime = Now() + Diagnostics.Debug.Print(StartTime.ToLongTimeString() & " - " & "Start before Schema " & et.ToString) + Dim SetID As String = RandomString(5) 'generate a unique ID to identify the submitted data and prevent mixup. A table can be accessed by several batch processes in parallel. + Dim ThisEntityName As String = EntityName(et) + + + Dim DtF As New Action(Of String, String, String)(Sub(note As String, info As String, data As String) + If DebugDetails = True Then Call DebugToFile("Update__entitytable - " & note & " For " & ThisEntityName & "(" & SetID & ")" & If(If(info, "") <> "", ": " & info, ""), filename:="DebugDetail.txt") + End Sub) + Dim Dlg As New Action(Of String, String, String)(Sub(note As String, info As String, data As String) + Dim str As String = "Update__entitytable - " & note & " for " & ThisEntityName & "(" & SetID & ")" & If(If(info, "") <> "", ": " & info, "") + Call DebugLog(str, data:=If(data, "")) + If DebugDetails = True Then Call DebugToFile(str, filename:="DebugDetail.txt") + Diagnostics.Debug.Print(str) + End Sub) + + + + 'check if update processes not already in progress and set lock + Dim params As New List(Of SqlClient.SqlParameter) From { + New SqlClient.SqlParameter("@tbl", ThisEntityName), + New SqlClient.SqlParameter("@state", True), + New SqlClient.SqlParameter("@override", False), + New SqlClient.SqlParameter("@setid", SetID) + } + Dim lockstate As Object = True 'getSQLValue("EXECUTE [dbo].[ctm__admin_getTableLock] @tbl, @state, @override, @setid;", con, SqlParameterList:=params, options:=New fds_SQLOptions()) + If DebugDetails = True AndAlso lockstate.GetType() = GetType(System.Boolean) Then Call DebugToFile("Update__entitytable - lock received for " & ThisEntityName & "(" & SetID & ") - " & lockstate.ToString, filename:="DebugDetail.txt") + 'true means lock was successful + If lockstate.GetType() = GetType(System.Boolean) AndAlso DirectCast(lockstate, Boolean) = True Then + Try + 'get Schema + Dim Schema As DatabaseSchema = If(IsNothing(SchemaDic) = False AndAlso SchemaDic.ContainsKey(ThisEntityName), SchemaDic(ThisEntityName), New DatabaseSchema(et)) + If Schema.isValid = False Then + Dlg("Schema not found", "", Nothing) + ElseIf Schema.hasEntity = True Then + Dim tgtDataset As DataSet = Schema.tgtDataset(SetID:=SetID) + + Dim lastDate As SQLObject, Filter As New List(Of String), EntityIDFilter As String = "", isProcessed As Boolean = False + If If(EntityID, New Long() {}).Length = 1 Then + EntityIDFilter = "(" & EntityID(0).ToString() & "L)" + Filter.Add("") + UpdateNeed = UpdateNeed.Reset + ElseIf If(EntityID, New Long() {}).Length > 1 Then + EntityIDFilter = "" + For idx As Integer = 0 To EntityID.Length - 1 Step 50 + Filter.Add("$filter=" & EntityID.Skip(idx).Take(50).Convert(Of String)(Function(l As Long) "Id eq " & l.ToString() & "L").Join(" or ")) + Next + UpdateNeed = UpdateNeed.Reset + ElseIf UpdateNeed > UpdateNeed.Short Then + EntityIDFilter = "" + Filter.Add("") + ElseIf Schema.EntityConfig.ContainsKey("DateColumn") AndAlso If(Schema.EntityConfig("DateColumn"), "") <> "" Then + lastDate = Await getSQLValue_async(Schema.EntityConfig.nz("DateSQL").ne("SELECT MAX([" & Schema.EntityConfig("DateColumn") & "]) FROM [dbo].[" & Schema.Entitytablename & "];"), FDSConnectionString, options:=New fds_SQLOptions()) + Filter.Add(If(UpdateNeed = fds.fds_mfr.UpdateNeed.Short AndAlso IsNothing(lastDate.Result) = False AndAlso lastDate.Result.GetType() = GetType(System.DateTime), "$filter=" & Schema.EntityConfig("DateColumn") & " gt DateTime'" & DirectCast(lastDate.Result, System.DateTime).ToString(format:="yyyy\-MM\-dd") & "T00:00:00'", "")) + End If + For Each iFilter As String In Filter + If (Schema.EntityConfig.ContainsKey("url") AndAlso Schema.EntityConfig("url") <> "") AndAlso (UpdateNeed = UpdateNeed.Short AndAlso iFilter <> "") OrElse (UpdateNeed > UpdateNeed.Short) Then + isProcessed = True + Diagnostics.Debug.Print(Now.ToLongTimeString() & " - " & "Start MFR " & Schema.Entitytablename) + Dim MFR_Response As ODataEnvelope = Await ReadOData(Me.MFRClient.clientConfig.BaseUrl & Schema.EntityConfig("url").Replace("?", EntityIDFilter & "?") & If(iFilter <> "" AndAlso Schema.EntityConfig("url").Contains("?") = False, "?", If(iFilter <> "", "&", "")) & iFilter) + Diagnostics.Debug.Print(Now.ToLongTimeString() & " - " & "End MFR " & Schema.Entitytablename) + Do Until IsNothing(MFR_Response) = True + If MFR_Response.value.GetType() = GetType(JObject) Then + MFR_Response.ConvertToArray() + End If + Try + + If MFR_Response.value.GetType() = GetType(JArray) AndAlso IsNothing(DirectCast(MFR_Response.value, Newtonsoft.Json.Linq.JContainer).First) = False AndAlso DirectCast(DirectCast(DirectCast(MFR_Response.value, Newtonsoft.Json.Linq.JContainer).First, Newtonsoft.Json.Linq.JContainer).First, Newtonsoft.Json.Linq.JProperty).Name = "odata.error" AndAlso DirectCast(MFR_Response.value, Newtonsoft.Json.Linq.JContainer).First.ToString().IndexOf("Sequence contains no elements", 0, StringComparison.InvariantCultureIgnoreCase) > -1 Then + MFR_Response.value = New JArray() + End If + Catch jbex As Exception + End Try + If MFR_Response.value.GetType() = GetType(JArray) Then + Diagnostics.Debug.Print(Now.ToLongTimeString() & " - " & DirectCast(MFR_Response.value, JArray).Count & ":" & tgtDataset.Tables(Schema.Entitytablename).Rows.Count & "- this " & Strings.Right(MFR_Response.url, 10)) + For Each vi As JObject In MFR_Response.value + Dim vdic As Dictionary(Of String, Object) = vi.ToObject(Of Dictionary(Of String, Object)) + Dim etrow As DataRow = tgtDataset.Tables(Schema.Entitytablename).NewRow + etrow.Item("setid") = SetID + etrow.Item("Id") = vdic("Id") + For Each vkey As String In vdic.Keys + If IsNothing(vdic(vkey)) = False Then + If Schema.Complextypes.ContainsKey(vkey.ToLower) AndAlso Schema.Complextypes(vkey.ToLower)("name") <> "CustomValues" Then + Call StoreCP(tgtDataset, etrow, Schema.Complextypes, CP:=vdic(vkey), EntityProperty:=ThisEntityName & ":" & vkey, vkey:=vkey, setid:=SetID, vdic:=vdic) + ElseIf Schema.Complextypes.ContainsKey(vkey.ToLower) AndAlso Schema.Complextypes(vkey.ToLower)("name") = "CustomValues" Then + If etrow.Table.Columns.Contains(vkey) Then etrow.Item(vkey) = json.SerializeObject(vdic(vkey)) + ElseIf Schema.NavProperties.ContainsKey(vkey.ToLower) Then + Call StoreNP(tgtDataset, Schema.Complextypes, Schema.NavProperties(vkey.ToLower), NP:=vdic(vkey), EntityProperty:=ThisEntityName & ":" & vkey, setid:=SetID, vdic:=vdic) + Else + If etrow.Table.Columns.Contains(vkey) Then + If vdic(vkey).GetType() = GetType(System.DateTime) Then + If Year(vdic(vkey)) > 1900 Then etrow.Item(vkey) = vdic(vkey) + ElseIf vdic(vkey).GetType = etrow.Table.Columns(vkey).DataType Then + etrow.Item(vkey) = vdic(vkey) + ElseIf vdic(vkey).GetType = GetType(String) And vdic(vkey).GetType() <> etrow.Table.Columns(vkey).DataType Then + Try + etrow.Item(vkey) = DirectCast(vdic(vkey), System.String).TryConvert(etrow.Table.Columns(vkey).DataType) + Catch cgvex As Exception + Try + etrow.Item(vkey) = vdic(vkey) + Catch cvex As Exception + Diagnostics.Debug.Print(Now.ToLongTimeString() & " - " & "cvex inner " & cvex.Message) + End Try + End Try + Else + Try + etrow.Item(vkey) = vdic(vkey) + Catch cvex As Exception + Diagnostics.Debug.Print(Now.ToLongTimeString() & " - " & "cvex outer " & cvex.Message) + End Try + End If + End If + End If + End If + Next + tgtDataset.Tables(Schema.Entitytablename).Rows.Add(etrow) + tgtDataset.Tables(Schema.Entitytablename).AcceptChanges() + Next + Else + Diagnostics.Debug.Print(Now.ToLongTimeString() & " - " & " MFR_Response not jArray") + End If + If IsNothing(MFR_Response.nextlink) = False AndAlso MFR_Response.nextlink.ToString <> "" Then + MFR_Response = Await ReadOData(MFR_Response.nextlink.ToString) + Else + MFR_Response = Nothing + End If + + Loop + End If + Next iFilter + + Diagnostics.Debug.Print(Now.ToLongTimeString() & " - " & "Start SQL " & Schema.Entitytablename) + If isProcessed = True Then + For Each tbl As DataTable In tgtDataset.Tables + Dim trc As Integer = tbl.Rows.Count + If trc > 0 OrElse If(EntityID, New Long() {}).Length > 0 Then + Try + tbl.AcceptChanges() + Dim dtwa As New DatatableWriterAsync(tbl, FDSConnectionString) + dtwa.CommandAfterError = New SqlClient.SqlCommand("SELECT * INTO [t_" & SetID.ToLower & "_" & tbl.TableName & "] FROM " & dtwa.DestinationTableName & ";") + + dtwa.CommandAfter = New SqlClient.SqlCommand('"SELECT * INTO [t_" & SetID.ToLower & "_" & tbl.TableName & "] FROM " & dtwa.DestinationTableName & ";" & + "EXECUTE [dbo].[" & (tbl.TableName).Replace("__", "__updt__") & "] @tblname, @referencetable, @tgtid;" & + "EXECUTE [dbo].[fds__setStatus] @table,@action,@setid,@info;" & If(AdditionalCommandAfter, "")) + dtwa.CommandAfter.Parameters.AddRange(New SqlClient.SqlParameter() { + New SqlClient.SqlParameter("@tblname", dtwa.DestinationTableName), + New SqlClient.SqlParameter("@table", tbl.TableName), + New SqlClient.SqlParameter("@action", If(tbl.TableName.ToLower = Schema.Entitytablename.ToLower, "update_", "imdu_") & UpdateNeed.ToString().ToLower()), + New SqlClient.SqlParameter("@setid", SetID.ToLower), + New SqlClient.SqlParameter("@entityname", Schema.ThisEntityName), + New SqlClient.SqlParameter("@info", json.SerializeObject(New With {.count = trc, .reference = Schema.Entitytablename, .id = If(If(EntityID, New Long() {}).Length > 0, vbs.Join(EntityID.Convert(Of String)(Function(x As Long) x.ToString).ToArray, ","), Nothing)})), + New SqlClient.SqlParameter("@referencetable", Schema.Entitytablename), + New SqlClient.SqlParameter("@tgtid", If(If(EntityID, New Long() {}).Length > 0, EntityID(0).ToString, DBNull.Value)) + }) + Diagnostics.Debug.Print("tbs:" & tbl.TableName & " - " & dtwa.DestinationTableName & " - " & SetID.ToLower) + dtwa.DoSubmit() + Catch dsex As Exception + Dlg("Submission issue", dsex.Message, "table: " & tbl.TableName) + End Try + Diagnostics.Debug.Print("OK") + End If + Next + Diagnostics.Debug.Print(Now.ToLongTimeString() & " - " & "End SQL " & Schema.Entitytablename) + End If + End If + Catch ex As Exception + Dlg(ex.Message, "", ex.StackTrace) + Finally + 'release lock + params = New List(Of SqlClient.SqlParameter) From { + New SqlClient.SqlParameter("@tbl", ThisEntityName), + New SqlClient.SqlParameter("@state", False), + New SqlClient.SqlParameter("@override", False), + New SqlClient.SqlParameter("@setid", SetID) + } + Dim Exceptionmessages_gtl As String = "" + 'setSQLValue("EXECUTE [dbo].[ctm__admin_getTableLock] @tbl, @state, @override, @setid;", connectionstring:=FDSConnectionString, SqlParameterList:=params, ExceptionMessage:=Exceptionmessages_gtl) + If DebugDetails = True Then Call DebugToFile("Update__entitytable - locked released for " & ThisEntityName & "(" & SetID & ")", filename:="DebugDetail.txt") + End Try + Else + 'abort action if locked = true + Debug.Print("Updates already locked for " & ThisEntityName & "(" & SetID & ")") + If DebugDetails = True Then Call DebugToFile("Update__entitytable - Updates already locked For " & ThisEntityName & "(" & SetID & ")", filename:="DebugDetail.txt") + End If + Return True + End Function + + + + Private Function StoreCP(ByRef TgtDataset As DataSet, ByRef etrow As DataRow, Complextypes As Dictionary(Of String, Dictionary(Of String, String)), ByVal CP As Object, ByVal EntityProperty As String, ByVal vkey As String, ByVal setid As String, ByVal vdic As Dictionary(Of String, Object)) As Boolean + If CP.GetType = GetType(JArray) Then + For Each vitm As JObject In vdic(vkey) + Call StoreCP(TgtDataset, etrow, Complextypes, CP:=vitm, EntityProperty:=EntityProperty, vkey:=vkey, setid:=setid, vdic:=vdic) + Next + ElseIf CP.GetType = GetType(JObject) Then + Dim CxType As Dictionary(Of String, String) = Complextypes(vkey.ToLower) + Dim cto As Dictionary(Of String, Object) = CP.ToObject(Of Dictionary(Of String, Object)) + Dim cnr As DataRow = TgtDataset.Tables(CxType("tablename")).NewRow + cnr.Item("setid") = setid + For Each cky As String In cto.Keys + If IsNothing(cto(cky)) = False AndAlso cnr.Table.Columns.Contains(cky) Then + 'cnr.Item(cky) = cto(cky) + If cto(cky).GetType() = GetType(System.DateTime) Then + If Year(cto(cky)) > 1900 Then cnr.Item(cky) = cto(cky) + ElseIf cto(cky).GetType = cnr.Table.Columns(cky).DataType Then + cnr.Item(cky) = cto(cky) + ElseIf cto(cky).GetType = GetType(String) And cto(cky).GetType() <> cnr.Table.Columns(cky).DataType Then + Try + cnr.Item(cky) = DirectCast(cto(cky), System.String).TryConvert(cnr.Table.Columns(cky).DataType) + Catch cgvex As Exception + Try + cnr.Item(cky) = cto(cky) + Catch cvex As Exception + End Try + End Try + Else + Try + cnr.Item(cky) = cto(cky) + Catch cvex As Exception + End Try + End If + End If + Next + If cnr.Table.Columns.Contains("EntityId") Then cnr.Item("EntityId") = vdic("Id") + If cnr.Table.Columns.Contains("Property") Then cnr.Item("Property") = EntityProperty + TgtDataset.Tables(CxType("tablename")).Rows.Add(cnr) + If etrow.Table.Columns.Contains(vkey & "#ID") AndAlso cto.ContainsKey("id") Then etrow.Item(vkey & "#ID") = vdic("Id") + End If + + Return True + End Function + + Private Function StoreNP(ByRef TgtDataset As DataSet, Complextypes As Dictionary(Of String, Dictionary(Of String, String)), NavProp As Dictionary(Of String, String), ByVal NP As Object, ByVal EntityProperty As String, ByVal setid As String, ByVal vdic As Dictionary(Of String, Object)) As Boolean + If NP.GetType() = GetType(JArray) Then + For Each vitm As JObject In NP + Call StoreNP(TgtDataset:=TgtDataset, Complextypes:=Complextypes, NavProp:=NavProp, NP:=vitm, EntityProperty:=EntityProperty, setid:=setid, vdic:=vdic) + Next + ElseIf NP.GetType() = GetType(JObject) Then + Dim nto As Dictionary(Of String, Object) = NP.ToObject(Of Dictionary(Of String, Object)) + If nto.ContainsKey("Id") Then + Dim nnr As DataRow = TgtDataset.Tables(NavProp("countertable")).NewRow + Dim ncr As DataRow = TgtDataset.Tables(NavProp("tablename")).NewRow + nnr.Item("setid") = setid + For Each cky As String In nto.Keys + If IsNothing(nto(cky)) = False Then + If Complextypes.ContainsKey(cky.ToLower) AndAlso Complextypes(cky.ToLower)("name") <> "CustomValues" Then + Call StoreCP(TgtDataset:=TgtDataset, etrow:=nnr, Complextypes:=Complextypes, CP:=nto(cky), EntityProperty:=Complextypes(cky.ToLower)("EntityType") & ":" & cky, vkey:=cky, setid:=setid, vdic:=vdic) + Else + If IsNothing(nto(cky)) = False AndAlso nnr.Table.Columns.Contains(cky) Then + 'nnr.Item(cky) = nto(cky) + If nto(cky).GetType() = GetType(System.DateTime) Then + If Year(nto(cky)) > 1900 Then nnr.Item(cky) = nto(cky) + ElseIf nto(cky).GetType = nnr.Table.Columns(cky).DataType Then + nnr.Item(cky) = nto(cky) + ElseIf nto(cky).GetType = GetType(String) And nto(cky).GetType() <> nnr.Table.Columns(cky).DataType Then + Try + nnr.Item(cky) = DirectCast(nto(cky), System.String).TryConvert(nnr.Table.Columns(cky).DataType) + Catch cgvex As Exception + Try + nnr.Item(cky) = nto(cky) + Catch cvex As Exception + End Try + End Try + Else + Try + nnr.Item(cky) = nto(cky) + Catch cvex As Exception + End Try + End If + End If + End If + End If + Next + ncr.Item("EntityId") = vdic("Id") + ncr.Item("PartnerType") = NavProp("countertype") + ncr.Item("PartnerId") = nto("Id") + ncr.Item("Property") = EntityProperty + TgtDataset.Tables(NavProp("tablename")).Rows.Add(ncr) + TgtDataset.Tables(NavProp("countertable")).Rows.Add(nnr) + End If + End If + Return True + End Function + + Private Shared Function newDatatable_SQL(tablename As String) As String + Return System.String.Format("Select TOP(0) [setid] = CAST('' as varchar(50)), * FROM [dbo].[{0}];", tablename) + End Function + Private Async Function newDatatable(tablename As String, setid As String) As Task(Of DataTable) + Dim sqldt As SQLDataTable = Await getSQLDatatable_async(newDatatable_SQL(tablename:=tablename), SqlConnectionString:=FDSConnectionString, options:=New fds_SQLOptions()) + Dim dt As DataTable = sqldt.DataTable.Clone + dt.TableName = tablename + If dt.Columns.Contains("setid") = False Then dt.Columns.Add(New DataColumn("setid", GetType(System.String)) With {.MaxLength = 5}) + dt.Columns("setid").DefaultValue = setid + Return dt + End Function +#Enable Warning BC42356 ' This async method lacks 'Await' operators and so will run synchronously + + Public Async Function Update__Entitytables(Optional DebugDetails As Boolean = False, Optional tgtEntityType As Nullable(Of EntityTypes) = Nothing) As Threading.Tasks.Task + Dim UpdateTasks As New List(Of Threading.Tasks.Task) + + Dim DtF As New Action(Of String, String, String, Exception)(Sub(note As String, info As String, data As String, ex As Exception) + If DebugDetails = True Then Call DebugToFile("Update__AllEntitytables - " & note & If(If(info, "") <> "", ": " & info, ""), filename:="DebugDetail.txt", exc:=ex, data:=data) + End Sub) + Dim Dlg As New Action(Of String, String, String, Exception)(Sub(note As String, info As String, data As String, ex As Exception) + Dim str As String = "Update__AllEntitytables - " & note & If(If(info, "") <> "", ": " & info, "") + Call DebugLog(str, data:=If(data, ""), exc:=ex) + If DebugDetails = True Then Call DebugToFile(str, filename:="DebugDetail.txt", exc:=ex, data:=data) + Debug.Print(str) + End Sub) + + Try + 'get updateable tables + 'the SQL query returns all tables that have corresponding temp tables and update procedures + 'a lock status is included to determine if update processes are running + Dim UpdateableTables As SQLDataTable = Await getSQLDatatable_async("SELECT * FROM [dbo].[fds__getUpdateableTables]()" & If(tgtEntityType.HasValue, " WHERE [entity_name] = '" & tgtEntityType.Value.ToString & "'", "") & ";", FDSConnectionString, options:=New fds_SQLOptions()) + Call DtF("UpdateableTables ", UpdateableTables.Exception, "(" & If(UpdateableTables.Count > 0, UpdateableTables.DataTable.Rows.Count.ToString, " no") & " Rows)", Nothing) + + If UpdateableTables.Count > 0 AndAlso UpdateableTables.DataTable.Columns.Contains("updateneed") = True Then 'just to avoid exceptions in next steps + For Each UpdateableTable_rw As DataRow In UpdateableTables.Select("updateneed > 0", "updateneed DESC") + Dim etname As String = UpdateableTable_rw.nz("entity_name", "") + Try 'create capsule for each cycle to prevent everything fails if anything fails + If etname = "" Then + Call DtF("no entity_name received", "", json.SerializeObject(UpdateableTable_rw), Nothing) + ElseIf UpdateableTable_rw.nbool("locked", True) = False Then + Dim Tbl_UpdateNeed As UpdateNeed = UpdateableTable_rw.nint("updateneed", 0) + Dim et As generic.EntityTypes = _generic.EntityValue(etname) + If Not et = EntityTypes.none Then + Call DtF("updating: " & etname, "", json.SerializeObject(UpdateableTable_rw), Nothing) + + Await Update__entitytable(et, UpdateNeed:=Tbl_UpdateNeed, EntityID:=Nothing, DebugDetails:=DebugDetails) + Call DtF("updating task completed", "", "", Nothing) + Else + Call DtF("entitytype not known", "", json.SerializeObject(New With {.etname = etname}), Nothing) + End If + Else + Call DtF("Table update locked" & etname, "", json.SerializeObject(UpdateableTable_rw), Nothing) + End If + Catch tableupdate_ex As Exception + Call Dlg("updatepart failed - " & etname, "", json.SerializeObject(UpdateableTable_rw), tableupdate_ex) + End Try + Next UpdateableTable_rw + End If + Catch exa As Exception + Call Dlg("outer frame", "", "", Nothing) + End Try + End Function + Public Async Function Update__EntityRequests(Optional DebugDetails As Boolean = False) As Threading.Tasks.Task + Dim UpdateTasks As New List(Of Threading.Tasks.Task) + + Dim DtF As New Action(Of String, String, String, Exception)(Sub(note As String, info As String, data As String, ex As Exception) + If DebugDetails = True Then Call DebugToFile("Update__EntityRequests - " & note & If(If(info, "") <> "", ": " & info, ""), filename:="DebugDetail.txt", exc:=ex, data:=data) + End Sub) + Dim Dlg As New Action(Of String, String, String, Exception)(Sub(note As String, info As String, data As String, ex As Exception) + Dim str As String = "Update__EntityRequests - " & note & If(If(info, "") <> "", ": " & info, "") + Call DebugLog(str, data:=If(data, ""), exc:=ex) + If DebugDetails = True Then Call DebugToFile(str, filename:="DebugDetail.txt", exc:=ex, data:=data) + Debug.Print(str) + End Sub) + + Try + 'get updateable tables + 'the SQL query returns all tables that have corresponding temp tables and update procedures + 'a lock status is included to determine if update processes are running + Dim UpdateableRequests As SQLDataTable = Await getSQLDatatable_async("SELECT * FROM [dbo].[fds__getUpdateableRequests]();", FDSConnectionString, options:=New fds_SQLOptions()) + Call DtF("UpdateableRequests ", UpdateableRequests.Exception, "(" & If(UpdateableRequests.Count > 0, UpdateableRequests.DataTable.Rows.Count.ToString, " no") & " Rows)", Nothing) + + If UpdateableRequests.Count > 0 Then 'just to avoid exceptions in next steps + For Each UpdateableRequest_rw As DataRow In UpdateableRequests.Select("", "order") + Dim etname As String = UpdateableRequest_rw.nz("entity_name", "") + Dim tgtid As Long = UpdateableRequest_rw.nint("Id", -1) + If tgtid > -1 AndAlso etname.IsNullOrWhiteSpace = False Then + Try 'create capsule for each cycle to prevent everything fails if anything fails + Dim et As generic.EntityTypes = _generic.EntityValue(etname) + Await Update__entitytable(et, UpdateNeed:=UpdateNeed.Reset, EntityID:=New Long() {tgtid}, DebugDetails:=DebugDetails, AdditionalCommandAfter:="DELETE FROM [dbo].[fds__mfr_updaterequests] WHERE LOWER([entity_name]) = LOWER(ISNULL(@entityname,'')) AND CAST(ISNULL([Id],'') as varchar(1000)) = @tgtid;") + + Catch tableupdate_ex As Exception + Call Dlg("Update__EntityRequest single failed - " & etname, "", json.SerializeObject(UpdateableRequest_rw), tableupdate_ex) + End Try + End If + Next UpdateableRequest_rw + End If + Catch exa As Exception + Call Dlg("outer frame", "", "", Nothing) + End Try + End Function + + Public Enum PostSubmissionActionMode + full + incremental + reset + End Enum + + + + Public Sub Dispose() Implements IDisposable.Dispose + ''Me.MFRClient.Logout() + DirectCast(Me.MFRClient, IDisposable).Dispose() + End Sub + + + + + End Class + +End Namespace \ No newline at end of file diff --git a/DataService_Legacy/fds_shared.vb b/DataService_Legacy/fds_shared.vb new file mode 100644 index 0000000..c12d49e --- /dev/null +++ b/DataService_Legacy/fds_shared.vb @@ -0,0 +1,226 @@ + + +Friend Module fds_shared + + Friend Function SQLConnectionString() As String + Return Configuration.ConfigurationManager.ConnectionStrings("fuchs_ConnectionString").ConnectionString + End Function + Friend Function FDSConnectionString() As String + Return Configuration.ConfigurationManager.ConnectionStrings("fuchs_fds_ConnectionString").ConnectionString + End Function + Friend Function SqlCon() As SqlClient.SqlConnection + Return New SqlClient.SqlConnection(Configuration.ConfigurationManager.ConnectionStrings("fuchs_ConnectionString").ConnectionString) + End Function + + + + Public Function RandomString(rs_length As Byte) As String + Dim r As New Random() + Dim s As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" + Dim sb As New Text.StringBuilder + For i As Byte = 1 To rs_length + Dim idx As Integer = r.Next(0, s.Length) + sb.Append(s.Substring(idx, 1)) + Next + Return sb.ToString() + End Function + + + '''' + '''' Returns a delimited containing the field values from a . + '''' + '''' + '''' The input . + '''' + '''' + '''' The delimiter placed between field values. the default value is a comma. + '''' + '''' + '''' A containing the field values from the row separated by the specified delimiter. + '''' + ' + 'Public Function ToCsv(source As DataRow, + ' Optional delimiter As String = ",") As String + ' Return String.Join(delimiter, source.ItemArray) + 'End Function + + ''' + ''' Returns a delimited containing the field values from a . + ''' + ''' + ''' The input . + ''' + ''' + ''' True to wrap values in double-quotes; otherwise, False. + ''' If double-quotes are added, double-quotes within text are escaped with another double-quote. + ''' + ''' + ''' The delimiter placed between field values. the default value is a comma. + ''' + ''' + ''' A containing the field values from the row separated by the specified delimiter. + ''' + + Public Function ToCsv(source As DataRow, + quoteStrings As Boolean, + cultureinfo As Globalization.CultureInfo, + Optional delimiter As String = ",") As String + Dim fieldValues = source.ItemArray + + + Dim rx As New Text.RegularExpressions.Regex("(\"")") + 'Wrap any String values in double-quotes and also escape any double-quotes in the String with another double-quote. + 'replace array by converted array + fieldValues = fieldValues.Select(Function(o) + If IsNothing(o) OrElse IsDBNull(o) Then + Return "" + ElseIf o.GetType = GetType(String) Then + If quoteStrings = True Then + Return Microsoft.VisualBasic.ChrW(34) & rx.Replace(o.ToString, Microsoft.VisualBasic.ChrW(34) & Microsoft.VisualBasic.ChrW(34)) & Microsoft.VisualBasic.ChrW(34) + Else + Return o.ToString + End If + Else + Select Case o.GetType + Case GetType(Decimal) + Return DirectCast(o, Decimal).ToString(cultureinfo) + Case GetType(Single) + Return DirectCast(o, Single).ToString(cultureinfo) + Case GetType(Double) + Return DirectCast(o, Double).ToString(cultureinfo) + Case GetType(Boolean) + Return DirectCast(o, Boolean).ToString(cultureinfo) + Case GetType(System.DateTime) + Return DirectCast(o, DateTime).ToUniversalTime.ToString("U") + Case Else + Return o.ToString() + End Select + End If + End Function).ToArray() + + + Return String.Join(delimiter, fieldValues) + End Function + + + + ''' + ''' Returns a delimited containing the field values from the rows a . + ''' + ''' The input . + ''' True to include a row of column headers; otherwise, False + ''' True to wrap values in double-quotes; otherwise, False. + ''' If double-quotes are added, double-quotes within text are escaped with another double-quote. + ''' The delimiter placed between rows. the default value is a line break comprising a carriage return and a line feed. + ''' The delimiter placed between field values. the default value is a comma. + ''' The culture that is used to convert float-point numbers like or to string.
This falls back to InvariantCulture, if not provided. + ''' True to wrap column header names in double-quotes; otherwise, False.
+ ''' If no value is provided, the settings falls back to quoteStrings parameter. + ''' A containing the field values from the rows of the table separated by the specified delimiters. + + Public Function ToCsv(source As DataTable, + includeHeaders As Boolean, + quoteStrings As Boolean, + Optional rowDelimiter As String = ControlChars.CrLf, + Optional fieldDelimiter As String = ",", + Optional cultureinfo As Globalization.CultureInfo = Nothing, + Optional quoteHeader As Boolean? = Nothing) As String + If quoteHeader.HasValue = False Then quoteHeader = quoteStrings + cultureinfo = If(cultureinfo, Globalization.CultureInfo.InvariantCulture) 'fallback if not provided + Dim rows = source.Rows. + Cast(Of DataRow)(). + Select(Function(row) row.ToCsv(quoteStrings:=quoteStrings, cultureinfo:=cultureinfo, delimiter:=fieldDelimiter)) + + If includeHeaders = True Then + Dim rx As New Text.RegularExpressions.Regex("(\"")") + Dim headers = String.Join(fieldDelimiter, + source.Columns. + Cast(Of DataColumn)(). + Select(Function(column) If(quoteHeader.Value, + Microsoft.VisualBasic.ChrW(34) & rx.Replace(column.ColumnName.ToString, Microsoft.VisualBasic.ChrW(34) & Microsoft.VisualBasic.ChrW(34)) & Microsoft.VisualBasic.ChrW(34), + column.ColumnName))) + + rows = {headers}.Concat(rows) + End If + + Return String.Join(rowDelimiter, rows) + End Function + + ''' + ''' Returns a text-file containing the string, created by streamwriter. + ''' + ''' The input . + ''' The encoding used with streamwriter for the textfile. This falls back to , if not provided. + ''' A file as byte-array. + + Public Function ToByteArray(input As String, Optional encoding As System.Text.Encoding = Nothing) As Byte() + Dim content As Byte() = Nothing + Using ms As New IO.MemoryStream + Using sw As New IO.StreamWriter(ms, encoding:=If(encoding, System.Text.Encoding.UTF8)) + sw.Write(input) + sw.Flush() + ms.Position = 0 + content = ms.ToArray() + End Using + End Using + Return content + End Function + + + Public Function WriteStreamToDisk(ByVal StreamToWrite As IO.Stream, ByVal FilePath As String) As Boolean + 'Dim tmpFilePath As String = Left(FilePath, Len(FilePath) - 4) & ".tmp" + Dim cnt = 0 +restart: + Try + If My.Computer.FileSystem.FileExists(FilePath) Then My.Computer.FileSystem.DeleteFile(FilePath) + Using FleStream As System.IO.FileStream = New System.IO.FileStream(FilePath, System.IO.FileMode.Create, System.IO.FileAccess.Write, System.IO.FileShare.Delete) + ReadWriteStream(StreamToWrite, FleStream, True) + End Using + Catch ex As Exception + System.Diagnostics.Debug.WriteLine($"{"WriteStreamToDisk - " & ex.Message}") + cnt += 1 + If cnt = 6 Then + Return False + Exit Function + Else + Threading.Thread.Sleep(500) + GoTo restart + End If + End Try + Return True + End Function + + Public Function ReadWriteStream(ByVal readStream As IO.Stream, ByVal writeStream As IO.Stream, ByVal closeWriteStream As Boolean) As Boolean + Try + Dim Length As Integer = 256 + Dim buffer(Length - 1) As Byte + readStream.Seek(0, System.IO.SeekOrigin.Begin) + Dim bytesRead As Integer = readStream.Read(buffer, 0, Length) + 'write the required bytes + While (bytesRead > 0) + writeStream.Write(buffer, 0, bytesRead) + bytesRead = readStream.Read(buffer, 0, Length) + End While + readStream.Close() + If closeWriteStream = True Then writeStream.Close() + Return True + Catch ex As Exception + System.Diagnostics.Debug.WriteLine($"{"ReadWriteStream - " & ex.Message}") + Call OCMS.debug_log("files_folders ReadWriteStream", ex) + Return False + End Try + End Function + + + + Public Function NameBase(ByVal FI As System.IO.FileInfo) As String + Return FI.Name.Substring(startIndex:=0, length:=FI.Name.Length - FI.Extension.Length) + End Function + + + + + Public Function MimeType(ByVal FI As System.IO.FileInfo) As String + Return System.Web.MimeMapping.GetMimeMapping(FI.Name) + End Function +End Module diff --git a/DataService_Legacy/fds_zip.vb b/DataService_Legacy/fds_zip.vb new file mode 100644 index 0000000..523953f --- /dev/null +++ b/DataService_Legacy/fds_zip.vb @@ -0,0 +1,500 @@ +Imports SevenZip 'Squid-Box.SevenZipSharp +Imports System.IO + +Namespace Global.fds + Public Class Archive + Implements IDisposable + + 'Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long + 'Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) + + 'Public Enum Timeunit As Long + ' Milliseconds = 0 + ' Seconds = 1000 + ' Minutes = 60000 + 'End Enum + 'Public Sub Wait(ByVal No As Integer, ByVal unit As Timeunit) + ' Dim tme As Long = CLng(No * unit) + ' Sleep(tme) + 'End Sub + + Public Event Saving() + Public Event FileSaved() + Public Event FileStreamCreated() + + Private _ArchiveFile As FileInfo + Private _ArchivePassword As String + Private _ArchiveFormat As OutArchiveFormat + Public TempPath As String = System.AppDomain.CurrentDomain.BaseDirectory + Public Property ArchiveFileStream As IO.Stream + + Private ZipOut As SevenZipExtractor + Private ZipIn As SevenZipCompressor + Public ZipAppend As Boolean = True + + Public ExitOK As Boolean = False + Public ZipInOK As Boolean = False + + Public Sub New(ByVal ArchiveFile As FileInfo, Optional ByVal ArchivePassword As String = "", Optional ByVal INIT As Boolean = True, Optional ByVal Type As OutArchiveFormat = OutArchiveFormat.SevenZip) + Me._ArchiveFormat = Type + Me._ArchiveFile = New FileInfo(ArchiveFile.FullName.Replace(ArchiveFile.Extension, If(Type = OutArchiveFormat.SevenZip, ".7z", ArchiveFile.Extension))) + Me._ArchivePassword = ArchivePassword + If INIT = True Then Call InitZipIn(Type) + End Sub + + Private Sub InitZipIn(ByVal Type As OutArchiveFormat) + Dim assemblydirectory As IO.DirectoryInfo + If Zipping.SevenZipPath = "" Then + Try + assemblydirectory = New IO.DirectoryInfo(New Uri(System.IO.Path.GetDirectoryName(System.Reflection.Assembly.GetExecutingAssembly().GetName().CodeBase)).LocalPath) + Dim zip As IO.FileInfo = assemblydirectory.GetFiles("7z.dll", SearchOption.AllDirectories).FirstOrDefault + Zipping.SevenZipPath = If(IsNothing(zip), "", zip.FullName) + Finally + If Zipping.SevenZipPath = "" Then + assemblydirectory = New IO.DirectoryInfo(System.AppDomain.CurrentDomain.BaseDirectory) + Dim zip As IO.FileInfo = assemblydirectory.GetFiles("7z.dll", SearchOption.AllDirectories).FirstOrDefault + Zipping.SevenZipPath = If(IsNothing(zip), "", zip.FullName) + End If + End Try + If Zipping.SevenZipPath = "" Then + OCMS.debug_log("DDA.intranet.Zipping Archive InitZipIn", error:="SevenZipPath not found") + End If + End If + SevenZipCompressor.SetLibraryPath(SevenZipPath) + + Me.ZipIn = New SevenZipCompressor + With Me.ZipIn + If Type = OutArchiveFormat.SevenZip AndAlso Me._ArchiveFile.Extension.ToLower.Contains("7z") = True Then + .ArchiveFormat = OutArchiveFormat.SevenZip + Else + .ArchiveFormat = Type + End If + + .CompressionLevel = SevenZip.CompressionLevel.Ultra + Select Case .ArchiveFormat + Case OutArchiveFormat.SevenZip + .CompressionMethod = SevenZip.CompressionMethod.Lzma2 + Case OutArchiveFormat.Zip, OutArchiveFormat.GZip + .CompressionMethod = CompressionMethod.Deflate + Case Else + .CompressionMethod = CompressionMethod.Default + End Select + + If ZipAppend = True Then + .CompressionMode = SevenZip.CompressionMode.Append + Else + .CompressionMode = SevenZip.CompressionMode.Create + End If + .DirectoryStructure = False + End With + Me.ZipInOK = True + End Sub + + Public Sub Extract(ByVal DataArchiveFilePath As FileInfo, ByVal TgtDirectory As DirectoryInfo, Optional ByVal Type As OutArchiveFormat = Nothing) + If DataArchiveFilePath.Exists Then + If IsNothing(Type) = True AndAlso DataArchiveFilePath.Extension.ToLower.Contains("7z") = True Then + Type = OutArchiveFormat.SevenZip + ElseIf IsNothing(Type) = True Then + Type = OutArchiveFormat.Zip + End If + + If Me.ZipInOK = False Then Call InitZipIn(Type) + + If Me._ArchivePassword = "" Then + Me.ZipOut = New SevenZipExtractor(DataArchiveFilePath.FullName) + Else + Me.ZipOut = New SevenZipExtractor(DataArchiveFilePath.FullName, Me._ArchivePassword) + End If + + Try + If Me.ZipOut.ArchiveFileData(0).Encrypted = False And Not Me._ArchivePassword = "" Then + Me._ArchivePassword = "" + End If + Catch ex As Exception + System.Diagnostics.Debug.WriteLine($"{"zip Extract - " & ex.Message}") + OCMS.debug_log("DDA.intranet.Zipping Archive InitZipIn", ex:=ex, data:=New With {.DataArchiveFilePath = DataArchiveFilePath.FullName, .TgtDirectory = TgtDirectory.FullName}) + Exit Sub + End Try + + If Not ZipOut Is Nothing Then + Me.ZipOut.ExtractArchive(TgtDirectory.FullName) + Me.ZipOut.Dispose() + End If + End If + End Sub + + Public Function FileInfo_to_Filepaths_Converter() As Converter(Of FileInfo, String) + Return New Converter(Of FileInfo, String)(Function(filepath As FileInfo) filepath.FullName()) + End Function + Public Function Filepaths_to_FileInfo_Converter() As Converter(Of String, FileInfo) + Return New Converter(Of String, FileInfo)(Function(filepath As String) New FileInfo(filepath)) + End Function + + Public Function Compress(ByVal FilePaths As List(Of String), Optional ByVal ArchiveFilePath As String = Nothing, Optional ByVal ArchivePass As String = Nothing, Optional ByVal Type As OutArchiveFormat = OutArchiveFormat.SevenZip) As Boolean + Return Compress(Files:=FilePaths.ConvertAll(Filepaths_to_FileInfo_Converter()), ArchiveFile:=If(IsNothing(ArchiveFilePath), Nothing, New FileInfo(ArchiveFilePath)), ArchivePass:=ArchivePass, Type:=Type) + End Function + Public Function Compress(ByVal Files As List(Of FileInfo), Optional ByVal ArchiveFile As FileInfo = Nothing, Optional ByVal ArchivePass As String = Nothing, Optional ByVal Type As OutArchiveFormat = OutArchiveFormat.SevenZip) As Boolean + If Files.Count = 0 Then Return True + If Me.ZipInOK = False Then Call InitZipIn(Type) + + If IsNothing(ArchiveFile) = True Then ArchiveFile = Me._ArchiveFile + If If(IsNothing(ArchivePass), "", ArchivePass) = "" Then ArchivePass = Me._ArchivePassword + + If ArchiveFile.Exists() AndAlso Me.ZipAppend = True Then + Me.ZipIn.CompressionMode = CompressionMode.Append + Else + If ArchiveFile.Exists = True Then ArchiveFile.Delete() + Me.ZipIn.CompressionMode = CompressionMode.Create + End If + + Try + Dim FilesVerified As FileInfo() = Files.Where(Function(f As FileInfo) f.Exists).ToArray() + Dim FilePaths As String() = Array.ConvertAll(Of FileInfo, String)(FilesVerified, FileInfo_to_Filepaths_Converter()) + If ArchivePass = "" Then + Me.ZipIn.CompressFiles(ArchiveFile.FullName, FilePaths) + Else + Me.ZipIn.EncryptHeaders = True + Me.ZipIn.ZipEncryptionMethod = ZipEncryptionMethod.Aes256 + Me.ZipIn.CompressFilesEncrypted(ArchiveFile.FullName, ArchivePass, FilePaths) + End If + RaiseEvent FileSaved() + + 'Debug.Print("Saved: " & Now().ToString) + Me.ExitOK = True + 'Disposing... + Me.ZipIn = Nothing + Me.ZipInOK = False + Catch ex As Exception + 'Debug.Print("NOT Saved: " & Now().ToString) + Me.ExitOK = False + End Try + Return Me.ExitOK AndAlso ArchiveFile.Exists + End Function + Public Function Compress(ByVal FilePath As String) As Boolean + Dim FL As New List(Of String) From { + FilePath + } + Call Compress(FL) + Return True + End Function + Public Function CompressToStream(ByVal FilePath As String) As Boolean + Dim FL As New List(Of String) From { + FilePath + } + Call CompressToStream(FL) + Return True + End Function + + Public Function CompressToStream(ByVal FilePaths As List(Of String)) As Boolean + Return CompressToStream(Files:=FilePaths.ConvertAll(Filepaths_to_FileInfo_Converter())) + End Function + Public Function CompressToStream(ByVal Files As List(Of FileInfo)) As Boolean + If Files.Count = 0 Then Return True + If Me.ZipInOK = False Then Call InitZipIn(Me._ArchiveFormat) + + If IsNothing(_ArchiveFileStream) Then 'nur wenn der interne leer ist... + Me.ZipIn.CompressionMode = CompressionMode.Create + Me._ArchiveFileStream = New MemoryStream + Else + Me.ZipIn.CompressionMode = CompressionMode.Append + End If + + Try + Dim FilesVerified As FileInfo() = Files.Where(Function(f As FileInfo) f.Exists).ToArray() + Dim FilePaths As String() = Array.ConvertAll(Of FileInfo, String)(FilesVerified, FileInfo_to_Filepaths_Converter()) + If Me._ArchivePassword = "" Then + Me.ZipIn.CompressFiles(Me._ArchiveFileStream, FilePaths) + Else + Me.ZipIn.EncryptHeaders = True + Me.ZipIn.ZipEncryptionMethod = ZipEncryptionMethod.Aes256 + Me.ZipIn.CompressFilesEncrypted(Me._ArchiveFileStream, Me._ArchivePassword, FilePaths) + End If + Me._ArchiveFileStream.Seek(0, SeekOrigin.Begin) + RaiseEvent FileStreamCreated() + + 'Debug.Print("Saved: " & Now().ToString) + Me.ExitOK = True + 'Disposing... + Me.ZipIn = Nothing + Me.ZipInOK = False + Catch ex As Exception + 'Debug.Print("NOT Saved: " & Now().ToString) + Me.ExitOK = False + End Try + Return Me.ExitOK + End Function + + Public Function CompressToStream(ByVal Files As List(Of FileInfo), ByRef TargetStream As IO.Stream) As Boolean + If Files.Count = 0 Then Return True + If Me.ZipInOK = False Then Call InitZipIn(Me._ArchiveFormat) + + If IsNothing(TargetStream) = True Then + TargetStream = New MemoryStream + End If + Me.ZipIn.CompressionMode = CompressionMode.Create + Dim FilePaths As String() = New String() {} + Try + Dim FilesVerified As FileInfo() = Files.Where(Function(f As FileInfo) f.Exists).ToArray() + FilePaths = Array.ConvertAll(Of FileInfo, String)(FilesVerified, FileInfo_to_Filepaths_Converter()) + If Me._ArchivePassword = "" Then + Me.ZipIn.CompressFiles(TargetStream, FilePaths) + Else + Me.ZipIn.EncryptHeaders = True + Me.ZipIn.ZipEncryptionMethod = ZipEncryptionMethod.Aes256 + Me.ZipIn.CompressFilesEncrypted(TargetStream, Me._ArchivePassword, FilePaths) + End If + TargetStream.Seek(0, SeekOrigin.Begin) + + 'Debug.Print("Saved: " & Now().ToString) + Me.ExitOK = True + 'Disposing... + Me.ZipIn = Nothing + Me.ZipInOK = False + Catch ex As Exception + 'Debug.Print("NOT Saved: " & Now().ToString) + OCMS.debug_log("IntranetController zip", ex, data:=New With {.filepaths = FilePaths}) + Me.ExitOK = False + End Try + Return Me.ExitOK + End Function + + + Public Function CompressToStream(ByVal Files As Dictionary(Of String, IO.Stream)) As Boolean + If Files.Count = 0 Then Return True + If Me.ZipInOK = False Then Call InitZipIn(Me._ArchiveFormat) + + If IsNothing(_ArchiveFileStream) Then 'nur wenn der interne leer ist... + Me.ZipIn.CompressionMode = CompressionMode.Create + Me._ArchiveFileStream = New MemoryStream + Else + Me.ZipIn.CompressionMode = CompressionMode.Append + End If + + Try + If Me._ArchivePassword = "" Then + Me.ZipIn.CompressStreamDictionary(streamDictionary:=Files, Me._ArchiveFileStream) + Else + Me.ZipIn.EncryptHeaders = True + Me.ZipIn.ZipEncryptionMethod = ZipEncryptionMethod.Aes256 + Me.ZipIn.CompressStreamDictionary(streamDictionary:=Files, Me._ArchiveFileStream, password:=Me._ArchivePassword) + End If + Me._ArchiveFileStream.Seek(0, SeekOrigin.Begin) + RaiseEvent FileStreamCreated() + + 'Debug.Print("Saved: " & Now().ToString) + Me.ExitOK = True + 'Disposing... + Me.ZipIn = Nothing + Me.ZipInOK = False + Catch ex As Exception + 'Debug.Print("NOT Saved: " & Now().ToString) + Me.ExitOK = False + End Try + Return Me.ExitOK + End Function + Public Function CompressToStream(ByVal Files As Dictionary(Of String, Byte()), Optional targetstream As IO.Stream = Nothing) As Boolean + If Files.Count = 0 Then Return True + If Me.ZipInOK = False Then Call InitZipIn(Me._ArchiveFormat) + + If IsNothing(_ArchiveFileStream) Then 'nur wenn der interne leer ist... + Me.ZipIn.CompressionMode = CompressionMode.Create + Me._ArchiveFileStream = New MemoryStream + Else + Me.ZipIn.CompressionMode = CompressionMode.Append + End If + + Try + Dim FilesStreams As New Dictionary(Of String, IO.Stream) + For Each fy As String In Files.Keys + FilesStreams.Add(fy, New IO.MemoryStream(Files(fy))) + Next + + If Me._ArchivePassword = "" Then + Me.ZipIn.CompressStreamDictionary(streamDictionary:=FilesStreams, If(IsNothing(targetstream), Me._ArchiveFileStream, targetstream)) + Else + Me.ZipIn.EncryptHeaders = True + Me.ZipIn.ZipEncryptionMethod = ZipEncryptionMethod.Aes256 + Me.ZipIn.CompressStreamDictionary(streamDictionary:=FilesStreams, If(IsNothing(targetstream), Me._ArchiveFileStream, targetstream), password:=Me._ArchivePassword) + End If + Me._ArchiveFileStream.Seek(0, SeekOrigin.Begin) + RaiseEvent FileStreamCreated() + + 'Debug.Print("Saved: " & Now().ToString) + Me.ExitOK = True + 'Disposing... + Me.ZipIn = Nothing + Me.ZipInOK = False + Catch ex As Exception + 'Debug.Print("NOT Saved: " & Now().ToString) + Me.ExitOK = False + End Try + Return Me.ExitOK + End Function + + + Public Function WriteArchiveStreamToDisk(Optional ByVal ArchiveFile As IO.FileInfo = Nothing) As Boolean + Try + If Me._ArchiveFile.Exists() Then Me._ArchiveFile.Delete() + Catch ex As Exception + End Try + If IsNothing(ArchiveFile) = False Then 'Wenn ein DateiPfad hier übergeben wurde... + WriteStreamToDisk(Me._ArchiveFileStream, ArchiveFile.FullName) + Else ' sonst wird der interne genommen + WriteStreamToDisk(Me._ArchiveFileStream, Me._ArchiveFile.FullName) + End If + Return Me._ArchiveFile.Exists + End Function + + + + 'Private ArchiveMail As EMail = Nothing + 'Public Function SendZip(Optional ByVal Subject As String = Nothing, Optional ByVal BodyText As String = Nothing) As Boolean + ' Try + ' If ArchiveMail Is Nothing Then Exit Function + ' If Not Subject = Nothing Then + ' ArchiveMail.Subject = Subject + ' End If + ' If Not BodyText = Nothing Then + ' ArchiveMail.Body = BodyText + ' End If + ' 'Send with archive as attachment + ' Return ArchiveMail.Send(_ArchivePath.Path) + ' Catch ex As Exception + ' Return False + ' End Try + 'End Function + 'Public Function SendZipStream(Optional ByVal Subject As String = Nothing, Optional ByVal BodyText As String = Nothing) As Boolean + ' Try + ' If ArchiveMail Is Nothing Then Exit Function + ' If Not Subject = Nothing Then + ' ArchiveMail.Subject = Subject + ' End If + ' If Not BodyText = Nothing Then + ' ArchiveMail.Body = BodyText + ' End If + ' 'Send with archive as attachment + ' Return ArchiveMail.Send(_ArchivePath.Name, _ArchiveFileStream) + ' Catch ex As Exception + ' Return False + ' End Try + 'End Function + 'Public Sub SetMailSettings(ByVal SMTP As MailServer_Settings, ByVal MAIL As Mail_Settings) + ' ArchiveMail = New EMail(SMTP, MAIL) + 'End Sub + + +#Region "IDisposable Support" + Private disposedValue As Boolean ' To detect redundant calls + + ' IDisposable + Protected Overridable Sub Dispose(disposing As Boolean) + If Not disposedValue Then + If disposing Then + ' TODO: dispose managed state (managed objects). + Try + If IsNothing(Me._ArchiveFileStream) = False Then Me._ArchiveFileStream.Dispose() + If IsNothing(Me.ZipOut) = False Then Me.ZipOut.Dispose() + Me.ZipIn = Nothing + Catch ex As Exception + + End Try + End If + + ' TODO: free unmanaged resources (unmanaged objects) and override Finalize() below. + ' TODO: set large fields to null. + End If + disposedValue = True + End Sub + + ' TODO: override Finalize() only if Dispose(disposing As Boolean) above has code to free unmanaged resources. + 'Protected Overrides Sub Finalize() + ' ' Do not change this code. Put cleanup code in Dispose(disposing As Boolean) above. + ' Dispose(False) + ' MyBase.Finalize() + 'End Sub + + ' This code added by Visual Basic to correctly implement the disposable pattern. + Public Sub Dispose() Implements IDisposable.Dispose + ' Do not change this code. Put cleanup code in Dispose(disposing As Boolean) above. + Dispose(True) + ' TODO: uncomment the following line if Finalize() is overridden above. + ' GC.SuppressFinalize(Me) + End Sub +#End Region + + + End Class + + + Public Module Zipping + + Public SevenZipPath As String = "" + + Public Sub FastAppend(ByVal FileToZip As FileInfo, ByVal ArchiveFile As FileInfo) + If FileToZip.Exists AndAlso IsNothing(ArchiveFile) = False AndAlso ArchiveFile.Exists Then + Dim Zip As New Archive(ArchiveFile) With { + .ZipAppend = True + } + Dim FL As New List(Of String) From { + FileToZip.FullName + } + Zip.Compress(FL) + End If + End Sub + Public Sub FastAppend(ByVal FileToZip As FileInfo, ByVal TgtArchiveDirectory As DirectoryInfo, ByVal ArchiveName As String) + Dim ArchiveFile As New FileInfo(TgtArchiveDirectory.FullName & If(Strings.Right(TgtArchiveDirectory.FullName, 1) = "\", "", "\") & ArchiveName) + If ArchiveFile.Exists Then Call FastAppend(FileToZip, ArchiveFile:=ArchiveFile) + End Sub + Public Sub FastAppend(ByVal FileToZip As FileInfo, ByVal TgtArchiveDirectoryPath As String, ByVal ArchiveName As String) + Dim ArchiveFile As New FileInfo(TgtArchiveDirectoryPath & If(Strings.Right(TgtArchiveDirectoryPath, 1) = "\", "", "\") & ArchiveName) + If ArchiveFile.Exists Then Call FastAppend(FileToZip, ArchiveFile:=ArchiveFile) + End Sub + Public Function FastZip(ByVal DirectoryToZip As DirectoryInfo, Optional ByVal Append As Boolean = True) As IO.FileInfo + If DirectoryToZip.Exists Then + Dim ZipFile As New FileInfo(DirectoryToZip.Name + ".7z"), cnt As Integer = 0 + If Append = False Then + Do Until ZipFile.Exists = False + cnt += 1 + ZipFile = New FileInfo(DirectoryToZip.Name & "_" & CStr(cnt) & ".7z") + Loop + End If + Dim Zip As New Archive(ZipFile) With { + .ZipAppend = Append + } + Zip.Compress(New List(Of FileInfo)(DirectoryToZip.GetFiles)) + Return If(ZipFile.Exists, ZipFile, Nothing) + Else + Return Nothing + End If + End Function + Public Function FastZip(ByVal FileToZip As IO.FileInfo, Optional ByVal Append As Boolean = True) As IO.FileInfo + If FileToZip.Exists Then + Dim ZipFile As New FileInfo(FileToZip.Name.Replace("." & FileToZip.Extension, "") + ".7z"), cnt As Integer = 0 + If Append = False Then + Do Until ZipFile.Exists = False + cnt += 1 + ZipFile = New FileInfo(FileToZip.Name.Replace("." & FileToZip.Extension, "") & "_" & CStr(cnt) & ".7z") + Loop + End If + Dim Zip As New Archive(ZipFile) With { + .ZipAppend = Append + } + Dim FL As New List(Of FileInfo) From { + FileToZip + } + Zip.Compress(FL) + Return If(ZipFile.Exists, ZipFile, Nothing) + Else + Return Nothing + End If + End Function + Public Function FastZip(ByVal TgtDirectory As String, ByVal Filename As String, Optional ByVal Append As Boolean = True) As IO.FileInfo + Return FastZip(New FileInfo(TgtDirectory & If(Strings.Right(TgtDirectory, 1) = "\", "", "\") & Filename), Append) + End Function + + + + + End Module + +End Namespace diff --git a/DataService_Legacy/install.bat b/DataService_Legacy/install.bat new file mode 100644 index 0000000..bd9c444 --- /dev/null +++ b/DataService_Legacy/install.bat @@ -0,0 +1 @@ +Fuchs_Dataservice.exe install --autostart \ No newline at end of file diff --git a/DataService_Legacy/packages.config b/DataService_Legacy/packages.config new file mode 100644 index 0000000..3823bf2 --- /dev/null +++ b/DataService_Legacy/packages.config @@ -0,0 +1,9 @@ + + + + + + + + + \ No newline at end of file diff --git a/DataService_Legacy/un-install.bat b/DataService_Legacy/un-install.bat new file mode 100644 index 0000000..1312ccc --- /dev/null +++ b/DataService_Legacy/un-install.bat @@ -0,0 +1 @@ +Fuchs_Dataservice.exe uninstall \ No newline at end of file diff --git a/Intranet_Legacy/Data/ProjectToDos.html b/Intranet_Legacy/Data/ProjectToDos.html new file mode 100644 index 0000000..89d68e8 --- /dev/null +++ b/Intranet_Legacy/Data/ProjectToDos.html @@ -0,0 +1,351 @@ + + + + + + + + + + +
+

Projekt ToDos und Ideen

+ +
+ + + + + + + +

+  

+

+ -          Rechnungseditor

+

+ o   Opt. Textfeld oberhalb der Tabelle

+

+ o   Opt. Textfeld unterhalb der Tabelle

+

+ o   Textbausteine

+

+ -          Eigene Rechnung hochladen (nicht autom/online erzeugt)

+

+ §  Anlegen eines Datensatzes (zur Nummernvergabe) +

+

+ §  Upload des pdf-Dokuments

+

+ -          Rechnungen

+

+ o   UTC -> local

+

+ o   Rechnungs-Nummernkreis für FDS   (  ab R2021-1196  )

+

+ o   Storno-Rechnung

+

+ §  „Freigabe“ des Auftrags/der Aufträge

+

+ ·         wahlweise ohne Freigabe der Aufträge

+

+ §  Storno als neue Rechnung mit neg. Betrag

+

+ §  Storno als Kopie der stornierten Rechnung mit Berücksichtigung des stornierten Betrages

+

+ o   Fortsetzen von Rechnungsentwürfen

+

+ o   Löschen von Rechnungsentwürfen

+

+ o   Abschlags-Rechnungen

+

+ §  Abschlagsrechnungen erstellen

+

+ §  „Offen lassen“ von Aufträgen

+

+ §  Berücksichtigung von Abschlagsrechnungen in abschließende Rechnungen

+

+ §  Angepasste Texte für A.Rechnungen

+

+ §  Nummerierte Abschlagsrechnungen je „Hauptauftrag“

+

+ §  Anzeige der Abschlagsrechnungen unterhalb aller Aufträge und Zwischensummen

+

+ o   Zahlungs-Status anzeigen

+

+ o   Zahlungs-Summe anzeigen  (eingegangene Beträge)

+

+ o   Zugeordnete Buchungen anzeigen

+

+ o   Manuelles Abschließen  (Bezahlt markieren = ist bezahlt)

+

+ o   Manuelles Abschließen  (Bezahlt markieren = ist nicht (vollst.) bezahlt)

+

+ o   Seitenzahlen in das Layout

+

+ o   GoDB-Konforme elektronische Rechnungen

+

+ o   ZUGFeRD  Meta-Daten für E-Invoicing

+

+ o   GiroCode  (EPC-QR-Code mit Rechnungsdaten;  Banking Apps können das lesen)

+

+ §  Auf der Rechnung

+

+ §  Auf der Mahnung   (nur offener Betrag)

+

+ §  In den Emails

+

+ o   Emails individualisiert

+

+ o   Hinweis wenn keine Email-Adresse

+

+ o   Post-Versand über „Emailbrief.de“  (Die pdfs werden direkt über einen Online-Dienst postalisch versandt)

+

+ o   Änderungen Rechnung 09.06.2021

+

+ -          Auftragsname veränderbar

+

+ -          Anstatt Auftragsnamen -> Ausgeführte Arbeiten aus der Checkliste

+

+ -          Positionsnummern aktualisieren bei gelöschten Zeilen,  wenn da gewesen.

+

+ -          Keine Zwischensumme wenn nur ein Auftrag

+

+ -          Default  UsT

+

+ -          USt pro Auftrag „zusammen“ verändern

+

+ -          Finanzamtshinweis    „Als Privathaushalt     ….. von dieser Rechnung

+

+ -          Rechnungsnummer = nicht auswählbar in der Liste

+

+ -          Datum des Auftrags  bei jedem Auftrag  „01.01.21: “ +

+

+ -          Formular :   Anzahl verändern -> Gesamtbetrag verändern

+

+ -          Doppelung der Hinweistexte

+

+ -          Zeitraum

+

+ o   Auftragsliste

+

+ -          Kunden in Liste

+

+ -          Kunde in Detail-Ansicht

+

+ -          Einsatzorte korrigieren

+

+ -           

+

+ -          Datev-Export:

+

+ o   Rechnungskopie im Zip  (für nicht-MFR-Rechnungen (fds))

+

+ -          Download von Rechnungen

+

+ o   Aktualisierung des Button in der Rechnungsliste für fds-Dokumente

+

+ -          Übersicht je Kunde

+

+ o   Rechnungen

+

+ o   Aufträge

+

+ o   Kontobewegungen

+

+ -          Unterschiedliche Rechte für Rechnungen mit und ohne Preisanpassungen

+

+ -          Verarbeitung von Kontobewegungen

+

+ o   Zuordnungsliste  (alle Buchungen mit autom. + manuellen Zuordnungen)

+

+ o   Manuelle Zuordnung

+

+ o   Manuelle Bestätigung erforderlich

+

+ o   Autom. Zuordnung zu Rechnungen  (Abgleich mit Kunden- und Rechnungsinfos)

+

+ o   Überlauf  (Eingänge nicht zuordenbar)

+

+ o   Zuordnung löschen

+

+ o   Anbindung ein Banking-API System (bspw https://banksapi.de/api/) zur autom. Abfrage von Buchungen

+

+ -          Mahnungs-Modul

+

+ o   Mahnungsvorschläge

+

+ o   Mahnsperre ?

+

+ o   Mahnungserstellung +

+

+ §  3 Mahn-Stufen

+

+ §  Online-Editor

+

+ §  Autom. Versand

+

+ §  Postversand

+

+ o   Unterschiedliche Texte/Vorlagen für unterschiedliche Kunden-Typen

+

+ -          Tageszusammenfassungen

+

+ o   Neue fertige Aufträge   (für Rechnungen)

+

+ o   Neue überfällige Rechnungen  (für Mahnungen)

+

+ o   Auffällige Kontobuchungen

+

+ -          Adressbuch

+

+ o   Matching zu MFR-Kunden  (CustomerID)

+

+ o   Kontaktpersonen

+

+ o   „Liefer“-Adressen

+

+ o   Administrative Standardadressen  (Post und Email) für best. Zwecke (z.B. Rechnungen, Mahnungen, Ansprechpartner)

+

+ o   Auswahlmöglichkeit im Rechnungs- und Mahnungs-Editor

+

+ -          Email-Log

+

+ -          Sicherheit

+

+ o   Verschlüsselung der Datenbank

+

+ o   Modul-Autorisierungen

+

+ §  Unterschiedliche Rechte für Rechnungen mit und ohne Preisanpassungen

+

+ o   S/MIME-Signatur der ausgehenden Emails

+

+  

+

+  

+ + + + + + + + + \ No newline at end of file diff --git a/Intranet_Legacy/Data/image1.jpeg b/Intranet_Legacy/Data/image1.jpeg new file mode 100644 index 0000000..eda90c7 Binary files /dev/null and b/Intranet_Legacy/Data/image1.jpeg differ diff --git a/Intranet_Legacy/Data/image2.jpeg b/Intranet_Legacy/Data/image2.jpeg new file mode 100644 index 0000000..aeb0efc Binary files /dev/null and b/Intranet_Legacy/Data/image2.jpeg differ diff --git a/Intranet_Legacy/Data/image3.jpeg b/Intranet_Legacy/Data/image3.jpeg new file mode 100644 index 0000000..7b84a50 Binary files /dev/null and b/Intranet_Legacy/Data/image3.jpeg differ diff --git a/Intranet_Legacy/Data/image4.png b/Intranet_Legacy/Data/image4.png new file mode 100644 index 0000000..cec2e5f Binary files /dev/null and b/Intranet_Legacy/Data/image4.png differ diff --git a/Intranet_Legacy/Data/overlay.png b/Intranet_Legacy/Data/overlay.png new file mode 100644 index 0000000..9d9e651 Binary files /dev/null and b/Intranet_Legacy/Data/overlay.png differ diff --git a/Intranet_Legacy/Views/Partials/vpart__ocms_login.vbhtml b/Intranet_Legacy/Views/Partials/vpart__ocms_login.vbhtml new file mode 100644 index 0000000..0a37c4a --- /dev/null +++ b/Intranet_Legacy/Views/Partials/vpart__ocms_login.vbhtml @@ -0,0 +1,116 @@ +@imports OCMS +@ModelType Global.OCMS.intranet.intranet_model +@code + Dim Ctrl As Global.OCMS.intranet.Controllers.IntranetController_base = If(GetType(Global.OCMS.intranet.Controllers.IntranetController_base).IsAssignableFrom(Me.ViewContext.Controller.GetType()), DirectCast(Me.ViewContext.Controller, Global.OCMS.intranet.Controllers.IntranetController_base), Nothing) + + Dim AccountName As String = "" 'Ctrl.AccountInfo.AccountName + Dim RequestedAccount As String = "" 'Ctrl.RequestedAccount + + Dim isIE As Boolean = Global.OCMS.intranet.OCMS_intranet.isUNSupportedBrowser(Ctrl) + + Dim textsdic As New LanguageTextDic("de") + With textsdic + .Add("noie", "Dieser Browser wird leider nicht unterstützt. Bitte verwenden Sie Edge, Firefox oder Chrome.", "This browser is unfortunately not supported. Please use Edge, Firefox, or Chrome instead.") + .Add("dph", "Datenschutz", "Data Protection & Privacy") + .Add("dps", "Diese Webseite ist ein nicht-öffentliches Online-Portal. Der Zugang ist ausschließlich für autorisierte Personen der jeweiligen Organisation vorbehalten." & vbNewLine & vbNewLine & "Bei Besuch dieser Anmeldeseite werden keine personenbezogen Daten erfasst und gespeichert, die Sie nicht selbst übermitteln. Übermittelte Daten werden ohne Ihre ausdrückliche Zustimmung generell nicht an Dritte weitergegeben." & vbNewLine & + "Zur Verminderung grundsätzlicher Sicherheitsrisiken bei der Datenübertragung im Internet findet die Kommunikation mit dem Server in beiden Richtungen grundsätzlich über eine gesicherte Verbindung statt." & vbNewLine & vbNewLine & + "Für die Nutzung der Seite als angemeldeter Benutzer beachten Sie bitte die ausführliche Datenschutzerklärung.", + "This website is a private online portal. Access have only members and authorized persons of the respective organisation." & vbNewLine & vbNewLine & "At visit of this login page, no individual-related data will be captured and stored, that you did not submit yourself. Sent data will generally not be distributed to third parties without your explicit consent." & vbNewLine & + "To reduce general security risks of transmitting data over the internet is the communication with the server in both directions generally via a secured connection." & vbNewLine & vbNewLine & + "For the use of this website as registered and logged-on user, please take note of the detailed data protection statements.") + .Add("ccc", "Ich stimme der Nutzung von Cookies zur Authentifizierung im internen Bereich zu.", "I consent to the use of cookies for authenticating in the internal area.") + End With + + +End Code + +
+ +
\ No newline at end of file diff --git a/Intranet_Legacy/Views/Partials/vpart__ocms_mainnav.vbhtml b/Intranet_Legacy/Views/Partials/vpart__ocms_mainnav.vbhtml new file mode 100644 index 0000000..36096ca --- /dev/null +++ b/Intranet_Legacy/Views/Partials/vpart__ocms_mainnav.vbhtml @@ -0,0 +1,6 @@ +@imports OCMS +@ModelType Global.OCMS.intranet.intranet_model +@code + +End Code + diff --git a/Intranet_Legacy/Views/Shared/Index.vbhtml b/Intranet_Legacy/Views/Shared/Index.vbhtml new file mode 100644 index 0000000..24c139c --- /dev/null +++ b/Intranet_Legacy/Views/Shared/Index.vbhtml @@ -0,0 +1,19 @@ +@imports OCMS +@ModelType Global.OCMS.intranet.intranet_model +@Code + ViewData("Title") = "Fuchs Intranet" + + Dim Ctrl As Global.OCMS.intranet.Controllers.IntranetController_base = If(GetType(Global.OCMS.intranet.Controllers.IntranetController_base).IsAssignableFrom(Me.ViewContext.Controller.GetType()), DirectCast(Me.ViewContext.Controller, Global.OCMS.intranet.Controllers.IntranetController_base), Nothing) + Dim userident As Global.OCMS.ocms_UserIdentity = If(IsNothing(Ctrl) = False, Ctrl.UserIdent_base, Nothing) + Dim isAuth As Boolean = If(IsNothing(userident), False, userident.isAuthenticated()) + +End Code + +@Section CustomHeader + @Me.Context.MvcLink("web/fuchs.css", MinIfNotDebug:=True, appendDateSuffix:=True) + @Me.Context.MvcLink("web/fuchs.js", MinIfNotDebug:=True, appendDateSuffix:=True) +End Section + +@If isAuth = True Then + +End If diff --git a/Intranet_Legacy/Views/Shared/_Layout.vbhtml b/Intranet_Legacy/Views/Shared/_Layout.vbhtml new file mode 100644 index 0000000..78e321d --- /dev/null +++ b/Intranet_Legacy/Views/Shared/_Layout.vbhtml @@ -0,0 +1,109 @@ +@imports OCMS +@imports json = Newtonsoft.Json.JsonConvert +@ModelType Global.OCMS.intranet.intranet_model + +@code + Dim Ctrl As Global.OCMS.intranet.Controllers.IntranetController_base = If(GetType(Global.OCMS.intranet.Controllers.IntranetController_base).IsAssignableFrom(Me.ViewContext.Controller.GetType()), DirectCast(Me.ViewContext.Controller, Global.OCMS.intranet.Controllers.IntranetController_base), Nothing) + Dim userident As Global.OCMS.ocms_UserIdentity = If(IsNothing(Ctrl) = False, Ctrl.UserIdent_base, Nothing) + Dim isAuth As Boolean = If(IsNothing(userident), False, userident.isAuthenticated()) + + Dim isIE As Boolean = Global.OCMS.intranet.OCMS_intranet.isUNSupportedBrowser(Ctrl) + + Dim UserDic As New Global.OCMS.GenericObjectDictionary(If(IsNothing(userident) = False, userident.toDictionary, New Dictionary(Of String, Object))) + Dim authinfo As New Dictionary(Of String, Object) + If isAuth = True Then + UserDic.CopyTo(authinfo) + End If + authinfo.set("requestedaccount", Ctrl.RequestedAccount) + authinfo.set("accountrequired", Ctrl.isAccountRequired) + Dim textsdic As New LanguageTextDic("de") + With textsdic + .Add("lgo", "abmelden", "log out") + .Add("rsp", "Passwort ändern", "Change Password") + .Add("po", "Übersicht", "Overview") + End With +End Code + + + + + + @(If(If(Me.ViewData("Title"), "") <> "", Me.ViewData("Title"), "Intranet")) + @Me.Context.MvcLink("/web/tools.min.css", appendDateSuffix:=True) + @Me.Context.MvcLink("/web/tools.js", appendDateSuffix:=True) + + @If isAuth = True AndAlso isIE = False Then + + @Me.Context.MvcLink("/Scripts/tinymce/tinymce.js") + @Me.Context.MvcLink("/web/fis.css", appendDateSuffix:=True) + @Me.Context.MvcLink("/web/fis.js", appendDateSuffix:=True) + Else + @Me.Context.MvcLink("/web/fisb.css", appendDateSuffix:=True) + @Me.Context.MvcLink("/web/fisb.js", appendDateSuffix:=True) + End If + @RenderSection("CustomHeader", False) + @**@ + + + + +
+ @If isAuth = True AndAlso isIE = False Then + @
+ @*style="transform: translate3d(100%, 0px, 0px);" data-progress-text="100%" data-progress="99"*@ +
+
+
+
+ @
+ +@RenderSection("BodyHeader", False) +
+ @
+ @**@ +
+
+
+ @RenderBody() +
+
+ @
+ @RenderSection("BodyFooter", False) +
+ Else + Try + @Html.Partial(partialViewName:="~/Areas/intranet/Views/Partials/vpart__ocms_login.vbhtml", model:=Me.Model, viewData:=ViewData) + Catch ex As Exception + System.Diagnostics.Debug.WriteLine("partial: vpart__ocms_login" & Microsoft.VisualBasic.vbNewLine & ex.Message) + End Try + @RenderBody() + End If +
+ + diff --git a/Intranet_Legacy/Views/Shared/intranet.vbhtml b/Intranet_Legacy/Views/Shared/intranet.vbhtml new file mode 100644 index 0000000..5e1a3d3 --- /dev/null +++ b/Intranet_Legacy/Views/Shared/intranet.vbhtml @@ -0,0 +1,17 @@ +@imports OCMS +@ModelType Global.OCMS.intranet.intranet_model +@Code + ViewData("Title") = "Fuchs Intranet" + + Dim Ctrl As Global.OCMS.intranet.Controllers.IntranetController_base = If(GetType(Global.OCMS.intranet.Controllers.IntranetController_base).IsAssignableFrom(Me.ViewContext.Controller.GetType()), DirectCast(Me.ViewContext.Controller, Global.OCMS.intranet.Controllers.IntranetController_base), Nothing) + Dim userident As Global.OCMS.ocms_UserIdentity = If(IsNothing(Ctrl) = False, Ctrl.UserIdent_base, Nothing) + Dim isAuth As Boolean = If(IsNothing(userident), False, userident.isAuthenticated()) + +End Code + +@Section CustomHeader +End Section + +@If isAuth = True Then + +End If diff --git a/Intranet_Legacy/Views/_ViewStart.vbhtml b/Intranet_Legacy/Views/_ViewStart.vbhtml new file mode 100644 index 0000000..39e5344 --- /dev/null +++ b/Intranet_Legacy/Views/_ViewStart.vbhtml @@ -0,0 +1,3 @@ +@Code + Layout = "~/Views/Shared/_Layout.vbhtml" +End Code \ No newline at end of file diff --git a/Intranet_Legacy/Views/web.config b/Intranet_Legacy/Views/web.config new file mode 100644 index 0000000..dcc823b --- /dev/null +++ b/Intranet_Legacy/Views/web.config @@ -0,0 +1,36 @@ + + + + + +
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + \ No newline at end of file diff --git a/Intranet_Legacy/code/7z.dll b/Intranet_Legacy/code/7z.dll new file mode 100644 index 0000000..b32d7bf Binary files /dev/null and b/Intranet_Legacy/code/7z.dll differ diff --git a/Intranet_Legacy/code/fuchs_fds_banking.vb b/Intranet_Legacy/code/fuchs_fds_banking.vb new file mode 100644 index 0000000..dd34137 --- /dev/null +++ b/Intranet_Legacy/code/fuchs_fds_banking.vb @@ -0,0 +1,141 @@ +Option Explicit On + +Imports json = Newtonsoft.Json.JsonConvert +Imports vbs = Microsoft.VisualBasic.Strings +Imports OCMS +Imports OCMS.SQLHandling +Imports programmersdigest.MT940Parser + +Namespace Global.Fuchs.intranet.banking + Module _banking + + Public Function DebitCreditMark_Abb(Mark As DebitCreditMark) As String + Select Case Mark + Case programmersdigest.MT940Parser.DebitCreditMark.Credit + Return "C" + Case programmersdigest.MT940Parser.DebitCreditMark.Debit + Return "D" + Case programmersdigest.MT940Parser.DebitCreditMark.ReverseCredit + Return "RC" + Case programmersdigest.MT940Parser.DebitCreditMark.ReverseDebit + Return "RD" + Case Else : Return "" + End Select + End Function + + Public Function parseToDatatable(ByVal stream As IO.Stream, Optional ByVal SchemaDatatable As DataTable = Nothing) As DataTable + Dim tbl As DataTable + If IsNothing(SchemaDatatable) Then + tbl = New DataTable() + + With tbl.Columns + .Add("AccountIdentification", type:=GetType(String)) + .Add("Amount", type:=GetType(Decimal)) + .Add("BankReference", type:=GetType(String)) + '.Add("CustomerReference", type:=GetType(String)) + .Add("EntryDate", type:=GetType(Date)) + .Add("FundsCode", type:=GetType(String)) + + .Add("AccountNumberOfPayer", type:=GetType(String)) + .Add("BankCodeOfPayer", type:=GetType(String)) + .Add("CompensationAmount", type:=GetType(String)) + .Add("CreditorReference", type:=GetType(String)) + .Add("CreditorsReferenceParty", type:=GetType(String)) + .Add("CustomerReference", type:=GetType(String)) + .Add("EndToEndReference", type:=GetType(String)) + .Add("JournalNumber", type:=GetType(String)) + .Add("MandateReference", type:=GetType(String)) + .Add("NameOfPayer", type:=GetType(String)) + .Add("OriginalAmount", type:=GetType(String)) + .Add("OriginatorsIdentificationCode", type:=GetType(String)) + .Add("PayersReferenceParty", type:=GetType(String)) + .Add("PostingText", type:=GetType(String)) + .Add("SepaRemittanceInformation", type:=GetType(String)) + .Add("TextKeyAddition", type:=GetType(Integer)) + .Add("TransactionCode", type:=GetType(Integer)) + .Add("IsUnstructuredData", type:=GetType(Boolean)) + .Add("UnstructuredData", type:=GetType(String)) + .Add("UnstructuredRemittanceInformation", type:=GetType(String)) + + .Add("DebitCreditMark", type:=GetType(String)) + .Add("SupplementaryDetails", type:=GetType(String)) + .Add("TransactionTypeIdCode", type:=GetType(String)) + .Add("ValueDate", type:=GetType(Date)) + End With + Else + tbl = SchemaDatatable.Clone + End If + + Using ps As New Parser(stream:=stream) + Try + Dim stl As New List(Of Statement)(ps.Parse) + For Each statement As Statement In stl + Try + + If statement.AccountIdentification <> "" Then + For Each line As StatementLine In statement.Lines + Dim nr As DataRow = tbl.NewRow + + Dim setnfo As New Action(Of String, Object)(Sub(key As String, info As Object) + If tbl.Columns.Contains(key) Then + nr.Item(key) = info + End If + End Sub) + + setnfo("AccountIdentification", statement.AccountIdentification) + If line.Amount.HasValue = True Then setnfo("Amount", line.Amount) + setnfo("BankReference", line.BankReference) + 'setnfo("CustomerReference", line.CustomerReference) + If line.EntryDate.HasValue = True Then setnfo("EntryDate", line.EntryDate) + If line.FundsCode.HasValue = True Then setnfo("FundsCode", line.FundsCode) + With line.InformationToOwner + setnfo("AccountNumberOfPayer", .AccountNumberOfPayer) + setnfo("BankCodeOfPayer", .BankCodeOfPayer) + setnfo("CompensationAmount", .CompensationAmount) + setnfo("CreditorReference", .CreditorReference) + setnfo("CreditorsReferenceParty", .CreditorsReferenceParty) + setnfo("CustomerReference", .CustomerReference) + setnfo("EndToEndReference", .EndToEndReference) + setnfo("JournalNumber", .JournalNumber) + setnfo("MandateReference", .MandateReference) + setnfo("NameOfPayer", .NameOfPayer) + setnfo("OriginalAmount", .OriginalAmount) + setnfo("OriginatorsIdentificationCode", .OriginatorsIdentificationCode) + setnfo("PayersReferenceParty", .PayersReferenceParty) + setnfo("PostingText", .PostingText) + setnfo("SepaRemittanceInformation", .SepaRemittanceInformation) + If .TextKeyAddition.HasValue Then setnfo("TextKeyAddition", .TextKeyAddition) + setnfo("TransactionCode", .TransactionCode) + setnfo("IsUnstructuredData", .IsUnstructuredData) + setnfo("UnstructuredData", .UnstructuredData) + setnfo("UnstructuredRemittanceInformation", .UnstructuredRemittanceInformation) + End With + + setnfo("DebitCreditMark", DebitCreditMark_Abb(line.Mark)) + setnfo("SupplementaryDetails", line.SupplementaryDetails) + setnfo("TransactionTypeIdCode", line.TransactionTypeIdCode) + setnfo("ValueDate", line.ValueDate) + + tbl.Rows.Add(nr) + Next + End If + Catch ex2 As Exception + + Diagnostics.Debug.Print(ex2.Message) + End Try + Next + + Catch ex As Exception + Diagnostics.Debug.Print(ex.Message) + End Try + End Using + + tbl.AcceptChanges() + Return tbl + + End Function + + + End Module + +End Namespace \ No newline at end of file diff --git a/Intranet_Legacy/code/fuchs_fds_email.vb b/Intranet_Legacy/code/fuchs_fds_email.vb new file mode 100644 index 0000000..7fe9ad9 --- /dev/null +++ b/Intranet_Legacy/code/fuchs_fds_email.vb @@ -0,0 +1,102 @@ +Option Explicit On + +Imports OCMS.SQLHandling +Imports json = Newtonsoft.Json.JsonConvert +Imports vb = Microsoft.VisualBasic +Imports oEmail = OCMS.ocms_email + +Namespace Global.Fuchs.intranet + + + Module fuchs_fds_email + + Private _FDS_EmailSettings As oEmail.EmailSettings = Nothing + Private Function EmailSettings() As oEmail.EmailSettings + If IsNothing(_FDS_EmailSettings) = True AndAlso My.Settings.FDS_EmailSettings <> "" Then + _FDS_EmailSettings = New oEmail.EmailSettings(My.Settings.FDS_EmailSettings) + End If + Return _FDS_EmailSettings + End Function + + Public Async Function SendEmail(ByVal Ref As String, ByVal Subject As String, ByVal html As String, Email As String, Name As String, files As Dictionary(Of String, Byte()), Fuchs_intranet As Fuchs_intranet) As Threading.Tasks.Task(Of Boolean) + + Dim ErrorMessage As New List(Of String), msgguid As String = "", msgsenttimestamp As Date, msgconfig As String = "" + + If IsValidEmail(Email) = False Then ErrorMessage.Add("Die Email-Adresse ist nicht gültig.") + 'If Name = "" Then ErrorMessage.Add("Bitte geben Sie Ihren Namen an.") + If html = "" Then ErrorMessage.Add("Bitte geben Sie eine Nachricht ein.") + + If ErrorMessage.Count = 0 Then + Try + + Dim signaturehtml As String = "" + Try + Dim signaturefile As New IO.FileInfo(OCMS.ocms_commons.ApplicationBase.FullName & "\Fuchs\email_signature\sanitaerfuchs_email_signature.txt") + If signaturefile.Exists Then + signaturehtml = "

 

Herzliche Grüße aus Düsseldorf-Bilk
Ihr Team der Firma Sebastian Fuchs

" + signaturehtml &= IO.File.ReadAllText(signaturefile.FullName) + End If + Catch sfex As Exception + OCMS.debug_log("fuchs_fds_email.SendEmail(bool) signaturefile", ex:=sfex) + End Try + + + Dim msg As New oEmail.Email(Mode:=oEmail.EmailMode.DirectMode) + With msg + .EmailSettings = EmailSettings() + .AddTo(Email, Name) + .AddReplyTo(New MimeKit.MailboxAddress("Sebastian Fuchs - Bad und Heizung", "info@sanitaerfuchs.de")) + .Subject = Subject + .SetBody(html & signaturehtml) + End With + If IsNothing(files) = False Then + For Each filename As String In files.Keys + Dim file As Byte() = files(filename) + msg.AttachFile(file, filename) + Next + End If + Dim ESR As oEmail.EmailSendingResult = Await msg.SendAsync(Sub(dref As String, ex As Exception) + OCMS.debug_log("fuchs_fds_email.SendEmail(bool) " & dref, ex:=ex) + End Sub) + + msgguid = msg.MessageId() + msgconfig = msg.EmailConfig_serialized() + msgsenttimestamp = ESR.Timestamp + ErrorMessage.AddRange(ESR.ErrorMessages.ToArray) + + Catch smex As Exception + ErrorMessage.Add("Beim Versenden ist ein Fehler aufgetreten.") + OCMS.debug_log("fuchs_fds_email.SendEmail(bool) inner", ex:=smex, data:=ErrorMessage) + End Try + End If + + If ErrorMessage.Count > 0 Then + OCMS.debug_log("fuchs_fds_email.SendEmail(bool) finally", ex:=Nothing, data:=ErrorMessage) + Else + Try + + Dim pl As New ParamList() From { + SQL_VarChar("Ref", Ref), + SQL_VarChar("guid", msgguid), + SQL_datetime("DateSent", msgsenttimestamp), + SQL_NVarChar("config", msgconfig), + SQL_bit("success", ErrorMessage.Count = 0), + SQL_NVarChar("log", json.SerializeObject(ErrorMessage)) + } + Await setSQLValue_async("EXECUTE [dbo].[fds__logEmail] @Ref, @guid, @DateSent, @config, @success, @log;", Fuchs_intranet.Intranet__SQLConnectionString, pl, ApplySymmetricKey:=Fuchs_intranet.Intranet__sql_symmetric_key) + Catch logex As Exception + OCMS.debug_log("fuchs_fds_email.SendEmail(bool) log", ex:=logex) + End Try + End If + + Return If(ErrorMessage.Count > 0, False, True) + + End Function + + + + + + End Module + +End Namespace diff --git a/Intranet_Legacy/code/fuchs_fds_pdf.vb b/Intranet_Legacy/code/fuchs_fds_pdf.vb new file mode 100644 index 0000000..360c28c --- /dev/null +++ b/Intranet_Legacy/code/fuchs_fds_pdf.vb @@ -0,0 +1,1368 @@ +Option Explicit On + +Imports System.IO +Imports MigraDoc.DocumentObjectModel +Imports MigraDoc.Extensions +Imports MigraDoc.Extensions.Html +Imports OCMS.ocms_dictionaries +Imports OCMS.pdf +Imports OCMS +Imports PdfSharp.Drawing + +Namespace Global.Fuchs.intranet.pdf + + Public Module _pdf + + Public Sub SetLicense() + 'Using MS As New System.IO.MemoryStream(SpirePdfLicense()) + Spire.License.LicenseProvider.SetLicenseKey("I+ztXu/77JVCXwEAwVQwRISgL4qlo1lOxO6csGdd02iJsOnMzEkqjhRx6oJ5rw5fgaF5wUf83LWMWwLE8PNc/ZGUZIa8mTx9ovjM9fK2+xLk/VC3s555Qhd5+PLfgxIEsp4r6lw03P7YPvD6pvM745VQg0dd8thRoznmkWrkUf/2/MiUZyUyVrH+qyEZgkniqpuDdqoaUNx1RfsK6TyiKKB7nsiqDy9xrduuYCMgOg1wii3aU+anA/pHUYh/jMO0TkavDRxzlL2GpijSDzIte0eXCR6K8GXLOpV3HKYnjErkiIn5zPIp9v7IzM+55FSiC3kAYwmxhMCH8M/eTZ6/2qhCYQXSbmX0h9ET3EMmhgj5lbuU84YAQNKuj+lIohxSDylTyYBekGTXP1fUud14pMqP2QrCkbYo7INgMkozZu/3q7r7lKOhQAPhzT31eL+63Br2c6NIC+y6y6cOUhz2jBE4trJtBXzNMwotfO2VtZ2tQYPuzyFylwcf2V7wULsM888p8kW9XeD+oKm/0UYR0IbS/S/t6HSuY7rS/zvXdcObvH11sGRcvjko7Pl7xY9xHGj68RAyd0uJlVyV/dY8om3llxM85F+mPYS5QHRmHerl4DyiQSvhkHBajLZ2MYG3Lk5qtFlVuIRLL3ohTEUdRJoW3JmOsZDSFG2f1zgwQUbhF29wwnfEPyfkVuxoMzExqPl2/LC/vpxQpzES0leMdW0KGkcvksHPiQd6aAqYPBTHZ+0aQoD8MHctMVdQHiQyWAiRVfljpt9fcOh24zNBRNijnUm0EN/QO8nZZ4pMqAU87U4mWLlyWBXqgmw//M3yEaXHEsYt/3RIr6yERpyQGVYUvoIVdXrOHvwatclsbir0qMndh9q36C0Jwk0E7GK5HpfOzNreoNUxKJHbQmgN7xe5POyBCizhT9Tt2QGMX3YqlhgWLjCSrJvR159pbdtyo8WJETG49Ba7w7Ll+evakE5Tpzidtnrm0uy5mEgUWUQa4N/FCJuMYOpyuVXDAz5kTiotgg9Xo5rFxUH+xufUadkE8brQ3e/y1MUxYw02CQaBimZUX/LCMRhL4u89lBkGTJOqLXsxEAXV5OTVtqAqsq06IT6MlpVjt4Dh1eJxH8bz6IJEJYjEgam0FVHkTk3kfOf95+QcsvVdHFXsdGszFMnAqX6b8nKcAnZvZWpWYuUtEbOsyuMTo6io8XNwKhpuUg5LlJmPPXkTKHQJ/CM6EQkqIS4Foz7pBaaYRBgEz/zDujxbYUGN6LaJiANung4Zyl6k5arhHdCalRDe29avN1ovxe/5tUHQQDxq+yQ1cNChPJTFHR1bKKu0T7SW7p19qH5850rXcjtzK4+6zGYXq8HItH6UNiev27o9VUoKTv+XZiD27YE33vdwQHh5Kdc8CMMo+uaTI11uLBirUH63Na2oBkCGJjJzQk8Gc5NQs7+2DptJ/rNlOhwb/czZLB6OjH+vNCyHZBCGPd17rIW16JQzgWv+OBI9DbD7pXYzDyF++IrBiRKBPNKCTwg3trm89J4zWeGW80bFtD0QnIcArA==") + 'Spire.License.LicenseProvider.SetLicenseFileStream(MS) + 'End Using + + End Sub + + + + Public Const project_abbreviation = "fuchs" + + + + Public deculture As IFormatProvider = New Globalization.CultureInfo("de-de") + Public Class FDS__TextBlocks + Public OrtUndZeit As String = "" + Public address As String() + Public subject As String = "" + Public body As String = "" + + Public AddressBox_sender_p1 As String = "Sebastian Fuchs" + Public AddressBox_sender_p2 As String = "GmbH & Co. KG ● Germaniastraße 15 ● 40223 Düsseldorf" + + Public Admin_User As String = "Stefan Ott" 'will be overwritten + Public Admin_User_Email As String = "info@processweb.de" 'will be overwritten + Public I_Admin_Datum_Label As String = "Rechnungsdatum" + Public R_Admin_Datum_Label As String = "Datum" + + Private _Admin_Datum_Value As Date = Now() + Public Admin_Datum As String = Me._Admin_Datum_Value.ToString("dd. MMMM yyyy", deculture) + Public Property Admin_Datum_Value As Date + Get + Return Me._Admin_Datum_Value + End Get + Set(value As Date) + Me._Admin_Datum_Value = value + Admin_Datum = Me._Admin_Datum_Value.ToString("dd. MMMM yyyy", deculture) + End Set + End Property + Public Admin_Prov_Label As String = "Leistungszeitraum" + Public Admin_Prov As String = "" + Public Admin_Ref_Label As String = "Nummer" + Public Admin_Ref As String = "" + + Public FooterBlock1 As String() = New String() { + "Sebastian Fuchs", + "Bad und Heizung GmbH & Co. KG", + "Sitz: Germaniastr. 15", + "40223 Düsseldorf", + "Amtsgericht Düsseldorf HRA22282", + "USt-ID-Nr.: DE286366012" + } + Public FooterBlock2 As String() = New String() { + "Persönlich haftend:", + "Sebastian Fuchs Verwaltungs GmbH", + "Amtsgericht Düsseldorf HRB69289", + "Geschäftsführer: Sebastian Fuchs", + "Installateur und Heizungsbaumeister", + "Energieberater HWK" + } + Public FooterBlock3 As String() = New String() { + "Telefon: 0211 - 31 07 222", + "Fax: 0211 - 87 66 185", + "Notdienst: 0177 - 88 08 167", + "E-Mail: info@sanitaerfuchs.de", + "Website: www.sanitaerfuchs.de" + } + Public FooterBlock4 As String() = New String() { + "Kreissparkasse Düsseldorf", + "IBAN: DE52 3015 0200 0002 0914 78", + "BIC: WELADED1KSD", + "Stadtsparkasse Düsseldorf", + "IBAN: DE76 3005 0110 0045 0148 00", + "BIC: DUSSDEDDXXX" + } + + Public ReadOnly ProvisionLoc_Label As String = "Leistungsort / Lieferadresse" + + Public ReadOnly DocInfo_Author As String = "Sebastian Fuchs Sanitär und Heizung, Düsseldorf" + Public ReadOnly DocInfo_Copyright As String = "by Processweb, Dr. Stefan Ott, © " & Year(Now()).ToString + + + Public ReminderTexts_before As New Dictionary(Of String, String()) From { + {"f", New String() {"Sehr geehrte Damen und Herren,", "ein Mahnschreiben sollte kurz, freundlich und erfolgreich sein. Kurz ist es, freundlich sowieso; ob es auch erfolgreich ist, hängt von Ihnen ab."}}, + {"m", New String() {"Sehr geehrte Damen und Herren,", "nun müssen wir Sie noch einmal anschreiben.", "Wahrscheinlich haben Sie triftige Gründe dafür, warum Sie die Zahlung unserer Forderung nicht vornehmen und auch nicht auf unsere Mahnung reagieren. Sollten wir darüber nicht einmal sprechen?", "Bitte nehmen Sie umgehend in dieser Sache mit uns Kontakt auf."}}, + {"l", New String() {"Sehr geehrte Damen und Herren,", "Eine DRITTE MAHNUNG zu erhalten bereitet Ihnen bestimmt ebenso wenig Freude wie uns, sie zu verschicken. Leider haben wir auf unsere zweite Mahnung noch keine Antwort von Ihnen erhalten.", "Wir bitten Sie, den offenen Betrag innerhalb der nächsten 7 Werktage nach Erhalt dieses Schreibens zu begleichen. Nach Ablauf dieser Frist erfolgt keine weitere Mahnung mehr.", "Sollte die Forderung bis dahin nicht beglichen sein, eröffnen wir das gerichtliche Mahnverfahren. Sollten Sie die Rechnung inzwischen beglichen haben, so betrachten Sie bitte dieses Schreiben als gegenstandslos."}} + } + Public ReminderTexts_after As New Dictionary(Of String, String()) From { + {"f", New String() {"Wir bitten Sie, den noch offenen Rechnungsbetrag innerhalb einer Woche auf unser Konto zu überweisen.", "Sollten Sie den Betrag bereits überwiesen haben, so bitten wir Sie, diese Zahlungserinnerung als gegenstandslos zu betrachten."}}, + {"m", New String() {"Um Ihnen zusätzliche Kosten für weitere Mahnungen zu ersparen, bitten wir Sie nunmehr um die Überweisung des noch zu zahlenden Gesamtbetrages inklusive der ggf. bereits fälligen Mahnzinsen und Mahngebühren innerhalb von einer Woche."}}, + {"l", New String() {}} + } + + + End Class + + + Public Function WhiteShading() As Shading + Return New Shading() With {.Color = Colors.White, .Visible = False} + End Function + Public Function LightShading() As Shading + Return New Shading() With {.Color = Color.FromRgb(240, 240, 240), .Visible = True} + End Function + Public Function GrayShading() As Shading + Return New Shading() With {.Color = Color.FromRgb(235, 235, 235), .Visible = True} + End Function + + + Public Function htmlSplit(inp As String, maxCharactersPerRow As Integer) As String() + Dim s As String = If(inp, "") + If s.Length <= maxCharactersPerRow OrElse s.Contains("<") = False Then + Return StrA(s) + Else + Dim matches As MatchCollection = Regex.Matches(s, "<[p,div]") + If matches.Count = 0 Then + Return StrA(s) + Else + Dim sses As New List(Of String), lastIndex As Integer = 0 + Dim descstr As String = "
", divdesc_position As Integer = s.IndexOf(descstr) + If divdesc_position >= 0 Then + sses.Add(s.Substring(0, divdesc_position)) + s = s.Substr(divdesc_position + descstr.Length, s.Length - (divdesc_position + descstr.Length - 6)) + matches = Regex.Matches(s, "<[p,div]") + End If + For Each m As Match In matches + For Each c As Capture In m.Captures + If c.Index > 0 AndAlso (c.Index - lastIndex) > maxCharactersPerRow Then + sses.Add(s.Substring(lastIndex, c.Index - lastIndex)) + lastIndex = c.Index + End If + Next + Next + sses.Add(s.Substring(lastIndex)) + Return sses.ToArray + End If + End If + End Function + + Public Sub ApplyInvoice(ByRef doc As MigraDoc.DocumentObjectModel.Document, TB As FDS__TextBlocks, Inv As fds__invoice_data, Optional SettingsDic As GenericStringDictionary = Nothing, Optional draft As Boolean = False) + Dim InvoiceType As String = Inv.InvoiceType() + Dim p13b As Boolean = Inv.InvoiceRegistration.nz("InvoiceOptions", "").Split(",").Contains("§13b") + Call Apply_Invoice_Styles(doc) + + Dim Sec As MigraDoc.DocumentObjectModel.Section = doc.Sections(0) + Sec.PageSetup.RightMargin = cm(1.5) + + Dim PageInnerHeight As Unit = New Unit(Sec.PageSetup.PageHeight.Millimeter - Sec.PageSetup.TopMargin.Millimeter - Sec.PageSetup.BottomMargin.Millimeter, type:=UnitType.Millimeter), PageInnerWidth As Unit = New Unit(Sec.PageSetup.PageWidth.Millimeter - Sec.PageSetup.LeftMargin.Millimeter - Sec.PageSetup.RightMargin.Millimeter, type:=UnitType.Millimeter) + + With Sec.AddParagraph + .Style = "SubjectBig" + .Format.SpaceBefore = cm(8.65) + + .AddText(Inv.InvoiceTitle & " Nr. " & Inv.InvoiceId) + .Format.SpaceAfter = cm(0.5) + End With + If Inv.ProvisionLocation.Length > 0 Then + With Sec.AddParagraph + 'Adressat + + '.Format.SpaceBefore = cm(0.3) + .Style = "AddressBox" 'not an invoice specific style + .Format.Font.Size = 10 + .Format.LineSpacingRule = MigraDoc.DocumentObjectModel.LineSpacingRule.Exactly + .Format.LineSpacing = 12 + .AddFormattedText(TB.ProvisionLoc_Label, TextFormat.Bold) + .AddLineBreak() + If Inv.ProvisionLocation.GetType() = GetType(String()) Then + For Each t As String In Inv.ProvisionLocation + .AddText(t) + .AddLineBreak() + Next + End If + End With + If Inv.ProvisionLocation.GetType() = GetType(String) Then + '.AddHtml(TB.ProvisionLocation) + 'For ei As Integer = 0 To .Elements.Count - 1 + ' Dim e As DocumentObject = .Elements.Item(ei) + ' If e.GetType() = GetType(Paragraph) Then + ' DirectCast(e, Paragraph).Style = "AddressBoxSender" + ' End If + 'Next + End If + End If + With Sec.AddParagraph + .Format.SpaceBefore = cm(0.7) + End With + + Dim showgrid As Boolean = False, ColumnsCount As Integer = 5 + Dim invtbl As Tables.Table = Sec.AddTable + With invtbl + .Style = "Table" + .Format.SpaceBefore = mm(1) + .Format.SpaceAfter = mm(1) + .Borders.Color = If(showgrid, Colors.Black, MigraDoc.DocumentObjectModel.Colors.White) + .Borders.Width = 0.25 + .Borders.Left.Width = 0.5 + .Borders.Right.Width = 0.5 + .Rows.LeftIndent = 0 + .Rows.Height = cm(0.6) + .Rows.HeightRule = Tables.RowHeightRule.AtLeast + For xct = 1 To ColumnsCount + Dim fcol0 = .AddColumn() + 'fcol0.Width = cm(FullWidth / ColumnsCount) + Next + End With + + Dim CellBaseTextMeasure As New TextMeasurement(doc.Styles("TblCell_Base").Font), clmargin As Double = 13 + Dim hrw As MigraDoc.DocumentObjectModel.Tables.Row = invtbl.AddRow(), hrwi As MigraDoc.DocumentObjectModel.Tables.Row + 'hrw.KeepWith = 2 + Dim hd As String() = New String() {"Pos.", "Menge", "Artikelbezeichnung", "VK", "Summe"} + For ci As Byte = 0 To ColumnsCount - 1 + With hrw.Cells(ci).AddParagraph() + .AddText(hd(ci)) + Dim thw As Double = CellBaseTextMeasure.MeasureString(hd(ci), UnitType.Point).Width + .Format.LeftIndent.Point + .Format.RightIndent.Point + clmargin + If hrw.Cells(ci).Column.Width <= thw Then hrw.Cells(ci).Column.Width = thw + End With + Next + + 'loop though all blocks + For Each req In Inv.InvoiceReq + Dim InvRqId As String = req.nz("Id", "-1"), even As Boolean = False + If InvRqId <> "-1" Then + hrw = invtbl.AddRow() 'Title + hrw.Style = "TblCell_RTitle" + hrw.Cells(0).MergeRight = 4 + hrw.Shading = WhiteShading() + hrw.Borders.Top = New Border() With {.Color = Colors.Black, .Style = BorderStyle.Single, .Width = 0.5} + With hrw.Cells(0) + 'If req.nz("title").StartsWith("<") Then + .AddHtml(req.nz("title")) + 'Else + '.AddParagraph().AddText(req.nz("title")) + 'End If + End With + + 'loop through all items of the block + For Each itm In Inv.InvoiceItm + If itm.nz("InvRqId", "-1") = InvRqId Then + Dim itemtext As String() = itm.nz("Text", "").htmlSplit(250) + + hrwi = invtbl.AddRow() + hrwi.Style = "TblCell_Head" + If itemtext.Length > 1 Then + hrwi.Borders.Bottom.Width = 0 + hrwi.Borders.Bottom.Color = hrwi.Shading.Color + hrwi.Borders.DistanceFromBottom = 0 + For Each cl As Tables.Cell In hrwi.Cells + cl.Borders.Bottom.Width = 0 + cl.Borders.Bottom.Color = hrwi.Shading.Color + cl.Borders.DistanceFromBottom = 0 + Next + End If + Call AddCell(hrwi, 0, CellBaseTextMeasure, itm.no("Position", ""), CellValueType.Text, clmargin, False) + Call AddCell(hrwi, 1, CellBaseTextMeasure, itm.no("Quantity", ""), CellValueType.Text, clmargin, False) + Call AddCell(hrwi, 2, CellBaseTextMeasure, If(itemtext.Length > 0, itemtext(0), ""), CellValueType.Text, clmargin, True) + Call AddCell(hrwi, 3, CellBaseTextMeasure, itm.no("value", ""), CellValueType.Currency, clmargin, False, Alignment:=ParagraphAlignment.Right) + Call AddCell(hrwi, 4, CellBaseTextMeasure, itm.no("value_total", ""), CellValueType.Currency, clmargin, False, Alignment:=ParagraphAlignment.Right) + + hrwi.Shading = If(even, GrayShading(), LightShading()) + + + For itp As Integer = 2 To itemtext.Length + hrwi = invtbl.AddRow() + 'hrwi.Style = "TblCell_Head" + hrwi.Borders.Top.Width = 0 + hrwi.Borders.Top.Color = hrwi.Shading.Color + hrwi.Borders.Distance = 0 + + For Each cl As Tables.Cell In hrwi.Cells + cl.Borders.Top.Width = 0 + cl.Borders.Top.Color = hrwi.Shading.Color + cl.Borders.Distance = 0 + Next + Call AddCell(hrwi, 0, CellBaseTextMeasure, "", CellValueType.Text, clmargin, False) + Call AddCell(hrwi, 1, CellBaseTextMeasure, "", CellValueType.Text, clmargin, False) + Call AddCell(hrwi, 2, CellBaseTextMeasure, itemtext(itp - 1), CellValueType.Text, clmargin, True) + Call AddCell(hrwi, 3, CellBaseTextMeasure, "", CellValueType.Text, clmargin, False) + Call AddCell(hrwi, 4, CellBaseTextMeasure, "", CellValueType.Text, clmargin, False) + + + hrwi.Shading = If(even, GrayShading(), LightShading()) + Next + even = Not even + End If + Next + + 'The intermediate sum only makes sense if more than one block exists, therefore the condition + If Inv.InvoiceReq.Count > 1 Then + hrw = invtbl.AddRow() 'zwischensumme + hrw.Style = "TblCell_RSum" + hrw.Cells(0).MergeRight = 3 + hrw.Shading = WhiteShading() + hrw.Borders.Top = New Border() With {.Color = Colors.Black, .Style = BorderStyle.Single, .Width = 0.5} + With hrw.Cells(0).AddParagraph + .Format.Font.Bold = True + .AddText("Zwischensumme") + End With + Call AddCell(hrw, 4, CellBaseTextMeasure, req.no("value_net", ""), CellValueType.Currency, clmargin, False, Alignment:=ParagraphAlignment.Right) + End If + End If + Next + + 'sums and vat + hrw = invtbl.AddRow() + hrw.Cells(0).MergeRight = 3 + hrw.Style = "TblCell_TNet" + hrw.Shading = WhiteShading() + hrw.Borders.Top = New Border() With {.Color = Colors.Black, .Style = BorderStyle.Single, .Width = 0.5} + With hrw.Cells(0).AddParagraph + .AddText("Netto") + End With + Call AddCell(hrw, 4, CellBaseTextMeasure, Inv.InvoiceRegistration.no("InvoiceBalance_net", ""), CellValueType.Currency, clmargin, False, Alignment:=ParagraphAlignment.Right) + + If p13b = False Then + + Dim ust As Decimal, net1 As Decimal, net2 As Decimal + 'A Line for ust = 0 with value = 1 doesn't make sense therefore the condition + If ParseDec(Inv.InvoiceRegistration("InvoiceVAT_1"), ust) = True AndAlso ParseDec(Inv.InvoiceRegistration.no("InvoiceVAT_net1", ""), net1) = True AndAlso Not (ust = 0.0 And net1 = 0.0) Then + hrw = invtbl.AddRow() + hrw.Style = "TblCell_TVat" + hrw.Cells(0).MergeRight = 3 + hrw.Shading = GrayShading() + With hrw.Cells(0).AddParagraph + .AddText("Umsatzsteuer " & ust.ToString("0.##") & "%") + End With + Call AddCell(hrw, 4, CellBaseTextMeasure, Inv.InvoiceRegistration.no("InvoiceVAT_net1", ""), CellValueType.Currency, clmargin, False, Alignment:=ParagraphAlignment.Right) + End If + 'A Line for ust = 0 with value = 1 doesn't make sense therefore the condition + If ParseDec(Inv.InvoiceRegistration("InvoiceVAT_2"), ust) = True AndAlso ParseDec(Inv.InvoiceRegistration.no("InvoiceVAT_net1", ""), net2) = True AndAlso Not (ust = 0.0 And net2 = 0.0) Then + hrw = invtbl.AddRow() + hrw.Style = "TblCell_TVat" + hrw.Cells(0).MergeRight = 3 + hrw.Shading = LightShading() + With hrw.Cells(0).AddParagraph + .AddText("Umsatzsteuer " & ust.ToString("0.##") & "%") + End With + Call AddCell(hrw, 4, CellBaseTextMeasure, Inv.InvoiceRegistration.no("InvoiceVAT_net2", ""), CellValueType.Currency, clmargin, False, Alignment:=ParagraphAlignment.Right) + End If + End If + + hrw = invtbl.AddRow() + hrw.Style = "TblCell_TSum" + hrw.Cells(0).MergeRight = 3 + hrw.Shading = WhiteShading() + hrw.Borders.Top = New Border() With {.Color = Colors.Black, .Style = BorderStyle.Single, .Width = 1} + hrw.Borders.Bottom = New Border() With {.Color = Colors.Black, .Style = BorderStyle.Single, .Width = 0.5} + With hrw.Cells(0).AddParagraph + .AddText("Summe") + End With + Call AddCell(hrw, 4, CellBaseTextMeasure, Inv.InvoiceRegistration.no("InvoiceBalance", ""), CellValueType.Currency, clmargin, False, Alignment:=ParagraphAlignment.Right) + + + 'calculate and adjust column width + Dim remWidth As Double = 0 + For ci As Byte = 0 To invtbl.Columns.Count - 1 + Diagnostics.Debug.Print(invtbl.Columns(ci).Width.Millimeter.ToString & "mm") + If Not ci = 2 Then remWidth += invtbl.Columns(ci).Width.Millimeter + Next + invtbl.Columns(2).Width = mm(PageInnerWidth.Millimeter - remWidth) + + + Dim txt As New List(Of TnF) + If p13b = True Then + Dim ust As Decimal + Dim uststring As String = If(ParseDec(Inv.InvoiceRegistration("InvoiceVAT_1"), ust) = True, " mit einem Steuersatz von " & ust.ToString("0.##") & "%", "") + txt.Add(New TnF("Gem. §13b Umsatzsteuergesetz unterliegen Sie der Steuerschuldnerschaft des Leistungsempfängers zur Umsatzsteuer aus dieser Rechnung" & uststring & ".")) + End If + If InvoiceType = "i" Then + txt.Add(New TnF("Für bereits erbrachte Arbeiten, Dienstleistungen, Materiallieferungen und getätigte Bestellvorgänge zum oben genannten Bauvorhaben, die sich aus dem mit Ihnen geschlossenen Vertrag ergeben, stellen wir Ihnen vertragsgemäß unsere Akontozahlung in Rechnung. " & + "Eine Endabrechnung erhalten Sie als Schlussrechnung nach Abschluss des gesamten Bauvorhabens. Das Ausführungsdatum entnehmen Sie bitte dem Schlusstext dieser Rechnung. Wir danken Ihnen herzlich für das entgegengebrachte Vertrauen und bitten Sie um kurzfristigen Ausgleich der Akontorechnung.")) + ElseIf CSng(Inv.InvoiceRegistration.no("InvoiceService", 0)) > 0 And p13b = False Then + txt.Add(New TnF(If(Currency(Inv.InvoiceRegistration("InvoiceService")) <> "?", "Im Bruttobetrag sind " & Currency(Inv.InvoiceRegistration("InvoiceService")) & " Lohnkosten enthalten (netto " & Currency(Inv.InvoiceRegistration("InvoiceService_net")) & "). Die darin enthaltene Mehrwertsteuer beträgt " & Currency(Inv.InvoiceRegistration("InvoiceService_VAT")) & ".", ""))) + End If + txt.Add(New TnF("Bitte beachten Sie, nach §14 Abs. 1 Umsatzsteuergesetz ist diese Rechnung ein Zahlungsbeleg oder eine andere beweiskräftige Unterlage für 2 Jahre nach Ablauf des Kalenderjahres der Ausstellung dieser Rechnung aufzubewahren, soweit nicht aufgrund anderer gesetzlicher Regelungen andere ggf. längere Aufbewahrungsfristen gelten.")) + If InvoiceType <> "i" AndAlso CSng(Inv.InvoiceRegistration.no("InvoiceService", 0)) > 0 AndAlso p13b = False Then + txt.Add(New TnF(("Privathaushalten erstattet das Finanzamt bis zu " & Currency(Inv.InvoiceRegistration("InvoiceService") * Inv.InvoiceRegistration.no("tax_servicerefund", 0.2)) & " des Arbeitslohns mit der nächsten Steuererklärung.").ToUpper(), pStyle:="InvoiceNotes_ucb")) + End If + txt.AddRange(New TnF() { + New TnF("Unsere Allgemeinen und ihnen bekannten Geschäftsbedingungen gelten für alle unsere Angebote. Wir liefern oder leisten ausschließlich zu diesen Bedingungen. Andere Bedingungen werden nicht Vertragsinhalt, auch wenn wir diesen nicht ausdrücklich widersprochen haben. Ergänzend zu diesen Bedingungen gelten unsere Zusatzbedingungen für allgemeine Dienstverträge, Handwerksleitungen und Wartungsverträge. Spätestens mit der Entgegennahme der entsprechenden Lieferung und/oder Leistung gelten unsere Bedingungen als angenommen. Sie gelten auch für künftige Geschäftsbeziehungen, auch wenn sie nicht nochmals ausdrücklich vereinbart werden. Insbesondere auch was die Datenverarbeitung nach Datenschutz- Grundverordnung (DSGVO) Artikel 5 anbelangt."), + New TnF("Steuernummer: 106/5849/2962"), + New TnF("Freistellungsbescheinigung zum Steuerabzug bei Bauleistungen gemäß § 48 Abs. 1 Satz1 des EStG liegt vor. Es gelten unsere derzeit gültigen allgemeinen Liefer- und Zahlungsbedingungen. " & Inv.InvoiceRegistration.nz("PaymentTermPhrase").ne("Zahlbar innerhalb von " & TranslatePaymentTerm(Inv.InvoiceRegistration.nz("PaymentTerm")) & ".") & " Danach erfolgt Verzugseintritt ohne Mahnung (§ 286 Absatz II BGB)."), + New TnF("Hinweis zu unseren Verrechnungssätzen: In den ausgewiesenen Arbeitswerten sind die Dienstleistungen als Arbeitslohn auf Basis der benötigten Zeit enthalten, inklusive der Fahrtzeit, Rüstzeit, Auftragsvorbereitung und Werkzeugen (ausgenommen Spezialwerkzeuge wie Pressen Stemmhammer, etc.) und die Verfügbarkeit von gängigen Ersatzteilen im Kundendienstfahrzeug. Alle Reparatureinsätze (ggf. nur oder einschließlich Störungsdiagnoseeinsätze) des Kundendienst werden grundsätzlich mit einem Verrechnungssatz nach Aufwand (1 Arbeitswert/Stück Zeiteinheit = 10 Minuten) abgerechnet. Der Verrechnungssatz „Servicepauschale/ Notdienst”" ausschließlich ausserhalb unserer Öffnungszeiten am Samstag und Sonntag sowie feiertags."), + New TnF("Weitere Informationen erhalten Sie unter www.sanitaerfuchs.de"), + New TnF("""Ach übrigens, wenn Sie mit uns zufrieden waren, dann sagen Sie es doch bitte den anderen. Und falls Sie mal nicht so zufrieden sind, dann sagen Sie es bitte gleich uns."" Denn schließlich ist die Zufriedenheit unserer Kunden unser wichtigstes Ziel - und ihre Weiterempfehlung unsere Beste Visitenkarte."), + New TnF("PLANT-MY-TREE für jedes gebaute Badezimmer und für jede gebaute Heizung spenden wir einen Baum. PLANT MY TREE führt als Unternehmen eigene Erstaufforstungsprojekte auf eigenen Flächen in Deutschland durch, die zuvor anderweitig genutzt wurden. Im Vorfeld arbeiten wir dabei eng mit den lokalen Forstbehörden zusammen. Unser Ziel ist die langfristige CO2-Kompensierung und damit der nachhaltige Umwelt- und Klimaschutz. Nach der Vermeidung des CO2-Ausstoß bzw. der Reduzierung ist die Aufforstung nicht nur unserer Meinung nach der beste und nachhaltigste Weg, das Klima und damit die Umwelt zu schützen. Deshalb konzentrieren wir uns auf die Aufforstung von Flächen."), + New TnF("Wir bedanken uns herzlich für Ihren Auftrag.") + }) + + + Array.ForEach(Of TnF)(txt.ToArray, Sub(t As TnF) + With Sec.AddParagraph + If IsNothing(t.ParagraphFormat) = False Then .Format = t.ParagraphFormat + .Style = t.style.ne("InvoiceNotes") + .AddText(t.text) + End With + End Sub) + + Dim payamount As Decimal = 0 + Try + payamount = Inv.InvoiceRegistration.no("InvoiceBalance", 0) + Catch ex As Exception + Debug.Print("Issue with payamout") + End Try + 'here's the girocode + + If Inv.IsDraft = False AndAlso payamount > 0 AndAlso If(Inv.InvoiceId, "").IsNullOrWhiteSpace = False Then + Try + 'put to the to so that nothing stupid happens to the pdf + Dim girocode_img As Byte() = Nothing + Try + Dim girocode As Drawing.Bitmap = getPaycode(iban:="DE52301502000002091478", bic:="WELADED1KSD", name:="Sebastian Fuchs Bad und Heizung", amount:=Inv.InvoiceRegistration.no("InvoiceBalance", 0), purpose:=Inv.InvoiceTitle.ne("Rechnung") & " " & Inv.InvoiceId) + girocode_img = If(IsNothing(girocode) = False, imageToByteArray(girocode), Nothing) + Catch gcex As Exception + girocode_img = Nothing + Debug.Print("Issue with girocode image") + End Try + + If IsNothing(girocode_img) = False Then + With Sec.AddParagraph() + .Format.SpaceBefore = cm(2) + .AddText("") + End With + + Dim girotbl As Tables.Table = Sec.AddTable() + With girotbl + .AddColumn(cm(17 - 3 - 0.6)) + .AddColumn(cm(3 + 0.6)) + .Borders.Color = Colors.Black + .Borders.Width = 0.5 + .Borders.Style = BorderStyle.Single + .Borders.Distance = cm(1) + End With + Dim rw As Tables.Row = girotbl.AddRow() + With rw + + End With + With rw.Cells(0) + .Borders.Right.Visible = False + .Format.LeftIndent = cm(0.6) + Dim p As Paragraph = .AddParagraph() + p.Format.SpaceBefore = cm(0.3) + p.Format.SpaceAfter = cm(0.2) + + p.AddText("Zahlen mit Girocode. Mit dem GiroCode bezahlen Sie Ihre Rechnungen schnell, sicher und vor allem fehlerfrei. Ihre Banking App liest aus dem Code alle relevanten Daten für Ihre Überweisung.") + p = .AddParagraph + p.AddText("Weitere Infos finden Sie unter ") + Dim hl As Hyperlink = p.AddHyperlink("http://www.girocode.de", HyperlinkType.Web) + hl.AddText("http://www.girocode.de") + p.AddText(".") + End With + + With rw.Cells(1) + .Borders.Left.Visible = False + Dim p As Paragraph = .AddParagraph + Dim img As Shapes.Image = p.AddImage(MigraDocFilenameFromByteArray(girocode_img)) + img.Resolution = 300 + img.WrapFormat.Style = Shapes.WrapStyle.TopBottom + + img.RelativeHorizontal = Shapes.RelativeHorizontal.Column + img.RelativeVertical = Shapes.RelativeVertical.Line + img.Width = cm(3) + img.LockAspectRatio = True + img.Left = Shapes.ShapePosition.Right + img.Top = Shapes.ShapePosition.Top + End With + End If + Catch ex As Exception + Debug.Print(ex.Message & vbNewLine & ex.StackTrace) + End Try + End If + End Sub + Public Sub ApplyReminder(ByRef doc As MigraDoc.DocumentObjectModel.Document, TB As FDS__TextBlocks, Rm As fds__reminder_data, Optional SettingsDic As GenericStringDictionary = Nothing, Optional draft As Boolean = False) + Dim ReminderType As String = Rm.ReminderType().ToLower + Call Apply_Invoice_Styles(doc) + + Dim Sec As MigraDoc.DocumentObjectModel.Section = doc.Sections(0) + Sec.PageSetup.RightMargin = cm(1.5) + + Dim PageInnerHeight As Unit = New Unit(Sec.PageSetup.PageHeight.Millimeter - Sec.PageSetup.TopMargin.Millimeter - Sec.PageSetup.BottomMargin.Millimeter, type:=UnitType.Millimeter), PageInnerWidth As Unit = New Unit(Sec.PageSetup.PageWidth.Millimeter - Sec.PageSetup.LeftMargin.Millimeter - Sec.PageSetup.RightMargin.Millimeter, type:=UnitType.Millimeter) + + With Sec.AddParagraph + .Style = "SubjectBig" + .Format.SpaceBefore = cm(8.65) + + .AddText(Rm.ReminderTitle) + .Format.SpaceAfter = cm(0.5) + End With + + With Sec.AddParagraph + .Format.SpaceBefore = cm(0.7) + End With + + + 'add text before + TB.ReminderTexts_before(ReminderType).ForEach(Sub(tx As String) + With Sec.AddParagraph() + .Style = "InvoiceNotes" + .AddText(tx) + End With + End Sub) + + + With Sec.AddParagraph + .Format.SpaceBefore = cm(0.7) + End With + + 'add table + + Dim showgrid As Boolean = False, ColumnsCount As Integer = 5 + Dim invtbl As Tables.Table = Sec.AddTable + With invtbl + .Style = "Table" + .Format.SpaceBefore = mm(1) + .Format.SpaceAfter = mm(1) + .Borders.Color = If(showgrid, Colors.Black, MigraDoc.DocumentObjectModel.Colors.White) + .Borders.Width = 0.25 + .Borders.Left.Width = 0.5 + .Borders.Right.Width = 0.5 + .Rows.LeftIndent = 0 + .Rows.Height = cm(0.6) + .Rows.HeightRule = Tables.RowHeightRule.AtLeast + For xct = 1 To ColumnsCount + Dim fcol0 = .AddColumn() + 'fcol0.Width = cm(FullWidth / ColumnsCount) + Next + End With + + Dim CellBaseTextMeasure As New TextMeasurement(doc.Styles("TblCell_Base").Font), clmargin As Double = 13 + Dim hrw As MigraDoc.DocumentObjectModel.Tables.Row = invtbl.AddRow(), hrwi As MigraDoc.DocumentObjectModel.Tables.Row + Dim hd As String() = New String() {"Rechnung", "vom", "Rechnungsbetrag", "bereits bezahlt", "noch offen"} + For ci As Byte = 0 To ColumnsCount - 1 + With hrw.Cells(ci).AddParagraph() + .AddText(hd(ci)) + Dim thw As Double = CellBaseTextMeasure.MeasureString(hd(ci), UnitType.Point).Width + .Format.LeftIndent.Point + .Format.RightIndent.Point + clmargin + If hrw.Cells(ci).Column.Width <= thw Then hrw.Cells(ci).Column.Width = thw + End With + Next + hrwi = invtbl.AddRow() + hrwi.Style = "TblCell_Head" + Call AddCell(hrwi, 0, CellBaseTextMeasure, Rm.ReminderRegistration.no("InvoiceId", ""), CellValueType.Text, clmargin, False) + Call AddCell(hrwi, 1, CellBaseTextMeasure, Rm.ReminderRegistration.no("InvoiceDate", ""), CellValueType.Date, clmargin, False) + Call AddCell(hrwi, 2, CellBaseTextMeasure, Rm.ReminderRegistration.no("amount", ""), CellValueType.Currency, clmargin, True, Alignment:=ParagraphAlignment.Right) + Call AddCell(hrwi, 3, CellBaseTextMeasure, Rm.ReminderRegistration.no("amount_payed", ""), CellValueType.Currency, clmargin, False, Alignment:=ParagraphAlignment.Right) + Call AddCell(hrwi, 4, CellBaseTextMeasure, Rm.ReminderRegistration.no("amount_open", ""), CellValueType.Currency, clmargin, False, Alignment:=ParagraphAlignment.Right) + hrwi.Shading = WhiteShading() + + 'sum + hrw = invtbl.AddRow() + hrw.Style = "TblCell_TSum" + hrw.Cells(0).MergeRight = 3 + hrw.Shading = WhiteShading() + hrw.Borders.Top = New Border() With {.Color = Colors.Black, .Style = BorderStyle.Single, .Width = 1} + hrw.Borders.Bottom = New Border() With {.Color = Colors.Black, .Style = BorderStyle.Single, .Width = 0.5} + With hrw.Cells(0).AddParagraph + .AddText("Summe") + End With + Call AddCell(hrw, 4, CellBaseTextMeasure, Rm.ReminderRegistration.no("amount_open", ""), CellValueType.Currency, clmargin, False, Alignment:=ParagraphAlignment.Right) + + + 'calculate and adjust column width + Dim remWidth As Double = 0 + For ci As Byte = 0 To invtbl.Columns.Count - 1 + Diagnostics.Debug.Print(invtbl.Columns(ci).Width.Millimeter.ToString & "mm") + If Not ci = 0 Then remWidth += invtbl.Columns(ci).Width.Millimeter + Next + invtbl.Columns(0).Width = mm(PageInnerWidth.Millimeter - remWidth) + + + With Sec.AddParagraph + .Format.SpaceBefore = cm(0.7) + End With + + 'add text before + TB.ReminderTexts_after(ReminderType).ForEach(Sub(tx As String) + With Sec.AddParagraph() + .Style = "InvoiceNotes" + .AddText(tx) + End With + End Sub) + + + 'add agb + Dim txt As New List(Of TnF) + txt.AddRange(New TnF() { + New TnF("Unsere Allgemeinen und ihnen bekannten Geschäftsbedingungen gelten für alle unsere Angebote. Wir liefern oder leisten ausschließlich zu diesen Bedingungen. Andere Bedingungen werden nicht Vertragsinhalt, auch wenn wir diesen nicht ausdrücklich widersprochen haben. Ergänzend zu diesen Bedingungen gelten unsere Zusatzbedingungen für allgemeine Dienstverträge, Handwerksleitungen und Wartungsverträge. Spätestens mit der Entgegennahme der entsprechenden Lieferung und/oder Leistung gelten unsere Bedingungen als angenommen. Sie gelten auch für künftige Geschäftsbeziehungen, auch wenn sie nicht nochmals ausdrücklich vereinbart werden. Insbesondere auch was die Datenverarbeitung nach Datenschutz- Grundverordnung (DSGVO) Artikel 5 anbelangt."), + New TnF("Steuernummer: 106/5849/2962"), + New TnF("Weitere Informationen erhalten Sie unter www.sanitaerfuchs.de"), + New TnF("""Ach übrigens, wenn Sie mit uns zufrieden waren, dann sagen Sie es doch bitte den anderen. Und falls Sie mal nicht so zufrieden sind, dann sagen Sie es bitte gleich uns."" Denn schließlich ist die Zufriedenheit unserer Kunden unser wichtigstes Ziel - und ihre Weiterempfehlung unsere Beste Visitenkarte."), + New TnF("PLANT-MY-TREE für jedes gebaute Badezimmer und für jede gebaute Heizung spenden wir einen Baum. PLANT MY TREE führt als Unternehmen eigene Erstaufforstungsprojekte auf eigenen Flächen in Deutschland durch, die zuvor anderweitig genutzt wurden. Im Vorfeld arbeiten wir dabei eng mit den lokalen Forstbehörden zusammen. Unser Ziel ist die langfristige CO2-Kompensierung und damit der nachhaltige Umwelt- und Klimaschutz. Nach der Vermeidung des CO2-Ausstoß bzw. der Reduzierung ist die Aufforstung nicht nur unserer Meinung nach der beste und nachhaltigste Weg, das Klima und damit die Umwelt zu schützen. Deshalb konzentrieren wir uns auf die Aufforstung von Flächen.") + }) + + + Array.ForEach(Of TnF)(txt.ToArray, Sub(t As TnF) + With Sec.AddParagraph + If IsNothing(t.ParagraphFormat) = False Then .Format = t.ParagraphFormat + .Style = t.style.ne("InvoiceNotes") + .AddText(t.text) + End With + End Sub) + + Dim payamount As Decimal = 0 + Try + payamount = Rm.ReminderRegistration.no("amount_open", 0) + Catch ex As Exception + Debug.Print("Issue with payamout") + End Try + 'here's the girocode + + If Rm.IsDraft = False AndAlso payamount > 0 AndAlso If(Rm.InvoiceId, "").IsNullOrWhiteSpace = False Then + Try + 'put to the to so that nothing stupid happens to the pdf + Dim girocode_img As Byte() = Nothing + Try + Dim girocode As Drawing.Bitmap = getPaycode(iban:="DE52301502000002091478", bic:="WELADED1KSD", name:="Sebastian Fuchs Bad und Heizung", amount:=payamount, purpose:="Rechnung " & Rm.InvoiceId) + girocode_img = If(IsNothing(girocode) = False, imageToByteArray(girocode), Nothing) + Catch gcex As Exception + girocode_img = Nothing + Debug.Print("Issue with girocode image") + Debug.Print(gcex.Message & vbNewLine & gcex.StackTrace) + End Try + + If IsNothing(girocode_img) = False Then + With Sec.AddParagraph() + .Format.SpaceBefore = cm(2) + .AddText("") + End With + + Dim girotbl As Tables.Table = Sec.AddTable() + With girotbl + .AddColumn(cm(17 - 3 - 0.6)) + .AddColumn(cm(3 + 0.6)) + .Borders.Color = Colors.Black + .Borders.Width = 0.5 + .Borders.Style = BorderStyle.Single + .Borders.Distance = cm(1) + End With + Dim rw As Tables.Row = girotbl.AddRow() + With rw + + End With + With rw.Cells(0) + .Borders.Right.Visible = False + .Format.LeftIndent = cm(0.6) + Dim p As Paragraph = .AddParagraph() + p.Format.SpaceBefore = cm(0.3) + p.Format.SpaceAfter = cm(0.2) + + p.AddText("Zahlen mit Girocode. Mit dem GiroCode bezahlen Sie Ihre Rechnungen schnell, sicher und vor allem fehlerfrei. Ihre Banking App liest aus dem Code alle relevanten Daten für Ihre Überweisung.") + p = .AddParagraph + p.AddText("Weitere Infos finden Sie unter ") + Dim hl As Hyperlink = p.AddHyperlink("http://www.girocode.de", HyperlinkType.Web) + hl.AddText("http://www.girocode.de") + p.AddText(".") + End With + + With rw.Cells(1) + .Borders.Left.Visible = False + Dim p As Paragraph = .AddParagraph + Dim img As Shapes.Image = p.AddImage(MigraDocFilenameFromByteArray(girocode_img)) + img.Resolution = 300 + img.WrapFormat.Style = Shapes.WrapStyle.TopBottom + + img.RelativeHorizontal = Shapes.RelativeHorizontal.Column + img.RelativeVertical = Shapes.RelativeVertical.Line + img.Width = cm(3) + img.LockAspectRatio = True + img.Left = Shapes.ShapePosition.Right + img.Top = Shapes.ShapePosition.Top + End With + End If + Catch ex As Exception + Debug.Print(ex.Message & vbNewLine & ex.StackTrace) + End Try + End If + End Sub + + Public Sub AddCell(ByRef Row As Tables.Row, CellIndex As Integer, TextMeasure As TextMeasurement, itm As Object, cvt As CellValueType, cellmargin As Double, variableWidth As Boolean, Optional Alignment As ParagraphAlignment = ParagraphAlignment.Left, Optional DateString As String = "") + Dim cl As Tables.Cell = Row.Cells(CellIndex), t As String = "", tw As Double + Select Case cvt + Case CellValueType.Currency + Dim v As Single + t = If(TryCastSingle(itm, v) = True, v.ToString("0.00 €", deculture), "") + Case CellValueType.Percent + Dim v As Single + t = If(TryCastSingle(itm, v) = True, v.ToString("0.00 %", deculture), "") + Case CellValueType.Date + Dim v As Date + t = If(TryCastDate(itm, v) = True, v.ToString(DateString.ne("dd.MM.yyyy"), deculture), "") + Case CellValueType.DateTime + Dim v As Date + t = If(TryCastDate(itm, v) = True, v.ToString(DateString.ne("dd.MM.yyyy HH:mm"), deculture), "") + Case Else + t = If(If(IsNothing(itm) OrElse IsDBNull(itm), "", itm.ToString()), "") + End Select + t = t.Trim() + If t.StartsWith("<") Then + cl.AddHtml(t) + ElseIf t <> "" Then + Dim p As Paragraph = cl.AddParagraph() + p.Format.Alignment = Alignment + p.AddText(t) + tw = TextMeasure.MeasureString(t, UnitType.Point).Width + cl.Format.LeftIndent.Point + cl.Format.RightIndent.Point + cellmargin + If cl.Column.Width <= tw AndAlso variableWidth = False Then cl.Column.Width = tw + End If + End Sub + + + Public Function getPaycode(iban As String, bic As String, name As String, amount As Decimal, purpose As String) As System.Drawing.Bitmap + Try + + 'Dim totp As New OtpNet.Totp(rfcKey) + Dim generator As New QRCoder.PayloadGenerator.Girocode(iban:=iban, bic:=bic, name:=name, amount:=amount, typeOfRemittance:=QRCoder.PayloadGenerator.Girocode.TypeOfRemittance.Unstructured, remittanceInformation:=purpose) + + Dim payload As String = generator.ToString() + + Dim qrGenerator As New QRCoder.QRCodeGenerator() + Dim qrCodeData As QRCoder.QRCodeData = qrGenerator.CreateQrCode(payload, QRCoder.QRCodeGenerator.ECCLevel.Q) + Dim qrCode As New QRCoder.QRCode(qrCodeData) + Return qrCode.GetGraphic(20) + + Catch ex As Exception + Return Nothing + End Try + End Function + + + + Public Class TnF + Public Property text As String = "" + Public Property style As String = "" + Public Property ParagraphFormat As ParagraphFormat = Nothing + + Public Sub New(t As String) + Me.text = t + End Sub + Public Sub New(t As String, Optional pStyle As String = "", Optional pFormat As ParagraphFormat = Nothing) + Me.text = t + Me.style = pStyle + Me.ParagraphFormat = pFormat + End Sub + End Class + + Public Function Currency(input As Object, Optional returnobject As String = "?") As String + Dim v As Decimal + If ParseDec(input:=input, v) = True Then + Return v.ToString("0.00 €", deculture) + Else : Return "" + End If + End Function + + Public Function TranslatePaymentTerm(pt As String) As String + Return If(pt, "").Replace("wd", " Werktagen").Replace("d", " Tagen").Replace("w", " Wochen").ne("10 Werktagen") 'fallback if empty + End Function + Public Function ParseDec(input As Object, ByRef val As Decimal) As Boolean + If IsNothing(input) = True OrElse IsDBNull(input) = True Then + Return False + ElseIf input.GetType() = GetType(System.Decimal) OrElse val.GetType.IsAssignableFrom(input.GetType) Then + val = input + Return True + ElseIf Decimal.TryParse(input.ToString, val) = True Then + Return True + Else : Return False + End If + End Function + + Public Enum CellValueType + Text + Int + Dec + Currency + Percent + [Date] + [DateTime] + End Enum + + Public Async Function writeLetter(TB As FDS__TextBlocks, draft As Boolean, locale As Globalization.CultureInfo) As Threading.Tasks.Task(Of MigraDoc.DocumentObjectModel.Document) + + Dim TgtFont As String = "Arial" + If SystemFontExists(TgtFont) = False Then TgtFont = "Arial" + + 'render + Dim Doc As New MigraDoc.DocumentObjectModel.Document + Doc.Info.Author = TB.DocInfo_Author + Doc.Info.Comment = TB.DocInfo_Copyright + Doc.Info.Title = "" + + Call pdf.DefineStyles_Letter(Doc, addstyles:=Nothing, TgtFont:=TgtFont) + Dim Sec As MigraDoc.DocumentObjectModel.Section = pdf.CreatePage_letter(Doc, TB, draft:=draft) + + Dim LF As New MigraDoc.DocumentObjectModel.Shapes.LineFormat() + With LF + If (System.Diagnostics.Debugger.IsAttached) = True Then + .DashStyle = MigraDoc.DocumentObjectModel.Shapes.DashStyle.Solid + .Color = MigraDoc.DocumentObjectModel.Colors.Gray + Else + .Visible = False + .Color = MigraDoc.DocumentObjectModel.Colors.White + End If + End With + + 'ORT & Datum + If TB.OrtUndZeit <> "" Then + With Sec.Headers.FirstPage.AddTextFrame + .Top = cm(11) + .Left = MigraDoc.DocumentObjectModel.Shapes.ShapePosition.Right + .Height = cm(1) + .Width = cm(7) + .RelativeVertical = MigraDoc.DocumentObjectModel.Shapes.RelativeVertical.Page + .RelativeHorizontal = MigraDoc.DocumentObjectModel.Shapes.RelativeHorizontal.Margin + With .AddParagraph + .AddText(TB.OrtUndZeit) + .Format.Font.Name = TgtFont + .Format.Font.Size = 11 + .Format.Alignment = MigraDoc.DocumentObjectModel.ParagraphAlignment.Right + End With + End With + End If + + 'Adressat + With Sec.Headers.FirstPage.AddTextFrame + .RelativeVertical = MigraDoc.DocumentObjectModel.Shapes.RelativeVertical.Page + .RelativeHorizontal = MigraDoc.DocumentObjectModel.Shapes.RelativeHorizontal.Page + .Top = cm(5.6) + .Left = cm(2.0) + .Width = cm(9) + .Height = cm(4) + .Margin = cm(0.5) + .MarginTop = cm(0.2) + '.LineFormat = LF.Clone + If If(TB.address, New String() {}).Length > 0 Then + With .AddParagraph + '.Format.SpaceBefore = cm(0.3) + .Style = "AddressBox" + For Each t As String In TB.address + .AddText(t) + .AddLineBreak() + Next + End With + End If + End With + + 'Betreff + If TB.subject <> "" Then + With Sec.AddParagraph + .Style = "BodyText" + .Format.SpaceBefore = cm(10) + .AddFormattedText(TB.subject, textFormat:=MigraDoc.DocumentObjectModel.TextFormat.Bold) + .AddLineBreak() + .AddLineBreak() + End With + End If + If TB.body <> "" Then + With Sec.AddParagraph + .Style = "BodyText" + .Format.SpaceBefore = MigraDoc.DocumentObjectModel.Unit.FromPoint(16) + .Format.LineSpacingRule = MigraDoc.DocumentObjectModel.LineSpacingRule.Multiple + .Format.LineSpacing = "1.25" + '.AddText(person_details("letter_address") & ",") + '.AddLineBreak() + '.AddFormattedText(vbNewLine, smF) + '.AddText("dies ist " & If((New String() {"formal", "neutral"}).Contains(person_details("address_form")), "Ihr", "dein") & " Bekleidungsgutschein") + '.AddLineBreak() + .AddText(TB.body) + End With + End If + + Return Doc + End Function + + Public Function CreatePage_Empty(ByRef doc As MigraDoc.DocumentObjectModel.Document, Optional TopMargin As Double = 0, Optional BottomMargin As Double = 0, Optional LeftMargin As Double = 0, Optional RightMargin As Double = 0) As MigraDoc.DocumentObjectModel.Section + Try + ' Each MigraDoc document needs at least one section. + Dim section As Section = doc.AddSection() 'Avery 3424 + section.PageSetup.TopMargin = cm(TopMargin) + section.PageSetup.BottomMargin = cm(BottomMargin) + section.PageSetup.LeftMargin = cm(LeftMargin) + section.PageSetup.RightMargin = cm(RightMargin) + section.PageSetup.DifferentFirstPageHeaderFooter = False + + ''Put a logo in the header + 'With section.Headers.FirstPage.AddImage(AppFolder & "Images\RCGD_logo_2.png") + ' .Height = "1.5cm" + ' .LockAspectRatio = True + ' .RelativeVertical = Shapes.RelativeVertical.Line + ' .RelativeHorizontal = Shapes.RelativeHorizontal.Margin + ' .Top = "-1cm" + ' .Left = Shapes.ShapePosition.Right + ' .WrapFormat.Style = Shapes.WrapStyle.Through + 'End With + 'With section.Headers.FirstPage.AddParagraph + ' .Format.Font.Size = 14 + ' .Format.Font.Bold = True + ' .AddText("Freigaben") + ' .AddLineBreak() + ' .AddFormattedText("Stand: " & Now.ToShortDateString, New MigraDoc.DocumentObjectModel.Font("Arial", "9")) + 'End With + + '' Create footer + 'Dim paragraph As Paragraph = section.Footers.Primary.AddParagraph() + 'paragraph.AddText("RCGD-Freigaben: " & Now.ToShortDateString) + 'paragraph.Format.Font.Size = 9 + 'paragraph.Format.Alignment = ParagraphAlignment.Center + + 'Dim p2 As Paragraph = section.Footers.FirstPage.AddParagraph() + 'With p2 + ' .AddText("RCGD-Freigaben: " & Now.ToShortDateString) + ' .Format.Font.Size = 9 + ' .Format.Alignment = ParagraphAlignment.Center + 'End With + + Return section + Catch ex As Exception + OCMS.debug_log(project_abbreviation & "_intranet_fds_pdf CreatePage_Empty", ex:=ex) + Throw ex + End Try + End Function + Dim FuchsGrayColor As MigraDoc.DocumentObjectModel.Color = MigraDoc.DocumentObjectModel.Color.FromRgb(128, 128, 128) + Dim FuchsBlauColor As MigraDoc.DocumentObjectModel.Color = MigraDoc.DocumentObjectModel.Color.FromRgb(27, 66, 120) + Public Function CreatePage_letter(ByRef doc As MigraDoc.DocumentObjectModel.Document, TB As FDS__TextBlocks, Optional SettingsDic As GenericStringDictionary = Nothing, Optional draft As Boolean = False) As MigraDoc.DocumentObjectModel.Section + Try + If IsNothing(SettingsDic) Then SettingsDic = New GenericStringDictionary() + Dim TgtFont As String = SettingsDic.ItemOrAlt("TgtFont", "Arial") + Dim PageNumRowHeight As New Unit(doc.Styles("PageNumStyle").Font.Size.Millimeter, type:=UnitType.Millimeter), ISOPageNumMargin As New Unit(4.23, type:=UnitType.Millimeter) + ISOPageNumMargin = mm(10) + If SystemFontExists(TgtFont) = False Then TgtFont = "Arial" 'fallback + Dim TextBaseColor As MigraDoc.DocumentObjectModel.Color = MigraDoc.DocumentObjectModel.Colors.Black + + ' Each MigraDoc document needs at least one section. + Dim section As Section = doc.AddSection() + section.PageSetup.PageHeight = doc.DefaultPageSetup.PageHeight + section.PageSetup.PageWidth = doc.DefaultPageSetup.PageWidth + + section.PageSetup.TopMargin = SettingsDic.ItemOrAlt("TopMargin", cm(2)) + section.PageSetup.BottomMargin = SettingsDic.ItemOrAlt("BottomMargin", New Unit(22.5 + 2 * ISOPageNumMargin.Millimeter + PageNumRowHeight.Millimeter, type:=UnitType.Millimeter)) + section.PageSetup.LeftMargin = SettingsDic.ItemOrAlt("LeftMargin", cm(2.5)) + section.PageSetup.RightMargin = SettingsDic.ItemOrAlt("RightMargin", cm(2)) + section.PageSetup.DifferentFirstPageHeaderFooter = True + section.PageSetup.HeaderDistance = SettingsDic.ItemOrAlt("HeaderDistance", cm(0)) + + Dim PageInnerHeight As Unit = New Unit(section.PageSetup.PageHeight.Millimeter - section.PageSetup.TopMargin.Millimeter - section.PageSetup.BottomMargin.Millimeter, type:=UnitType.Millimeter), PageInnerWidth As Unit = New Unit(section.PageSetup.PageWidth.Millimeter - section.PageSetup.LeftMargin.Millimeter - section.PageSetup.RightMargin.Millimeter, type:=UnitType.Millimeter) + + 'Put a logo in the header + Dim LogoFilePath As String = OCMS.ocms_commons.ApplicationBase.FullName & "\Areas\Intranet\Data\image1.jpeg" + With section.Headers.FirstPage.AddImage(LogoFilePath) + .Width = mm(39.3) + .LockAspectRatio = True + .RelativeVertical = Shapes.RelativeVertical.Page + .RelativeHorizontal = Shapes.RelativeHorizontal.Page + .Top = cm(1.73) + .Left = cm(16.07) + .WrapFormat.Style = Shapes.WrapStyle.Through + End With + 'Put a logo in the header + Dim Logo2FilePath As String = OCMS.ocms_commons.ApplicationBase.FullName & "\Areas\Intranet\Data\image2.jpeg" + With section.Headers.FirstPage.AddImage(Logo2FilePath) + .Width = mm(25.4) + .LockAspectRatio = True + .RelativeVertical = Shapes.RelativeVertical.Page + .RelativeHorizontal = Shapes.RelativeHorizontal.Page + .Top = cm(4.89) + .Left = cm(17.5) + .WrapFormat.Style = Shapes.WrapStyle.Through + End With + 'Put a logo in the header + Dim Logo3FilePath As String = OCMS.ocms_commons.ApplicationBase.FullName & "\Areas\Intranet\Data\image3.jpeg" + With section.Headers.FirstPage.AddImage(Logo3FilePath) + .Width = mm(26) + .LockAspectRatio = True + .RelativeVertical = Shapes.RelativeVertical.Page + .RelativeHorizontal = Shapes.RelativeHorizontal.Page + .Top = cm(6.21) + .Left = cm(17.51) + .WrapFormat.Style = Shapes.WrapStyle.Through + End With + + 'Put a logo in the header + Dim Logo4FilePath As String = OCMS.ocms_commons.ApplicationBase.FullName & "\Areas\Intranet\Data\image4.png" + With section.Headers.FirstPage.AddImage(Logo4FilePath) + .Width = mm(25.4) + .LockAspectRatio = True + .RelativeVertical = Shapes.RelativeVertical.Page + .RelativeHorizontal = Shapes.RelativeHorizontal.Page + .Top = cm(7.79) + .Left = cm(17.5) + .WrapFormat.Style = Shapes.WrapStyle.Through + End With + + If draft = True Then + 'Put a logo in the header + Dim Overlay As Action(Of HeaderFooter) = Sub(HF As HeaderFooter) + Dim OverlayFilePath As String = OCMS.ocms_commons.ApplicationBase.FullName & "\Areas\Intranet\Data\overlay.png" + With HF.AddImage(OverlayFilePath) + .Width = cm(12) + .LockAspectRatio = True + .RelativeVertical = Shapes.RelativeVertical.Page + .RelativeHorizontal = Shapes.RelativeHorizontal.Page + .Left = Shapes.ShapePosition.Center + .Top = Shapes.ShapePosition.Center + .WrapFormat.Style = Shapes.WrapStyle.Through + End With + End Sub + + Overlay.Invoke(section.Headers.FirstPage) + Overlay.Invoke(section.Headers.Primary) + + End If + + 'If IsNothing(HeaderTextParagraph) = False Then section.Headers.FirstPage.Add(HeaderTextParagraph) + + Dim singlelineimage As New System.Drawing.Bitmap(20, 1) + For x As Integer = 0 To singlelineimage.Width - 1 + For y As Integer = 0 To singlelineimage.Height - 1 + singlelineimage.SetPixel(x, y, System.Drawing.Color.Black) + Next + Next + + + 'Marken + Dim mark As Action(Of HeaderFooter, Single) = Sub(ByVal HF As HeaderFooter, distFromTop As Single) + With HF.AddImage(MigraDocFilenameFromByteArray(imageToByteArray(singlelineimage))) + .LockAspectRatio = True + .Top = cm(distFromTop) + .Left = 0 + .RelativeVertical = Shapes.RelativeVertical.Page + .RelativeHorizontal = Shapes.RelativeHorizontal.Page + .WrapFormat.Style = Shapes.WrapStyle.Through + End With + End Sub + + 'Faltmarke + mark.Invoke(section.Headers.FirstPage, 10.7) + mark.Invoke(section.Headers.Primary, 10.7) + + 'Lochmarke + mark.Invoke(section.Headers.FirstPage, 14.85) + mark.Invoke(section.Headers.Primary, 14.85) + + + 'Put Sender to the Top + With section.Headers.FirstPage.AddTextFrame + .Top = cm(5.3) + .RelativeVertical = Shapes.RelativeVertical.Page + .RelativeHorizontal = Shapes.RelativeHorizontal.Margin + .Left = Shapes.ShapePosition.Left + .Height = mm(12.5) + .Width = cm(14) + With .AddParagraph + .Style = "AddressBoxSender" + If TB.AddressBox_sender_p1 <> "" Then + .AddFormattedText(TB.AddressBox_sender_p1, textFormat:=TextFormat.Bold) + End If + .AddText(TB.AddressBox_sender_p2) + End With + .WrapFormat.Style = Shapes.WrapStyle.Through + End With + 'Put Admin Info to the right + With section.Headers.FirstPage.AddTextFrame + .Top = mm(52.5) + .Left = cm(12.87) + .Height = cm(12) + .Width = cm(5) + .RelativeVertical = Shapes.RelativeVertical.Page + .RelativeHorizontal = Shapes.RelativeHorizontal.Page + With .AddParagraph + .Style = "AdminBlock" + .Format.SpaceBefore = 0 + .AddFormattedText("Bearbeiter", style:="AdminBlockHead") + .AddLineBreak() + .AddText(If(TB.Admin_User, "").ne(" ")) + End With + With .AddParagraph + .Style = "AdminBlock" + .AddFormattedText("Email", style:="AdminBlockHead") + .AddLineBreak() + .AddText(If(TB.Admin_User_Email, "").ne("-")) + End With + With .AddParagraph + .Style = "AdminBlock" + .AddFormattedText(TB.I_Admin_Datum_Label, style:="AdminBlockHead") + .AddLineBreak() + .AddText(If(TB.Admin_Datum, "").ne("-")) + End With + With .AddParagraph + .Style = "AdminBlock" + .AddFormattedText(TB.Admin_Prov_Label, style:="AdminBlockHead") + .AddLineBreak() + .AddText(If(TB.Admin_Prov, "").ne("-")) + End With + With .AddParagraph + .Style = "AdminBlock" + .AddFormattedText(TB.Admin_Ref_Label, style:="AdminBlockHead") + .AddLineBreak() + .AddText(If(TB.Admin_Ref, "").ne("-")) + End With + .WrapFormat.Style = Shapes.WrapStyle.Through + End With + + ' Create footer + Dim FTF As Action(Of Shapes.TextFrame, Single, String()) + FTF = Sub(TTF As Shapes.TextFrame, left As Single, BlockTexts As String()) + With TTF + .RelativeHorizontal = Shapes.RelativeHorizontal.Page + .RelativeVertical = Shapes.RelativeVertical.Page + .Left = cm(left) + .Top = mm(section.PageSetup.PageHeight.Millimeter - 25) + .Width = cm(4.5) + .Height = cm(2) + .Margin = 0 + Dim paragraph As MigraDoc.DocumentObjectModel.Paragraph = .AddParagraph() + With paragraph + .Style = "FooterBlock" + BlockTexts.ForEach(Sub(s As String) + .AddText(s) + .AddLineBreak() + End Sub) + End With + End With + End Sub + Dim TF As Shapes.TextFrame = section.Footers.Primary.AddTextFrame + FTF.Invoke(TF, 2.5, TB.FooterBlock1) + TF = section.Footers.FirstPage.AddTextFrame + FTF.Invoke(TF, 2.5, TB.FooterBlock1) + + TF = section.Footers.Primary.AddTextFrame + FTF.Invoke(TF, 2.5 + (1 * 4.25), TB.FooterBlock2) + TF = section.Footers.FirstPage.AddTextFrame + FTF.Invoke(TF, 2.5 + (1 * 4.25), TB.FooterBlock2) + + TF = section.Footers.Primary.AddTextFrame + FTF.Invoke(TF, 2.5 + (2 * 4.25), TB.FooterBlock3) + TF = section.Footers.FirstPage.AddTextFrame + FTF.Invoke(TF, 2.5 + (2 * 4.25), TB.FooterBlock3) + + TF = section.Footers.Primary.AddTextFrame + FTF.Invoke(TF, 2.5 + (3 * 4.25), TB.FooterBlock4) + TF = section.Footers.FirstPage.AddTextFrame + FTF.Invoke(TF, 2.5 + (3 * 4.25), TB.FooterBlock4) + + ' Create PageNums + Dim pagenum As Action(Of HeaderFooter) = Sub(HF As HeaderFooter) + With HF.AddTextFrame + .RelativeHorizontal = Shapes.RelativeHorizontal.Margin + .RelativeVertical = Shapes.RelativeVertical.Page + .Left = Shapes.ShapePosition.Right + .Top = mm(section.PageSetup.PageHeight.Millimeter - section.PageSetup.BottomMargin.Millimeter + 1 * ISOPageNumMargin.Millimeter) + .Width = cm(4.5) 'doesn't matter as long as it is wide enough + .Height = PageNumRowHeight + .Margin = 0 + + With .AddParagraph() + .Style = "PageNumStyle" + .Format.Alignment = ParagraphAlignment.Right 'Muss + .AddText("Seite ") + .AddPageField() + .AddText(" von ") + .AddNumPagesField() + End With + + End With + + End Sub + pagenum.Invoke(section.Footers.Primary) + pagenum.Invoke(section.Footers.FirstPage) + + + 'With section.Footers.Primary.AddParagraph + ' .Format.Alignment = ParagraphAlignment.Center + ' .Format.Font.Size = TgtFontSize_AdminTxt + ' .Format.Font.Name = TgtFont + ' .Format.Font.Color = TgtColor + ' .AddText(FooterAdminInfo) + 'End With + 'With section.Footers.FirstPage.AddParagraph + ' .Format.Alignment = ParagraphAlignment.Center + ' .Format.Font.Size = TgtFontSize_AdminTxt + ' .Format.Font.Name = TgtFont + ' .Format.Font.Color = TgtColor + ' .AddText(FooterAdminInfo) + 'End With + + Return section + Catch ex As Exception + OCMS.debug_log(project_abbreviation & "_intranet_fds_pdf CreatePage_letter", ex:=ex) + Throw ex + End Try + End Function + + Public Sub DefineStyles_Standard(ByRef doc As MigraDoc.DocumentObjectModel.Document, Optional TgtFont As String = "Arial") + If SystemFontExists(TgtFont) = False Then TgtFont = "Arial" + + doc.Styles.Normal.Font.Name = TgtFont + 'doc.Styles(StyleNames.Header).ParagraphFormat.AddTabStop("16cm", TabAlignment.Right) + 'doc.Styles(StyleNames.Footer).ParagraphFormat.AddTabStop("8cm", TabAlignment.Center) + + ' Style for Tables + With doc.Styles.AddStyle("BodyText", "Normal") + .Font.Name = TgtFont + .Font.Size = 12 + End With + + ' Style for Tables + With doc.Styles.AddStyle("Table", "Normal") + .Font.Name = TgtFont + .Font.Size = 12 + .ParagraphFormat.LineSpacingRule = LineSpacingRule.Single + End With + With doc.Styles.AddStyle("Table 1.5", "Normal") + .Font.Name = TgtFont + .Font.Size = 12 + .ParagraphFormat.LineSpacingRule = LineSpacingRule.OnePtFive + End With + With doc.Styles.AddStyle("TableSmaller", "Normal") + .Font.Name = TgtFont + .Font.Size = 8 + End With + + ' Reference Style + With doc.Styles.AddStyle("Reference", "Normal") + .ParagraphFormat.SpaceBefore = "5mm" + .ParagraphFormat.SpaceAfter = "5mm" + .ParagraphFormat.TabStops.AddTabStop("16cm", TabAlignment.Right) + End With + End Sub + Public Sub DefineStyles_Letter(ByRef doc As MigraDoc.DocumentObjectModel.Document, addstyles As Style(), Optional ByVal TgtFont As String = "Arial", Optional BaseSize As Single = 12.0) + If SystemFontExists(TgtFont) = False Then TgtFont = "Arial" + + + doc.Styles.Normal.Font.Name = TgtFont + doc.Styles.Normal.Font.Color = Colors.Black + + 'doc.Styles(StyleNames.Header).ParagraphFormat.AddTabStop("16cm", TabAlignment.Right) + 'doc.Styles(StyleNames.Footer).ParagraphFormat.AddTabStop("8cm", TabAlignment.Center) + + ' Styles + With doc.Styles.AddStyle("BodyText", "Normal") + .Font.Name = TgtFont + .Font.Size = BaseSize + End With + With doc.Styles.AddStyle("BodyText 1.5", "Normal") + .Font.Name = TgtFont + .Font.Size = BaseSize + .ParagraphFormat.LineSpacingRule = LineSpacingRule.OnePtFive + End With + With doc.Styles.AddStyle("BodyText b", "Normal") + .Font.Name = TgtFont + .Font.Size = BaseSize + .Font.Bold = True + End With + With doc.Styles.AddStyle("BodyText 1.5 b", "Normal") + .Font.Name = TgtFont + .Font.Size = BaseSize + .ParagraphFormat.LineSpacingRule = LineSpacingRule.OnePtFive + .Font.Bold = True + End With + With doc.Styles.AddStyle("AdminBlockHead", "Normal") + .Font = New Font(TgtFont, size:=9) With {.Color = FuchsGrayColor, .Bold = True} + End With + With doc.Styles.AddStyle("AdminBlock", "Normal") + .Font = New Font(TgtFont, size:=9) With {.Color = Colors.Black, .Bold = False} + .ParagraphFormat.SpaceBefore = cm(0.25) + .ParagraphFormat.LineSpacingRule = LineSpacingRule.Exactly + .ParagraphFormat.LineSpacing = (9 * 1.2) + End With + With doc.Styles.AddStyle("FooterBlock", "Normal") + .Font = New Font(TgtFont, size:=7) With {.Color = FuchsBlauColor} + .ParagraphFormat.Alignment = ParagraphAlignment.Left + .ParagraphFormat.LineSpacingRule = LineSpacingRule.Exactly + .ParagraphFormat.LineSpacing = 7.5 + End With + With doc.Styles.AddStyle("AddressBoxSender", "Normal") + .Font = New Font(TgtFont, size:=7.5) With {.Color = FuchsBlauColor} + .ParagraphFormat.Alignment = ParagraphAlignment.Left + .ParagraphFormat.LineSpacingRule = LineSpacingRule.Exactly + .ParagraphFormat.LineSpacing = 7.5 + End With + With doc.Styles.AddStyle("AddressBox", "Normal") + .Font = New Font(TgtFont, size:=10) With {.Color = Colors.Black} + .ParagraphFormat.Alignment = ParagraphAlignment.Left + .ParagraphFormat.LineSpacingRule = LineSpacingRule.Exactly + .ParagraphFormat.LineSpacing = 12 + End With + With doc.Styles.AddStyle("PageNumStyle", "Normal") + .Font = New Font(TgtFont, size:=10) With {.Color = Colors.Black} + .ParagraphFormat.Alignment = ParagraphAlignment.Right + .ParagraphFormat.LineSpacingRule = LineSpacingRule.Exactly + .ParagraphFormat.LineSpacing = 10 + End With + + If IsNothing(addstyles) = False AndAlso addstyles.Length > 0 Then + For Each st As Style In addstyles + doc.Styles.Add(st) + Next + End If + + End Sub + Public Sub Apply_Invoice_Styles(ByRef doc As MigraDoc.DocumentObjectModel.Document, Optional ByVal TgtFont As String = "Arial") + If SystemFontExists(TgtFont) = False Then TgtFont = "Arial" + + Dim addStyles As New List(Of Style) + + 'Dim normalParagraphFormat As ParagraphFormat = doc.Styles("Normal").ParagraphFormat.Clone + + ' Styles + addStyles.Add(New Style("SubjectBig", "Normal") With {.Font = New Font(TgtFont, 13) With {.Bold = True}}) + addStyles.Add(New Style("AdminInfo", "Normal") With {.Font = New Font(TgtFont, 9)}) + addStyles.Add(New Style("ProvisionLocation", "Normal") With {.Font = New Font(TgtFont, 9)}) + addStyles.Add(New Style("InvoiceBody", "Normal") With {.Font = New Font(TgtFont, 9)}) + Dim clb_pf As Func(Of MigraDoc.DocumentObjectModel.Document, ParagraphFormat) = Function(d As MigraDoc.DocumentObjectModel.Document) + Dim pf As ParagraphFormat = d.Styles("Normal").ParagraphFormat.Clone + With pf + .Borders.Distance = 3 + .Alignment = ParagraphAlignment.Left + End With + Return pf + End Function + + addStyles.Add(New Style("TblCell_Base", "Normal") With {.Font = New Font(TgtFont, 9), .ParagraphFormat = clb_pf(doc)}) + addStyles.Add(New Style("TblCell_Head", "TblCell_Base") With {.Font = New Font(TgtFont, 9) With {.Bold = False}}) + Dim tt_pf As ParagraphFormat = clb_pf(doc) + tt_pf.LineSpacingRule = LineSpacingRule.Multiple + tt_pf.LineSpacing = 1.15 + With tt_pf.Borders + .DistanceFromTop = 9 + .DistanceFromBottom = 6 + End With + addStyles.Add(New Style("TblCell_RTitle", "TblCell_Base") With {.Font = New Font(TgtFont, 9) With {.Bold = True}, .ParagraphFormat = tt_pf}) + addStyles.Add(New Style("TblCell_RSum", "TblCell_Base") With {.Font = New Font(TgtFont, 9) With {.Bold = True}}) + addStyles.Add(New Style("TblCell_TNet", "TblCell_Base") With {.Font = New Font(TgtFont, 9) With {.Bold = True}}) + addStyles.Add(New Style("TblCell_TVat", "TblCell_Base") With {.Font = New Font(TgtFont, 9) With {.Bold = False}}) + addStyles.Add(New Style("TblCell_TSum", "TblCell_Base") With {.Font = New Font(TgtFont, 9) With {.Bold = True}}) + Dim in_pf As ParagraphFormat = doc.Styles("Normal").ParagraphFormat.Clone + With in_pf + .LineSpacingRule = LineSpacingRule.Multiple + .LineSpacing = 1.05 + .SpaceBefore = 10 + .Alignment = ParagraphAlignment.Justify + End With + addStyles.Add(New Style("InvoiceNotes", "Normal") With {.Font = New Font(TgtFont, 9), .ParagraphFormat = in_pf}) + addStyles.Add(New Style("InvoiceNotes_ucb", "InvoiceNotes") With {.Font = New Font(TgtFont, 9) With {.Bold = True}}) + + + For Each st As Style In addStyles + doc.Styles.Add(st) + Next + + End Sub + + End Module + +End Namespace + + diff --git a/Intranet_Legacy/code/fuchs_fds_widgets.vb b/Intranet_Legacy/code/fuchs_fds_widgets.vb new file mode 100644 index 0000000..2678226 --- /dev/null +++ b/Intranet_Legacy/code/fuchs_fds_widgets.vb @@ -0,0 +1,390 @@ +Option Explicit On + +Imports System.Threading.Tasks +Imports OCMS +Imports OCMS.intranet +Imports OCMS.SQLHandling +Imports njson = Newtonsoft.Json.JsonConvert +Imports System.IO +Imports System.Web.Mvc +Imports OCMS.intranet.Controllers +Imports SO_Tools.SO +Imports vbs = Microsoft.VisualBasic.Strings + +Namespace Global.Fuchs.intranet + + + Public Module fuchs_fds_widgets + + Public Async Function intranet_wdg(Ctrl As IntranetController, fn As String) As Threading.Tasks.Task(Of ActionResult) + Try + Select Case fn + Case "my" + Dim wdglist As New List(Of String) + Dim wdg_dt As SQLDataTable = Await getSQLDatatable_async("SELECT * FROM [dbo].[fis_getONEPersonWidgets] (@authuser);", Ctrl.Intranet.Intranet__SQLConnectionString, SqlParameterList:=Ctrl.StdParamlist("@account", "fis"), ApplySymmetricKey:=Ctrl.Intranet.Intranet__sql_symmetric_key) + Dim wdg_rws As DataRow() = wdg_dt.Select("", If(wdg_dt.DataTable.Columns.Contains("order"), "order", "")) + Dim w As New List(Of String) + For Each wdg_rw As DataRow In wdg_rws + w.Add(wdg_rw.nz("short_name")) + 'jsonstring_list.Add(VM_WDG_OneWDG(wdg_rw, PDic)) + Next + Return Await JSONAsync(w.ToArray) + Case "one" + Dim wdg_dt As SQLDataTable = Await getSQLDatatable_async("SELECT * FROM [dbo].[fis_getONEPersonWidgets] (@authuser) WHERE [short_name] = @shortname;", Ctrl.Intranet.Intranet__SQLConnectionString, SqlParameterList:=Ctrl.StdParamlist(SQL_VarChar("@shortname", Ctrl.Form("short_name")), SQL_VarChar("@account", "fis")), ApplySymmetricKey:=Ctrl.Intranet.Intranet__sql_symmetric_key) + If wdg_dt.Count = 1 Then + Return Await JSONAsync(Await Fuchs_WDG_OneWDG(wdg_dt.FirstRow(), Ctrl.StdParamlist(), constring:=Ctrl.Intranet.Intranet__SQLConnectionString, server_path:=Ctrl.Request.Url.BaseUrl.AppendIf("/") & "intranet/", authlogin:=Ctrl.UserIdent.useraccount_id)) + Else + Return New ExceptionResult("", InternalCode:=OCMS_StatusCodes.exception) + End If + Case "one_chart" + Dim objectdic As New Dictionary(Of String, Object), ShortName As String = Ctrl.Form("short_name") + Dim wdg_dt As SQLDataTable = Await getSQLDatatable_async("SELECT TOP(1) * FROM [dbo].fis_widgets] WHERE [short_name] = @shortname;", Ctrl.Intranet.Intranet__SQLConnectionString, SqlParameterList:=Ctrl.StdParamlist("@shortname", ShortName), ApplySymmetricKey:=Ctrl.Intranet.Intranet__sql_symmetric_key) + 'Dim wdg_rws As DataRow() = wdg_dt.Select("", If(dt.Columns.Contains("order"), "order", "")) + If wdg_dt.Count = 1 Then + Return Await ImgAsync(img_b64:=(Await Fuchs_WDG_OneWDG(wdg_dt.FirstRow(), Ctrl.StdParamlist(), constring:=Ctrl.Intranet.Intranet__SQLConnectionString, server_path:=Ctrl.Request.Url.BaseUrl.AppendIf("/") & "intranet/", authlogin:=Ctrl.UserIdent.useraccount_id)).Item(ShortName), format:=Drawing.Imaging.ImageFormat.Png, FileDownloadName:=ShortName & ".png") + Else + Return New ExceptionResult("", InternalCode:=OCMS_StatusCodes.exception) + End If + End Select + Catch ex As Exception + debug_log("Global.Fuchs.intranet.fuchs_fds_widgets", ex:=ex, authuser:=Ctrl.UserAccountID, data:=Ctrl.Form) + Return New ExceptionResult("", InternalCode:=OCMS_StatusCodes.exception) + End Try + End Function + Public Async Function Fuchs_WDG_OneWDG_HTML(ByVal wdg_rw As DataRow, ByVal fuchs_plist As ParamList, constring As String) As Threading.Tasks.Task(Of String) + Dim Type As String = wdg_rw.nz("type").ToLower + Dim CacheData As String = "", ReturnString As String = "" + Dim DayCache As Boolean = False 'wdg_rw.NRw("daycache", True, False) + Dim Short_Name As String = wdg_rw.nz("short_name") + If left(Type, 3) = "sql" Then + Dim SQL As String = wdg_rw.nz("sql") + If Not SQL = "" Then + If Type = "sql_table" Then + Dim dt As SQLDataTable = Await getSQLDatatable_async(SQL, constring, fuchs_plist.Clone()) + Dim dtrws As DataRow() = dt.Select("", If(dt.DataTable.Columns.Contains("order"), "order", "")) + Dim admincols As New List(Of String) + admincols.AddRange(wdg_rw.nz("sql_admin_columns").ToLower.Split(",")) + Dim DTC As New Dictionary(Of String, String) + For Each dti As String In wdg_rw.nz("sql_datatypes").Split(",") + If Not dti = "" Then + Dim dtx As String() = dti.Split(":") + DTC.Add(dtx(0), dtx(1)) + End If + Next + + Dim wdgdiv As SOC = New SOC("div").style("background-color: #fff;border: 1px solid #ccc;border-radius: 6px;box-shadow: 1px 1px 3px 0 rgba(0,0,0,.17);height: 300px;margin-bottom: 10px;position: relative;width: 300px;margin-right: 15px;") + Dim wdg_hd As SOC = New SOC("div").style("border-top-left-radius: 4px;border-top-right-radius: 4px;height: 20px;position: relative;background-color: #8396bd;color: #ecf0f1;text-align: center;font-size: 12px;font-weight: bold;").text(wdg_rw.nz("name")).appendTo(wdgdiv) + + Dim tbl As SOC = New SOC("table").style("border-collapse: collapse;width: 100%;background-color:transparent;border-spacing: 0;").appendTo(wdgdiv) + Dim tbl_bdy As SOC = New SOC("tbody").appendTo(tbl) + + Dim thr As SOC = New SOC("tr").style("border: none;").appendTo(tbl_bdy) + + Dim cols As New List(Of String) + For Each col As DataColumn In dt.DataTable.Columns + If Not admincols.Contains(col.ColumnName.ToLower) Then + cols.Add(col.ColumnName) + Dim th As SOC = New SOC("th").style("background-color: #ccc; padding: 2px 4px; font-size: 11px; border: 1px solid transparent;").text(col.ColumnName).appendTo(thr) + End If + Next + For Each drw As DataRow In dtrws + Dim tdr As SOC = New SOC("tr").appendTo(tbl_bdy) + 'tdr.Attributes.Add("style", "border: none;") + For Each col In cols + Dim td As SOC = New SOC("th").style("padding: 2px 4px;font-size: 12px;border: 1px solid #ccc;").appendTo(tdr) 'border-right: none; + If dt.DataTable.Columns(col).DataType = GetType(Date) Then + Try + td.InnerText = drw.ndt_string(col, format:="dd.MM.yyyy", New Globalization.CultureInfo("de")) + Catch ex As Exception + End Try + Else + td.InnerText = drw.nz(col) + End If + Next + Next + Return Await wdgdiv.outerHtml_async() + End If + End If + End If + Return "" + End Function + + Public Async Function Fuchs_WDG_OneWDG(ByVal wdg_rw As DataRow, ByVal fuchs_plist As ParamList, constring As String, server_path As String, authlogin As String, Optional parameter As Dictionary(Of String, String) = Nothing) As Threading.Tasks.Task(Of Dictionary(Of String, Object)) + Dim Type As String = wdg_rw.nz("type").ToLower + Dim CacheData As Dictionary(Of String, Object) = Nothing + Dim DayCache As Boolean = False 'wdg_rw.nbool("daycache", alternative:=False) + Dim Short_Name As String = wdg_rw.nz("short_name") + If DayCache = True Then + Try + Dim pl As New ParamList(fuchs_plist) + pl.AddParameter("short_name", Short_Name) + Dim cachesql As SQLObjectTyped(Of Object) = Await getSQLValue_async(Of Object)("EXECUTE [dbo].[vm__widgets_getCache] @account, @short_name, @login_guid;", Global.Fuchs.intranet.fuchs_ocms_intranet.Intranet.Intranet__SQLConnectionString, pl) + Dim cachestr As String = cachesql.nz() + If cachestr <> "" Then + CacheData = New Dictionary(Of String, Object) From {{Short_Name, If(cachestr.StartsWith(Short_Name), Newtonsoft.Json.JsonConvert.DeserializeObject("{ " & cachestr & " }"), Newtonsoft.Json.JsonConvert.DeserializeObject(cachestr))}} + End If + Catch ex As Exception + CacheData = Nothing + End Try + Else CacheData = Nothing + End If + + If left(Type, 3) = "sql" Then + Dim SQL As String = wdg_rw.nz("sql") + If Not SQL = "" Then + If Type = "sql_table" Then + If Information.IsNothing(CacheData) = True Then + Dim plist As New ParamList(fuchs_plist) + Dim dt As SQLDataTable = Await getSQLDatatable_async(SQL, constring, plist) + Dim dtrws As DataRow() = dt.Select("", If(dt.DataTable.Columns.Contains("order"), "order", "")) + Dim admincols As New List(Of String) + admincols.AddRange(wdg_rw.nz("sql_admin_columns").ToLower.Split(",")) + Dim DTC As New Dictionary(Of String, String) + For Each dti As String In wdg_rw.nz("sql_datatypes").Split(",") + If Not dti = "" Then + Dim dtx As String() = dti.Split(":") + DTC.Add(dtx(0), dtx(1)) + End If + Next + Dim cols As New List(Of String) + For Each col As DataColumn In dt.DataTable.Columns + If Not admincols.Contains(col.ColumnName.ToLower) Then cols.Add(col.ColumnName) + Next + Dim wdg_kvp As New Dictionary(Of String, Object) From {{Short_Name, New With {.name = wdg_rw.nz("name"), .description = wdg_rw.nz("description"), .type = "table", .columns = cols.ToArray(), .data = dt.DataTable.toArrayofObjectDictionaries(), .rendering_options = wdg_rw.nz("rendering_options").Split(";")}}} + + If DayCache Then + Try + Dim cpl As New ParamList(fuchs_plist) + cpl.AddParameter("short_name", Short_Name) + cpl.AddParameter("data", Newtonsoft.Json.JsonConvert.SerializeObject(wdg_kvp.Item(Short_Name))) + Await setSQLValue_async("EXECUTE [dbo].[vm__widgets_setCache] @account, @short_name, @login_guid, @data;", SQLConnectionString:=constring, SqlParameterList:=cpl) + Catch ex As Exception + End Try + End If + + Return wdg_kvp + Else + Return CacheData + End If + ElseIf Type = "sql_indicator" Then + If Information.IsNothing(CacheData) = True Then + Dim plist As New ParamList(fuchs_plist) + Dim dt As SQLDataTable = Await getSQLDatatable_async(SQL, constring, plist) + Dim dtrws As DataRow = dt.FirstRow() + + Dim wdg_kvp As New Dictionary(Of String, Object) From {{Short_Name, New With {.name = wdg_rw.nz("name"), .description = wdg_rw.nz("description"), .type = "ind", .columns = Nothing, .data = dtrws.toDictionary, .rendering_options = wdg_rw.nz("rendering_options").Split(";")}}} + + If DayCache Then + Try + Dim cpl As New ParamList(fuchs_plist) + cpl.AddParameter("short_name", Short_Name) + cpl.AddParameter("data", Newtonsoft.Json.JsonConvert.SerializeObject(wdg_kvp.Item(Short_Name))) + Await setSQLValue_async("EXECUTE [dbo].[vm__widgets_setCache] @account, @short_name, @login_guid, @data;", SQLConnectionString:=constring, SqlParameterList:=cpl) + Catch ex As Exception + End Try + End If + + Return wdg_kvp + Else + Return CacheData + End If + ElseIf Type = "sql_chart" Then + + Dim chartsettings As ChartSettingsDic = Nothing + + 'the new was json + If wdg_rw.nz("server_options").StartsWith("{") Then + chartsettings = New ChartSettingsDic(wdg_rw.nz("server_options")) + Else + chartsettings = New ChartSettingsDic() + 'the old way, 2-dimensionally separated string + Dim ServerOptions As Dictionary(Of String, String) = StringToDic(wdg_rw.nz("server_options"), ":", "|") + + With chartsettings + If ServerOptions.ContainsKey("Title") Then .Add("title", ServerOptions("Title")) + .Add("series_column", If(ServerOptions.ContainsKey("series_column"), ServerOptions("series_column"), "series")) + .Add("x1_column", If(ServerOptions.ContainsKey("x1_column"), ServerOptions("x1_column"), "x")) + .Add("y1_column", If(ServerOptions.ContainsKey("y1_column"), ServerOptions("y1_column"), "y")) + + If ServerOptions.ContainsKey("x1_title") Then .Add("x1_title", ServerOptions("x1_title")) + If ServerOptions.ContainsKey("x1_interval") Then .Add("x1_interval", ServerOptions("x1_interval")) + If ServerOptions.ContainsKey("x1_fontsize") Then .Add("x1_fontsize", ServerOptions("x1_fontsize")) + If ServerOptions.ContainsKey("x1_label_angle") Then .Add("x1_label_angle", ServerOptions("x1_label_angle")) + If ServerOptions.ContainsKey("y1_title") Then .Add("y1_title", ServerOptions("y1_title")) + + If ServerOptions.ContainsKey("y1_min") Then + If ServerOptions("y1_min").StartsWith("sql(") Then + .Add("y1_min", Await getSQLValue_async(FindFramedPart(ServerOptions("y1_min"), "sql(", ")"), constring, fuchs_plist.Clone())) + Else + .Add("y1_min", ServerOptions("y1_min")) + End If + End If + If ServerOptions.ContainsKey("y1_max") Then + If ServerOptions("y1_max").StartsWith("sql(") Then + .Add("y1_max", Await getSQLValue_async(FindFramedPart(ServerOptions("y1_max"), "sql(", ")"), constring, fuchs_plist.Clone())) + Else + .Add("y1_max", ServerOptions("y1_max")) + End If + End If + If ServerOptions.ContainsKey("y1_interval") Then + If left(ServerOptions("y1_interval"), 4) = "sql(" Then + .Add("y1_interval", Await getSQLValue_async(FindFramedPart(ServerOptions("y1_interval"), "sql(", ")"), constring, fuchs_plist.Clone())) + Else + .Add("y1_interval", ServerOptions("y1_interval")) + End If + End If + + If ServerOptions.ContainsKey("y1_fontsize") Then .Add("y1_fontsize", ServerOptions("y1_fontsize")) + If ServerOptions.ContainsKey("series_colors") Then .Add("series_colors", ServerOptions("series_colors")) + + If ServerOptions.ContainsKey("showdate") Then .Add("showdate", ServerOptions("showdate").ToLower = "true" OrElse ServerOptions("showdate") = "1") + If ServerOptions.ContainsKey("showlegend") Then .Add("showlegend", ServerOptions("showlegend").ToLower = "true" OrElse ServerOptions("showlegend") = "1") + If ServerOptions.ContainsKey("barwidth") Then .Add("barwidth", ServerOptions("barwidth")) + If ServerOptions.ContainsKey("charttype") Then .Add("charttype", ServerOptions("charttype")) + + End With + End If + chartsettings.Add("width", If(wdg_rw.nz("rendering_options").Contains("dblwidth"), 292 + 315, 292)) + chartsettings.Add("height", 252) + Dim Chart As New GenericCharts.Chart(SQLCommand:=SQL, SqlConnectionString:=Global.Fuchs.intranet.fuchs_ocms_intranet.Intranet.Intranet__SQLConnectionString, Auth:="", SQLParameterList:=fuchs_plist.Clone, DateSQLCommand:="SELECT GETDATE()") With { + .Series_Colors_SeriesSplit = ";", + .Series_Colors_ValueSplit = "-", + .Series_Colors_ParameterSplit = "" + } + Chart.Init(chartsettings:=chartsettings, VDic:=New GenericCharts.VariablesDic(wdg_rw.nz("variables"), parameter, authlogin)) + + Dim wddic As New Dictionary(Of String, Object) From { + {"name", wdg_rw.nz("name")}, + {"description", wdg_rw.nz("description")}, + {"type", "image_base64"}, + {"rendering_options", vbs.Split(wdg_rw.nz("rendering_options"), ";")}, + {"image", Chart.ToBase64string()} + } + Return New Dictionary(Of String, Object) From {{Short_Name, wddic}} + Else + Return Nothing + End If + Else + Return Nothing + End If + + ElseIf left(Type, 3) = "url" Then + If Type = "url_chart" Then + Dim wddic As New Dictionary(Of String, Object) From { + {"name", wdg_rw.nz("name")}, + {"description", wdg_rw.nz("description")}, + {"type", "image_url"}, + {"rendering_options", wdg_rw.nz("rendering_options").Split(";")}, + {"url", Global.OCMS.intranet.proxy.OCMS_Proxy(wdg_rw.nz("url"))} + } + Return New Dictionary(Of String, Object) From {{Short_Name, wddic}} + Else + Return Nothing + End If + ElseIf Type = "method" Then + Dim wddic As New Dictionary(Of String, Object) From { + {"name", wdg_rw.nz("name")}, + {"description", wdg_rw.nz("description")}, + {"type", "html"}, + {"rendering_options", wdg_rw.nz("rendering_options").Split(";")} + } '{"html", CallByName(New VM_Widgets,LeftToFirst(wdg_rw.nz("url"), ";", False) , CallType.Get, Strings.Split(RightFromFirst(wdg_rw.nz("url"), ";", True, False), ",")))} + Dim Method As String() = wdg_rw.nz("url").Split(";") + If Method.Length > 0 Then + Select Case wdg_rw.nz("url").LeftToFirst(";", emptyIfNotFound:=False).ToLower() + Case "weather" + If Method.Length > 1 Then + wddic.Add("html", Await Weather(Method(1), servername:=server_path)) + End If + End Select + If wddic.ContainsKey("html") Then + Return New Dictionary(Of String, Object) From {{Short_Name, wddic}} + Else + Return Nothing + End If + Else + Return Nothing + End If + ElseIf Type = "html" Then + Dim wddic As New Dictionary(Of String, Object) From {{"name", wdg_rw.nz("name")}, {"description", wdg_rw.nz("description")}, {"type", "html"}} + wddic.Add("rendering_options", wdg_rw.nz("rendering_options").Split(";")) + If Not wdg_rw.nz("url") = "" Then + Dim html = "" + Try + Dim turib As New System.UriBuilder() + If left(wdg_rw.nz("url"), 4).ToLower = "http" Then + turib = New System.UriBuilder(wdg_rw.nz("url")) + Else + turib = New System.UriBuilder("http://" & server_path & "/" & wdg_rw.nz("url")) + End If + Dim wqrequest As Net.HttpWebRequest = Net.WebRequest.Create(turib.ToString) + Dim wqResponse As Net.HttpWebResponse + wqResponse = wqrequest.GetResponse + Dim reader As New StreamReader(wqResponse.GetResponseStream()) + html = reader.ReadToEnd() + Catch exwrq As Exception + End Try + wddic.Add("html", Global.OCMS.intranet.proxy.OCMS_Proxyfy(path:=server_path, Input:=wdg_rw.nz("html"), safemode:=wdg_rw.nbool("safemode", alternative:=False))) + Return New Dictionary(Of String, Object) From {{Short_Name, wddic}} + Else + wddic.Add("html", Global.OCMS.intranet.proxy.OCMS_Proxyfy(path:=server_path, Input:=wdg_rw.nz("html"), safemode:=wdg_rw.nbool("safemode", alternative:=False))) + Return New Dictionary(Of String, Object) From {{Short_Name, wddic}} + End If + Else + Return Nothing + End If + End Function + + + + + + Public Async Function Weather(CityCode As String, Optional servername As String = Nothing) As Threading.Tasks.Task(Of String) + Try + Dim Proxyhost As String = If(servername, "") + + Dim WeatherNfo As SortedDictionary(Of Date, GenericStringDictionary) = (Await Global.Fuchs.intranet.services.GetWeather(CityCode:=CityCode)).getNextValid(Now(), 5) + Dim f As SOC = New SOC("div").style("width: 100%; height: 100%; padding: 0.5rem; overflow: hidden;") + Dim d As SOC = New SOC("div").style("width: 100%; height:270px; position:relative; font-family: Verdana,​Geneva,​sans-serif; font-size:12px;margin: 4px;display: grid;grid-template-rows: 90px 130px auto;grid-template-columns: 25% 25% 25% 25%;").appendTo(f) + + Dim first As Boolean = True + For Each ky As Date In WeatherNfo.Keys + Dim itm As GenericStringDictionary = WeatherNfo.Item(ky) + Dim c As SOC = New SOC("div").appendTo(d) + If first Then + + With c + .style("width:100%; grid-column-start: 1; grid-column-end: 5; overflow: hidden;") + .InnerHtml = "
" & + "
" & Format(ky, "ddd, dd.MM. HH") & " Uhr
" & + "
" & itm("t_min_rw") & " - " & itm("t_max_rw") & "°C
" & + "
" & itm("status_txt") & "
" + End With + + Else + With c + .style("display:block; overflow: hidden; width: 100%; position: relative;" & If(ky <> WeatherNfo.Last.Key, "border-right: 1px solid #CCCCCC;", "")) + .InnerHtml = "
" & If(Format(ky, "yyMMdd") = Format(Now(), "yyMMdd"), "Heute", Format(ky, "dddd")) & "
" & + "
" & Format(ky, "HH") & " Uhr
" & + "
" & + "
" & itm("t_min_rw") & " / " & itm("t_max_rw") & "°C
" & + "
" & itm("status_txt") & "
" + End With + End If + first = False + Next + Dim cr As SOC = New SOC("div").style("width: 100%; display: block; grid-column-start: 1; grid-column-end: 5; overflow: hidden; margin-top: 10px;").appendTo(d) + cr.InnerHtml = "
" & WeatherNfo.First.Value("credit_text") & "
" & + "
" + Return Await f.outerHtml_async() + Catch ex12 As Exception + Debug.Print("fuchs_fds_widgets.weather", ex12, Nothing, False) + Return "" + End Try + End Function + End Module + + +End Namespace + + + diff --git a/Intranet_Legacy/code/fuchs_intranet.vb b/Intranet_Legacy/code/fuchs_intranet.vb new file mode 100644 index 0000000..f7f3cb2 --- /dev/null +++ b/Intranet_Legacy/code/fuchs_intranet.vb @@ -0,0 +1,928 @@ +Option Explicit On + +Imports System.Threading.Tasks +Imports OCMS +Imports OCMS.intranet +Imports OCMS.SQLHandling +Imports njson = Newtonsoft.Json.JsonConvert + + + +Namespace Global.Fuchs.intranet + + Module fuchs_ocms_intranet + + Public Intranet As Global.Fuchs.intranet.Fuchs_intranet + + Public Function getIntranet() As OCMS_intranet + If IsNothing(Global.Fuchs.intranet.Intranet) Then + Global.Fuchs.intranet.Intranet = New Global.Fuchs.intranet.Fuchs_intranet("Fuchs.intranet") + End If + Return Global.Fuchs.intranet.Intranet + End Function + Public Function getFuchsIntranet() As Global.Fuchs.intranet.Fuchs_intranet + If IsNothing(Global.Fuchs.intranet.Intranet) Then + Global.Fuchs.intranet.Intranet = New Global.Fuchs.intranet.Fuchs_intranet("Fuchs.intranet") + End If + Return Global.Fuchs.intranet.Intranet + End Function + + End Module + + + Public Class fds__reminder_data + Dim base As Newtonsoft.Json.Linq.JObject + Public ReadOnly Property newvalues As GenericObjectDictionary + Public ReadOnly Property [rem] As GenericObjectDictionary + + + Public ReadOnly Property ReminderRegistration As GenericObjectDictionary + + + Public ReadOnly Property Id As String + Get + Return If(IsNothing(Me.ReminderRegistration) = True, "", Me.ReminderRegistration.Item("Id", ReturnAlternative:="")) + End Get + End Property + Public ReadOnly Property IsDraft As Boolean + +#Region "props" + Public ReadOnly Property raw_InvoiceAddress As String() + Get + 'Me.newvalues("invoiceaddress") + If IsNothing(Me.newvalues) = True OrElse Me.newvalues("invoiceaddress", ReturnAlternative:="") = "" Then + Return New String() {} + Else + Return Me.newvalues.nz("invoiceaddress").Replace("
", vbLf).Replace("
", vbLf).Replace("
", vbLf).Replace(vbCrLf, vbLf).Replace(vbLf & vbLf, vbLf).Split(vbLf).Convert(Of String)(Function(t As String) HttpUtility.HtmlDecode(t.Trim())).Where(Function(t As String) t <> "").ToArray + End If + End Get + End Property + + Public ReadOnly Property raw_InvoiceEmail As String + Get + Return If(IsNothing(Me.newvalues) = True, "", Me.newvalues.nz("invoiceemail").Trim()) + End Get + End Property + Public ReadOnly Property raw_InvId As String + Get + Return If(IsNothing(Me.[rem]) = True, "", Me.[rem].nz("invid").ne(Me.[rem].nz("InvId")).Trim()) + End Get + End Property + Public ReadOnly Property raw_CustomValues As String + Get + Return If(IsNothing(Me.newvalues) = True, "", Me.newvalues.nz("CustomValues").Trim()) + End Get + End Property + + Public ReadOnly Property DateCreated As Date? + Get + Return If(IsNothing(Me.ReminderRegistration) = True, Nothing, Me.ReminderRegistration.nz("DateCreated")) + End Get + End Property + Public ReadOnly Property ReminderType As String + Get + Return If(IsNothing(Me.ReminderRegistration) = True, "", Me.ReminderRegistration.nz("type").Substr(0, 1)) + End Get + End Property + + Public ReadOnly Property UserNameFinalized As String + Get + Return If(IsNothing(Me.ReminderRegistration) = True, "", Me.ReminderRegistration.nz("UserNameFinalized")) + End Get + End Property + Public ReadOnly Property UserEmailFinalized As String + Get + Return If(IsNothing(Me.ReminderRegistration) = True, "", Me.ReminderRegistration.nz("UserEmailFinalized")) + End Get + End Property + + Public ReadOnly Property InvoiceId As String + Get + Return If(IsNothing(Me.ReminderRegistration), "", Me.ReminderRegistration("InvoiceId", ReturnAlternative:="")) + End Get + End Property + Public ReadOnly Property InvoiceAddress As String() + Get + Return If(IsNothing(Me.ReminderRegistration) = True, New String() {}, Me.ReminderRegistration.nz("SendToAddress").Replace("
", vbLf).Replace("
", vbLf).Replace("
", vbLf).Replace(vbCrLf, vbLf).Replace(vbLf & vbLf, vbLf).Split(vbLf).ForEach(Function(t As String) t.Trim())) + End Get + End Property + + Public ReadOnly Property InvoiceEmail As String + Get + Return If(IsNothing(Me.ReminderRegistration) = True, "", Me.ReminderRegistration.nz("SendToEmail")) + End Get + End Property + Public ReadOnly Property ReminderTitle As String + Get + Return If(IsNothing(Me.ReminderRegistration) = True, "", Me.ReminderRegistration.nz("subject")) + End Get + End Property + Public ReadOnly Property Subject As String + Get + Return If(IsNothing(Me.ReminderRegistration) = True, "", Me.ReminderRegistration.nz("subject")) + End Get + End Property + + +#End Region + + + + Public Sub New(ctd As Newtonsoft.Json.Linq.JObject) + Me.base = ctd + Me._IsDraft = True + If IsNothing(ctd) = False Then + If Me.base.ContainsKey("new") Then Me._newvalues = New GenericObjectDictionary(Me.base("new").ToObject(Of Dictionary(Of String, Object))) + If Me.base.ContainsKey("rem") Then Me._rem = New GenericObjectDictionary(Me.base("rem").ToObject(Of Dictionary(Of String, Object))) + End If + End Sub + Public Sub New(ID As String, ctrl As Global.OCMS.intranet.Controllers.IntranetController) + Me.RegisterReminder(ID:=ID, ctrl:=ctrl) + End Sub + + Private _letter As MigraDoc.DocumentObjectModel.Document + Friend ReadOnly Property ReminderPDF(ctrl As Global.OCMS.intranet.Controllers.IntranetController) As MigraDoc.DocumentObjectModel.Document + Get + If IsNothing(Me._letter) = True Then + If IsNothing(Me.ReminderRegistration) = True Then Call RegisterReminder(Me.Id, ctrl) + Dim tb As New pdf.FDS__TextBlocks() With { + .Admin_Ref = "",'Me.ReminderId, + .address = Me.InvoiceAddress, + .Admin_User = Me.UserNameFinalized, + .Admin_User_Email = Me.UserEmailFinalized, + .Admin_Datum_Value = Me.DateCreated + } + If Me.raw_CustomValues <> "" Then + Dim o As New GenericObjectDictionary(Me.raw_CustomValues) + If o("contactEmail") <> "" OrElse o("contactName") <> "" Then + tb.Admin_User = o("contactName") + tb.Admin_User_Email = o("contactEmail") + End If + End If + Me._letter = Threading.Tasks.Task.Run(Async Function() Await Global.Fuchs.intranet.pdf.writeLetter(TB:=tb, draft:=Me.IsDraft, locale:=pdf.deculture)).Result() + Me._letter.Info.Title = Me.ReminderTitle + pdf.ApplyReminder(Me._letter, tb, Me, draft:=Me.IsDraft) + End If + Return Me._letter + End Get + End Property + + Public Async Function getReminderFile(ctrl As Global.OCMS.intranet.Controllers.IntranetController) As Task(Of Byte()) + + Dim ba As Byte() = New Byte() {} + If Me.ReminderRegistration("IsFinal", ReturnAlternative:=False) = True Then + If (Me.ReminderRegistration.ContainsKey("hasFile") = False OrElse Me.ReminderRegistration("hasFile", ReturnAlternative:=False) = False) Then + Call Me.StoreReminderDocumentFile(ctrl) + End If + Call fds.fds_mfr.getFDSDoc(file:=ba, reportid:=Me.Id, type:="reminder") + Else + + 'render + Dim pdfrend As New MigraDoc.Rendering.PdfDocumentRenderer(True) + pdfrend.Document = Me.ReminderPDF(ctrl) + pdfrend.RenderDocument() + + 'output + Using MStream As New IO.MemoryStream + pdfrend.PdfDocument.Save(MStream, False) + MStream.Position = 0 + ba = MStream.ToArray() + End Using + + 'convert to pdfa + ba = Global.OCMS.pdf.pdfAFileContent(ba) + End If + Return ba + End Function + + Public Async Function StoreReminderDocumentFile(ctrl As Global.OCMS.intranet.Controllers.IntranetController) As Task(Of Byte()) + Dim pl As New ParamList + pl.AddParameter("Id", Me.Id) + + Dim ba As Byte() + Try + 'render + Dim pdfrend As New MigraDoc.Rendering.PdfDocumentRenderer(True) + pdfrend.Document = Me.ReminderPDF(ctrl) + pdfrend.RenderDocument() + + ''output + Using MStream As New IO.MemoryStream + pdfrend.PdfDocument.Save(MStream, False) + MStream.Position = 0 + ba = MStream.ToArray() + End Using + + 'convert to pdfa + ba = Global.OCMS.pdf.pdfAFileContent(ba) + Catch ex As Exception + ba = New Byte() {} + End Try + If ba.Length > 0 Then + pl.Add(New SqlClient.SqlParameter("@file", dbType:=SqlDbType.VarBinary) With {.Value = ba}) + + Dim r As Boolean = Await setSQLValue_async("EXECUTE [dbo].[fds__setReminderFile] @Id, @file;", ctrl.Intranet.Intranet__SQLConnectionString, SqlParameterList:=pl, ApplySymmetricKey:=ctrl.Intranet.Intranet__sql_symmetric_key, options:=New FIS_SQLOptions()) + Return If(r = True, ba, Nothing) + Else + Return Nothing + End If + + End Function + + Public Sub RegisterReminder(ctrl As Global.OCMS.intranet.Controllers.IntranetController, change As Boolean, RemId As String) + If IsNothing(Me.[rem]) = False AndAlso Me.[rem].Count > 0 Then + Dim r = Threading.Tasks.Task.Run(Async Function() + Try + + Dim IsChange As Boolean = change = True AndAlso RemId <> "" + + Dim pl As ParamList = ctrl.StdParamlist() + With pl + .Add(SQL_VarChar("InvId", Me.raw_InvId())) + .Add(SQL_Char("type", Me.[rem]("type"))) + .Add(SQL_float("amount", stringvalue:=Me.newvalues("amount"))) + .Add(SQL_float("amount_payed", stringvalue:=Me.newvalues("amount_payed"))) + .Add(SQL_VarChar("SendToAddress", Me.raw_InvoiceAddress.join(vbLf))) + .Add(SQL_NVarChar("SendToEmail", Me.raw_InvoiceEmail)) + .Add(SQL_NVarChar("subject", Me.newvalues("subject", ""), dbNull_IfEmpty:=True)) + .Add(SQL_NVarChar("text", Me.newvalues("text", ""), dbNull_IfEmpty:=True)) + End With + + Dim sql As New List(Of String) From {"DECLARE @Id varchar(10);"} + If IsChange = False Then + sql.AddRange(New String() { + "EXECUTE [dbo].[fds__createReminder] @InvId, @type, @amount, @amount_payed, @SendToAddress, @SendToEmail, @subject, @text, @authuser, @Id OUTPUT;" + }) + Else + pl.Add(SQL_VarChar("RemId", RemId)) + 'sql.AddRange(New String() { + ' "EXECUTE [dbo].[fds__setInvoice] @InvId, @InvoiceType, @InvoiceTitle, @InvoiceBalance, @InvoiceBalance_net, @InvoiceVAT_net1, @InvoiceVAT_1, @PaymentTerm, @CustomerId, @SendToAddress, @SendToEmail, @ProvisionPeriod, @CustomValues, @authuser, @Id OUTPUT;" + ' }) + End If + Dim remdset As SQLDataSet = Await getSQLDataSet_async(sql.ToArray.join(vbLf), ctrl.Intranet.Intranet__SQLConnectionString, SqlParameterList:=pl, ApplySymmetricKey:=ctrl.Intranet.Intranet__sql_symmetric_key, tablenames:=New String() {"rem"}, options:=New FIS_SQLOptions()) + If remdset.Exception <> "" Then + Diagnostics.Debug.Print("fds__reminder_data.RegisterReminder_V1 - set/create - sql exception: " & remdset.Exception) + ctrl.FuchsIntranet.debug_log("fds__reminder_data.RegisterReminder_V1 - set/create - sql exception: ", [error]:=remdset.Exception, data:=New With {.sql = sql, .pl = pl.ToDictionary}) + End If + Me._ReminderRegistration = New GenericObjectDictionary(Base:=remdset.Table("rem").FirstRow.toObjectDictionary()) + Catch REMex As Exception + ctrl.FuchsIntranet.debug_log("fds__reminder_data.RegisterReminder_V1", ex:=REMex, data:=New With {.form = ctrl.Form.CustomParamsToJson(), .account = ctrl.AuthAccount, .user = ctrl.UserAccountID}) + End Try + Return True + End Function).Result() + + End If + End Sub + + Public Sub RegisterReminder(ID As String, ctrl As Global.OCMS.intranet.Controllers.IntranetController) + If If(ID, "") <> "" Then + Dim r = Threading.Tasks.Task.Run(Async Function() + Try + + Dim pl As ParamList = ctrl.StdParamlist("Id", ID) + pl.Add(SQL_bit("@includefile", False)) + Dim sql As String = "EXECUTE [dbo].[fds__getReminder] @Id, @includefile, @authuser;" + Dim remdset As SQLDataSet = Await getSQLDataSet_async(sql, ctrl.Intranet.Intranet__SQLConnectionString, SqlParameterList:=pl, ApplySymmetricKey:=ctrl.Intranet.Intranet__sql_symmetric_key, tablenames:=New String() {"admin", "rem"}, options:=New FIS_SQLOptions()) + If remdset.Exception <> "" Then + Diagnostics.Debug.Print("fds__reminder_data.RegisterReminder_V2 - set/create - sql exception: " & remdset.Exception) + ctrl.FuchsIntranet.debug_log("fds__reminder_data.RegisterReminder_V2 - set/create - sql exception: ", [error]:=remdset.Exception, data:=New With {.sql = sql, .pl = pl.ToDictionary}) + End If + Me._ReminderRegistration = New GenericObjectDictionary(Base:=remdset.Table("rem").FirstRow.toObjectDictionary()) + Me._IsDraft = Not (Me._ReminderRegistration("IsFinal") = True) + Catch REMex As Exception + ctrl.FuchsIntranet.debug_log("fds__reminder_data.RegisterReminder_V2", ex:=REMex, data:=New With {.form = ctrl.Form.CustomParamsToJson(), .account = ctrl.AuthAccount, .user = ctrl.UserAccountID}) + End Try + Return True + End Function).Result() + End If + End Sub + + Public Shared Function getStoredFile(ByRef file As Byte(), reminderid As String, ctrl As Global.OCMS.intranet.Controllers.IntranetController) As IO.FileInfo + Dim sqlrw As Dictionary(Of String, Object) = System.Threading.Tasks.Task.Run(Async Function() + Return (Await getSQLDataSet_async("SELECT TOP(1) * FROM [dbo].[fds__reminder] WHERE [Id] = @Id AND [file] is not null;", SqlConnectionString:=ctrl.Intranet.Intranet__SQLConnectionString, SqlParameterList:=ctrl.StdParamlist("Id", reminderid), ApplySymmetricKey:=ctrl.Intranet.Intranet__sql_symmetric_key)).FirstTable.FirstRow.toObjectDictionary() + End Function).Result() + If sqlrw.Count > 0 AndAlso sqlrw.nz("DocumentName", "") <> "" AndAlso sqlrw.no("file", "").GetType() = GetType(Byte()) Then + file = sqlrw("file") + Return New IO.FileInfo(fileName:=sqlrw.nz("DocumentName")) + Else + Return Nothing + End If + End Function + + End Class + + + Public Class fds__invoice_data + Dim base As Newtonsoft.Json.Linq.JObject + Public ReadOnly Property admin As GenericObjectDictionary + Public ReadOnly Property newvalues As GenericObjectDictionary + Public ReadOnly Property sms As GenericObjectDictionary + Public ReadOnly Property req As List(Of Dictionary(Of String, Object)) + + Public ReadOnly Property InvoiceAdmin As GenericObjectDictionary + Public ReadOnly Property InvoiceRegistration As GenericObjectDictionary + Public ReadOnly Property InvoiceReq As Dictionary(Of String, Object)() = Nothing + Public ReadOnly Property InvoiceItm As Dictionary(Of String, Object)() = Nothing + + Public ReadOnly Property Id As String + Get + Return If(IsNothing(Me.InvoiceRegistration), "", Me.InvoiceRegistration("Id", ReturnAlternative:="")) + End Get + End Property + + + + Public ReadOnly Property IsDraft As Boolean + + Public Sub New(ctd As Newtonsoft.Json.Linq.JObject) + Me.base = ctd + Me._IsDraft = True + If IsNothing(ctd) = False Then + If Me.base.ContainsKey("admin") Then Me._admin = New GenericObjectDictionary(Me.base("admin").ToObject(Of Dictionary(Of String, Object))) + If Me.base.ContainsKey("new") Then Me._newvalues = New GenericObjectDictionary(Me.base("new").ToObject(Of Dictionary(Of String, Object))) + If Me.base.ContainsKey("sms") Then Me._sms = New GenericObjectDictionary(Me.base("sms").ToObject(Of Dictionary(Of String, Object))) + If Me.base.ContainsKey("req") Then Me._req = Me.base("req").ToObject(Of List(Of Dictionary(Of String, Object))) + End If + End Sub + Public Sub New(ID As String, ctrl As Global.OCMS.intranet.Controllers.IntranetController) + Me.RegisterInvoice(ID:=ID, ctrl:=ctrl) + End Sub + + + Private _letter As MigraDoc.DocumentObjectModel.Document + Friend ReadOnly Property InvoicePDF(ctrl As Global.OCMS.intranet.Controllers.IntranetController) As MigraDoc.DocumentObjectModel.Document + Get + If IsNothing(Me._letter) = True Then + If IsNothing(Me.InvoiceReq) = True Then Call RegisterInvoice(Me.Id, ctrl) + Dim tb As New pdf.FDS__TextBlocks() With { + .Admin_Ref = Me.InvoiceId, + .address = Me.InvoiceAddress, + .Admin_User = Me.UserNameFinalized, + .Admin_User_Email = Me.UserEmailFinalized, + .Admin_Prov_Label = If(Me.ProvisionPeriod.Contains("-"), "Leistungszeitraum", "Leistungsdatum"), + .Admin_Prov = Me.ProvisionPeriod, + .Admin_Datum_Value = Me.DateCreated + } + If Me.ContactName <> "" OrElse Me.ContactEmail <> "" Then + tb.Admin_User = Me.ContactName + tb.Admin_User_Email = Me.ContactEmail + End If + Me._letter = Threading.Tasks.Task.Run(Async Function() Await Global.Fuchs.intranet.pdf.writeLetter(TB:=tb, draft:=Me.IsDraft, locale:=pdf.deculture)).Result() + Me._letter.Info.Title = "Rechnung " & Me.InvoiceId + pdf.ApplyInvoice(Me._letter, tb, Me, draft:=Me.IsDraft) + End If + Return Me._letter + End Get + End Property + + Public Async Function getInvoiceFile(ctrl As Global.OCMS.intranet.Controllers.IntranetController) As Task(Of Byte()) + + Dim ba As Byte() = New Byte() {} + If Me.InvoiceRegistration("IsFinal", ReturnAlternative:=False) = True Then + If (Me.InvoiceRegistration.ContainsKey("hasFile") = False OrElse Me.InvoiceRegistration("hasFile", ReturnAlternative:=False) = False) Then + Call Me.StoreInvoiceDocumentFile(ctrl) + End If + Call fds.fds_mfr.getReportDoc(file:=ba, Me.Id) + Else + Try + 'render + Dim pdfrend = New MigraDoc.Rendering.PdfDocumentRenderer(True) + pdfrend.Document = Me.InvoicePDF(ctrl) + pdfrend.RenderDocument() + + 'output + Using MStream As New IO.MemoryStream + pdfrend.PdfDocument.Save(MStream, False) + MStream.Position = 0 + ba = MStream.ToArray() + End Using + + 'convert to pdfa + ba = Global.OCMS.pdf.pdfAFileContent(ba) + Catch ex As Exception + ba = New Byte() {} + debug_log("getFile", ex:=ex, authuser:=ctrl.UserIdent.useraccount_id, data:=New With {.id = Me.Id, .invid = Me.InvoiceId}) + End Try + End If + Return ba + End Function + + Public Async Function StoreInvoiceDocumentFile(ctrl As Global.OCMS.intranet.Controllers.IntranetController) As Task(Of Byte()) + Dim pl As New ParamList + pl.AddParameter("Id", Me.Id) + + Dim ba As Byte() + Try + 'render + Dim pdfrend = New MigraDoc.Rendering.PdfDocumentRenderer(True) + pdfrend.Document = Me.InvoicePDF(ctrl) + pdfrend.RenderDocument() + + 'output + Using MStream As New IO.MemoryStream + pdfrend.PdfDocument.Save(MStream, False) + MStream.Position = 0 + ba = MStream.ToArray() + End Using + + 'convert to pdfa + ba = Global.OCMS.pdf.pdfAFileContent(ba) + + Catch ex As Exception + ba = New Byte() {} + debug_log("StoreDocumentFile", ex:=ex, authuser:=ctrl.UserIdent.useraccount_id, data:=New With {.id = Me.Id, .invid = Me.InvoiceId}) + End Try + If ba.Length > 0 Then + pl.Add(New SqlClient.SqlParameter("@file", dbType:=SqlDbType.VarBinary) With {.Value = ba}) + + Dim r As Boolean = Await setSQLValue_async("EXECUTE [dbo].[fds__setInvoiceFile] @Id, @file;", ctrl.Intranet.Intranet__SQLConnectionString, SqlParameterList:=pl, ApplySymmetricKey:=ctrl.Intranet.Intranet__sql_symmetric_key, options:=SQLOptions()) + Return If(r = True, ba, Nothing) + Else + Return Nothing + End If + + End Function + + Public Sub RegisterInvoice(ctrl As Global.OCMS.intranet.Controllers.IntranetController, change As Boolean, InvId As String) + If IsNothing(Me.admin) = False AndAlso Me.admin.Count > 0 Then + Dim r = Threading.Tasks.Task.Run(Async Function() + Try + Dim IsChange As Boolean = change = True AndAlso InvId <> "" + Dim vathigh As String = "", vats As Dictionary(Of String, Object) = If(Me.sms("vat").GetType = GetType(Dictionary(Of String, Object)), Me.sms("vat"), DirectCast(Me.sms("vat"), Newtonsoft.Json.Linq.JObject).ToObject(Of Dictionary(Of String, Object))) + For Each v As String In vats.Keys + If vathigh = "" Then + vathigh = v + ElseIf Single.Parse(v.Replace("%", "")) > Single.Parse(vathigh.Replace("%", "")) Then + vathigh = v + End If + Next + Dim pl As ParamList = ctrl.StdParamlist() + With pl + .Add(SQL_Char("InvoiceType", Me.admin("type"))) + .Add(SQL_VarChar("InvoiceTitle", Me.raw_InvoiceTitle())) + .Add(SQL_float("InvoiceBalance", stringvalue:=Me.sms("ttb"))) + .Add(SQL_float("InvoiceBalance_net", stringvalue:=Me.sms("ttn"))) + .Add(SQL_float("InvoiceVAT_net1", stringvalue:=If(vathigh = "" OrElse vats.ContainsKey(vathigh) = False, "0", vats(vathigh)))) + .Add(SQL_float("InvoiceVAT_1", Single.Parse(If(vathigh = "" OrElse vats.ContainsKey(vathigh) = False, "0", vathigh.Replace("%", "")), pdf.deculture))) + .Add(SQL_VarChar("PaymentTerm", Me.raw_paymentterms)) + .Add(SQL_BigInt("CustomerId", value:=Me.raw_CustomerId)) + .Add(SQL_VarChar("SendToAddress", Me.raw_InvoiceAddress.join(vbLf))) + .Add(SQL_NVarChar("SendToEmail", Me.raw_InvoiceEmail)) + .Add(SQL_VarChar("ProvisionPeriod", Me.raw_ProvisionPeriod, dbNull_IfEmpty:=True)) + .Add(SQL_NVarChar("CustomValues", Me.raw_CustomValues, dbNull_IfEmpty:=True)) + + + .Add(SQL_float("InvoiceService_net", stringvalue:=Me.sms("tscn"))) + .Add(SQL_float("InvoiceService_VAT", stringvalue:=Me.sms("tscvat"))) + .Add(SQL_VarChar("InvoiceOptions", If(Me.admin("p13b", "").GetType = GetType(Boolean) AndAlso Me.admin("p13b", "") = True, "§13b", ""), dbNull_IfEmpty:=True)) + End With + + Dim sql As New List(Of String) From {"DECLARE @Id varchar(10);"} + If IsChange = False Then + sql.AddRange(New String() { + "EXECUTE [dbo].[fds__createInvoice] @InvoiceType, @InvoiceTitle, @InvoiceBalance, @InvoiceBalance_net, @InvoiceVAT_net1, @InvoiceVAT_1, @PaymentTerm, @CustomerId, @SendToAddress, @SendToEmail, @ProvisionPeriod, @CustomValues, @authuser, @Id OUTPUT;", + "EXECUTE [dbo].[fds__createInvoice_Details] @Id, @InvoiceService_net, @InvoiceService_VAT, @InvoiceOptions, @authuser;" + }) + Else + pl.Add(SQL_VarChar("InvId", InvId)) + sql.AddRange(New String() { + "EXECUTE [dbo].[fds__setInvoice] @InvId, @InvoiceType, @InvoiceTitle, @InvoiceBalance, @InvoiceBalance_net, @InvoiceVAT_net1, @InvoiceVAT_1, @PaymentTerm, @CustomerId, @SendToAddress, @SendToEmail, @ProvisionPeriod, @CustomValues, @authuser, @Id OUTPUT;", + "EXECUTE [dbo].[fds__createInvoice_Details] @Id, @InvoiceService_net, @InvoiceService_VAT, @InvoiceOptions, @authuser;" + }) + End If + If Me.raw_ProvisionLocation.Length > 0 Then + pl.Add(SQL_NVarChar("ProvisionLocation", Me.raw_ProvisionLocation.join(vbLf).LeftToFirst("