Stefan/Fuchs_Intranet
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

added legacy code for reference
Playwright Tests / test (push) Has been cancelled
Details

Browse Source
This commit is contained in:
Stefan
2026-06-04 14:56:43 +02:00
parent dbe6cd8653
commit c8a4d18f1a
93 changed files with 18065 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Intranet_Legacy/code/7z.dll
BIN
View File
Binary file not shown.
Intranet_Legacy/code/fuchs_fds_banking.vb
+141
View File
@@ -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
Intranet_Legacy/code/fuchs_fds_email.vb
+102
View File
@@ -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 = "<p>&nbsp;</p><p style=""margin: 24px 0 16px 0;line-height:140%;"">Herzliche Grüße aus Düsseldorf-Bilk<br/>Ihr Team der Firma Sebastian Fuchs</p>"
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
Intranet_Legacy/code/fuchs_fds_pdf.vb
+1368
View File
File diff suppressed because it is too large Load Diff
Intranet_Legacy/code/fuchs_fds_widgets.vb
+390
View File
@@ -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 = "<div style=""width:100px;height:70px;position:relative;float:left;background:transparent url('" & Global.OCMS.intranet.proxy.OCMS_ProxyParseUrl(Proxyhost, itm.Item("icon_url_m")) & "') no-repeat center top;""></div>" &
"<div style=""font-weight: bolder; font-size: 14px; line-height: 26px;"">" & Format(ky, "ddd, dd.MM. HH") & " Uhr</div>" &
"<div style=""font-size:15px;line-height:22px;"">" & itm("t_min_rw") & " - " & itm("t_max_rw") & "&deg;C</div>" &
"<div style="""">" & itm("status_txt") & "</div>"
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 = "<div style=""line-height:18px;font-weight:bolder;font-size:11px;text-align:center;"">" & If(Format(ky, "yyMMdd") = Format(Now(), "yyMMdd"), "Heute", Format(ky, "dddd")) & "</div>" &
"<div style=""font-weight: normal; font-size: 12px; text-align: center; margin-bottom: 5px;"">" & Format(ky, "HH") & " Uhr</div>" &
"<div style=""width: 100%; height: 42px; position: relative; display: block; background: transparent url('" & Global.OCMS.intranet.proxy.OCMS_ProxyParseUrl(Proxyhost, itm.Item("icon_url_s")) & "') no-repeat center top;""></div>" &
"<div style=""text-align: center; margin-top: 2px; font-size: 12px;"">" & itm("t_min_rw") & " / " & itm("t_max_rw") & "&deg;C</div>" &
"<div style=""text-align: center; font-size: 9px; margin-top: 4px;"">" & itm("status_txt") & "</div>"
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 = "<div style=""width: 100%; display: block; font-size: 10px; font-style: italic; text-align: center;"">" & WeatherNfo.First.Value("credit_text") & "</div>" &
"<div style=""width: 100%; text-align: center;""><a href=""" & WeatherNfo.First.Value("credit_link") & """ target=""_blank""><img style=""border: 0"" title=""wetter.com"" alt=""wetter.com"" src=""" & Global.OCMS.intranet.proxy.OCMS_ProxyParseUrl(Proxyhost, "http://static1.wetter.com/woys/5/images/wetter.com_60x12.png") & """></a></div>"
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
Intranet_Legacy/code/fuchs_intranet.vb
+928
View File
@@ -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("<br>", vbLf).Replace("<br/>", vbLf).Replace("<br />", 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("<br>", vbLf).Replace("<br/>", vbLf).Replace("<br />", 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("<!--", emptyIfNotFound:=False)))
sql.Add("UPDATE [dbo].[fds__invoices] SET [ProvisionLocation] = LEFT(@ProvisionLocation,1000) WHERE [Id] = @Id And [isFinal] = 0;")
End If
If vats.Count > 1 Then
For Each v As String In vats.Keys
If v <> vathigh Then
pl.Add(SQL_VarChar("InvoiceVAT_2", Single.Parse(v.Replace("%", "")))) 'only one additional possible at the moment ->> constant suffix
pl.Add(SQL_float("InvoiceVAT_net2", stringvalue:=vats(v)))
sql.Add("UPDATE [dbo].[fds__invoices] SET [InvoiceVAT_net2] = @InvoiceVAT_net2, [InvoiceVAT_2] = @InvoiceVAT_2 WHERE [Id] = @Id And [isFinal] = 0;")
Exit For 'only one additional possible at the moment
End If
Next
End If
sql.Add("SELECT TOP(0) * FROM [dbo].[fds__invoice_servicerequests];")
sql.Add("Select TOP(0) * From [dbo].[fds__invoice_items];")
Dim invdset 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() {"inv", "det", "req", "itm"}, options:=SQLOptions())
If invdset.Exception <> "" Then
Diagnostics.Debug.Print("fds__invoice_data.RegisterInvoice - set/create - sql exception: " & invdset.Exception)
ctrl.FuchsIntranet.debug_log("fds__invoice_data.RegisterInvoice - set/create - sql exception: ", [error]:=invdset.Exception, data:=New With {.sql = sql, .pl = pl.ToDictionary})
End If
Me._InvoiceRegistration = New GenericObjectDictionary(Base:=invdset.Table("inv").FirstRow.toObjectDictionary())
Dim itemsdt As DataTable = invdset.Tables("itm"), InvoiceID As String = Me.InvoiceRegistration.Item("Id", ReturnAlternative:=""), InvRqIDList As New List(Of String)
If InvoiceID <> "" Then
If Me.req.Count > 1 Then
Await setSQLValue_async("EXECUTE [dbo].[fds__remInvoice_ServiceRequests] @id, @authuser;", ctrl.Intranet.Intranet__SQLConnectionString, SqlParameterList:=ctrl.StdParamlist("id", InvoiceID), ApplySymmetricKey:=ctrl.Intranet.Intranet__sql_symmetric_key, options:=SQLOptions())
End If
For ri As Integer = 0 To Me.req.Count - 1
Dim rdic As New GenericObjectDictionary(Me.req(ri))
pl = ctrl.StdParamlist()
With pl
.Add(SQL_VarChar("InvId", InvoiceID))
.Add(SQL_BigInt("mfr__servicerequest", stringvalue:=rdic.nz("Id")))
.Add(SQL_NVarChar("title", If(rdic.nz("text").ne(rdic("nme", "")), "")))
Dim vnet As Single
If TryCastSingle(rdic.no("netval", Nothing), vnet) = True Then
.Add(SQL_float("value_net", vnet))
Else
.Add(SQL_float("value_net", stringvalue:=rdic.nz("netval")))
End If
.Add(SQL_int("SortOrder", ri))
End With
Dim InvRqDT As SQLDataTable = Await getSQLDatatable_async("EXECUTE [dbo].[fds__createInvoice_ServiceRequest] @InvId, @mfr__servicerequest, @title, @value_net, @SortOrder;", ctrl.Intranet.Intranet__SQLConnectionString, SqlParameterList:=pl, ApplySymmetricKey:=ctrl.Intranet.Intranet__sql_symmetric_key, options:=SQLOptions())
If InvRqDT.Exception <> "" Then
Diagnostics.Debug.Print("fds__invoice_data.RegisterInvoice - InvRq - sql exception: " & InvRqDT.Exception)
ctrl.FuchsIntranet.debug_log("fds__invoice_data.RegisterInvoice - InvRq - sql exception: ", [error]:=InvRqDT.Exception, data:=New With {.sql = sql, .pl = pl.ToDictionary})
End If
' InvRqID is string !!
Dim InvRqID As String = InvRqDT.FirstRow.nz("Id", "-1")
If InvRqID <> "-1" Then
InvRqIDList.Add(InvRqID)
Dim ii As Integer = 0
For Each itm As Newtonsoft.Json.Linq.JObject In DirectCast(rdic("itm"), Newtonsoft.Json.Linq.JArray)
ii += 1
Dim itmrw As DataRow = itemsdt.NewRow(), itmdic As New GenericObjectDictionary(itm.ToObject(Of Dictionary(Of String, Object)))
Try
With itmrw
.Item("InvId") = InvoiceID
.Item("InvRqID") = InvRqID
Dim mfr__item As Long
If If(itmdic("id").ToString(), "") <> "" AndAlso If(itmdic("id").ToString, "") <> "undefined" AndAlso Long.TryParse(itmdic("id"), mfr__item) = True Then .Item("mfr__item") = mfr__item
.Item("Type") = itmdic("typ")
.Item("Position") = itmdic("p")
.Item("Quantity") = itmdic("q")
.Item("Text") = itmdic("t")
Dim v As Single
If TryCastSingle(itmdic("v"), v) Then .Item("value") = v
If TryCastSingle(itmdic("vt"), v) Then .Item("value_total") = v
If TryCastSingle(itmdic.nz("vat", "").Replace("%", ""), v) Then .Item("vat") = v
If TryCastSingle(itmdic("vs"), v) Then .Item("value_service") = v
.Item("det") = itmdic("det")
.Item("SortOrder") = ii
End With
itemsdt.Rows.Add(itmrw)
Catch ex As Exception
Diagnostics.Debug.Print("fds__invoice_data.RegisterInvoice - items - " & ex.Message & vbNewLine & ex.StackTrace)
ctrl.FuchsIntranet.debug_log("fds__invoice_data.RegisterInvoice - items", ex)
End Try
Next
End If
Next
Dim dtw As New DatatableWriterAsync(itemsdt, ctrl.Intranet.Intranet__SQLConnectionString, "[dbo].[fds__invoice_items]")
If itemsdt.Rows.Count > 0 Then
dtw.CommandBefore = New SqlClient.SqlCommand("EXECUTE [dbo].[fds__remInvoice_Items] @Id, @authuser;")
dtw.CommandBefore.Parameters.AddRange(ctrl.StdParamlist("id", InvoiceID).ToArray())
End If
dtw.Submit()
End If
Catch RIex As Exception
ctrl.FuchsIntranet.debug_log("fds__invoice_data.RegisterInvoice_V1", ex:=RIex, 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 RegisterInvoice(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)
Dim invdset As SQLDataSet = Await getSQLDataSet_async("EXECUTE [dbo].[fds__getInvoice] @Id, @authuser;", ctrl.Intranet.Intranet__SQLConnectionString, SqlParameterList:=pl, ApplySymmetricKey:=ctrl.Intranet.Intranet__sql_symmetric_key, tablenames:=New String() {"admin", "inv", "req", "itm"}, options:=SQLOptions())
Me._InvoiceAdmin = New GenericObjectDictionary(Base:=invdset.Table("admin").FirstRow.toObjectDictionary())
Me._InvoiceRegistration = New GenericObjectDictionary(Base:=invdset.Table("inv").FirstRow.toObjectDictionary())
Me._IsDraft = Not (Me._InvoiceRegistration("IsFinal") = True)
Me._InvoiceReq = invdset.Tables("req").toArrayofObjectDictionaries()
Me._InvoiceItm = invdset.Tables("itm").toArrayofObjectDictionaries()
Catch RIex As Exception
ctrl.FuchsIntranet.debug_log("fds__invoice_data.RegisterInvoice_V2", ex:=RIex, data:=New With {.form = ctrl.Form.CustomParamsToJson(), .account = ctrl.AuthAccount, .user = ctrl.UserAccountID})
End Try
Return True
End Function).Result()
End If
End Sub
#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("<br>", vbLf).Replace("<br/>", vbLf).Replace("<br />", 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_ProvisionLocation As String()
Get
If IsNothing(Me.newvalues) = True OrElse Me.newvalues("loc", ReturnAlternative:="") = "" Then
Return New String() {}
Else
Dim nv As String = Me.newvalues.nz("loc")
For Each v As String In StrA("<br>", "<br/>", "<br />")
nv = nv.Replace(v, vbLf).Replace(v.ToUpper, vbLf)
Next
Dim matchpattern As String = "<(?:[^>=]|='[^']*'|=""[^""]*""|=[^'""][^\s>]*)*>"
nv = Regex.Replace(nv, matchpattern, "", RegexOptions.IgnoreCase Or RegexOptions.IgnorePatternWhitespace Or RegexOptions.Multiline Or RegexOptions.Singleline)
Return nv.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_ProvisionPeriod As String
Get
Return If(IsNothing(Me.newvalues) = True, "", Me.newvalues.nz("provisionperiod").Trim())
End Get
End Property
Public ReadOnly Property raw_paymentterms As String
Get
Return If(IsNothing(Me.admin) = True, "", Me.admin.nz("paymentterms").Trim())
End Get
End Property
Public ReadOnly Property raw_CustomerId As Long?
Get
Dim v As Long
If IsNothing(Me.admin) = True OrElse IsNothing(Me.admin("CustomerId")) = True Then
Return Nothing
ElseIf Me.admin.no("CustomerId", "").GetType() = GetType(Long) Then
Return Me.admin.no("CustomerId", Nothing)
ElseIf Long.TryParse(Me.admin.nz("CustomerId", ""), v) = True Then
Return v
Else Return Nothing
End If
End Get
End Property
Public ReadOnly Property raw_InvoiceTitle As String
Get
Return If(IsNothing(Me.newvalues) = True, "", Me.newvalues.nz("invoicetitle").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 InvoiceId As String
Get
Return If(IsNothing(Me.InvoiceRegistration) = True, "", Me.InvoiceRegistration.nz("InvoiceId"))
End Get
End Property
Public ReadOnly Property DateCreated As Date?
Get
Return If(IsNothing(Me.InvoiceRegistration) = True, Nothing, Me.InvoiceRegistration.nz("DateCreated"))
End Get
End Property
Public ReadOnly Property InvoiceType As String
Get
Return If(IsNothing(Me.InvoiceRegistration) = True, "", Me.InvoiceRegistration.nz("InvoiceType").Substr(0, 1))
End Get
End Property
Public ReadOnly Property UserNameFinalized As String
Get
Return If(IsNothing(Me.InvoiceRegistration) = True, "", Me.InvoiceRegistration.nz("UserNameFinalized"))
End Get
End Property
Public ReadOnly Property UserEmailFinalized As String
Get
Return If(IsNothing(Me.InvoiceRegistration) = True, "", Me.InvoiceRegistration.nz("UserEmailFinalized"))
End Get
End Property
Public ReadOnly Property ContactName As String
Get
If IsNothing(Me.InvoiceRegistration) = True OrElse Me.InvoiceRegistration.nz("CustomValues").StartsWith("{") = False Then
Return ""
Else
Dim o As New GenericObjectDictionary(Me.InvoiceRegistration.nz("CustomValues"))
Return o("contactName")
End If
End Get
End Property
Public ReadOnly Property ContactEmail As String
Get
If IsNothing(Me.InvoiceRegistration) = True OrElse Me.InvoiceRegistration.nz("CustomValues").StartsWith("{") = False Then
Return ""
Else
Dim o As New GenericObjectDictionary(Me.InvoiceRegistration.nz("CustomValues"))
Return o("contactEmail")
End If
End Get
End Property
Public ReadOnly Property InvoiceAddress As String()
Get
Return If(IsNothing(Me.InvoiceRegistration) = True, New String() {}, Me.InvoiceRegistration.nz("SendToAddress").Replace("<br>", vbLf).Replace("<br/>", vbLf).Replace("<br />", vbLf).Replace(vbCrLf, vbLf).Replace(vbLf & vbLf, vbLf).Split(vbLf).ForEach(Function(t As String) t.Trim()))
End Get
End Property
Public ReadOnly Property ProvisionLocation As String()
Get
Return If(IsNothing(Me.InvoiceRegistration) = True, New String() {}, Me.InvoiceRegistration.nz("ProvisionLocation").Replace("<br>", vbLf).Replace("<br/>", vbLf).Replace("<br />", 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.InvoiceRegistration) = True, "", Me.InvoiceRegistration.nz("SendToEmail"))
End Get
End Property
Public ReadOnly Property ProvisionPeriod As String
Get
Return If(IsNothing(Me.InvoiceRegistration) = True, "", Me.InvoiceRegistration.nz("ProvisionPeriod"))
End Get
End Property
Public ReadOnly Property paymentterms As String
Get
Return If(IsNothing(Me.InvoiceRegistration) = True, "", Me.InvoiceRegistration.nz("PaymentTerm"))
End Get
End Property
Public ReadOnly Property InvoiceTitle As String
Get
Return If(IsNothing(Me.InvoiceRegistration) = True, "", Me.InvoiceRegistration.nz("InvoiceTitle"))
End Get
End Property
#End Region
Public Function SQLOptions() As FIS_SQLOptions
Return New FIS_SQLOptions()
End Function
End Class
Public Class Fuchs_intranet
Inherits Global.OCMS.intranet.OCMS_intranet
Public Sub New(intranet_namespace As String)
MyBase.New(intranet_namespace:=intranet_namespace)
End Sub
Public Overrides ReadOnly Property project_abbreviation As String = "fuchs"
Public Overrides ReadOnly Property ApplicationName As String = "Sebastian Fuchs Sanitär und Heizung - Intranet"
Public Overrides ReadOnly Property Intranet__SQLConnectionString As String = ConfigurationManager.ConnectionStrings("fuchs_fds_ConnectionString").ConnectionString
Public Overrides ReadOnly Property FallbackCultureInfo As System.Globalization.CultureInfo = MyBase.deCulture
Public Overrides ReadOnly Property Intranet__sql_symmetric_key As Global.OCMS.security.NamePasswordPair = New Global.OCMS.security.NamePasswordPair() With {.Name = "fuchs_enc_1", .Password = "*0&PY_6iyjlKyQ"}
Public Overrides ReadOnly Property Intranet__TOTPsharedsecret_base As String = System.Configuration.ConfigurationManager.AppSettings("fuchs_intranet_TOTP") 'only base32 A-Z,2-7
Public ReadOnly Property Intranet__SMS_API_key As String = System.Configuration.ConfigurationManager.AppSettings("SMS_APIKey")
Public Overrides ReadOnly Property Intranet__cookiename As String = "fuchs_" & System.Configuration.ConfigurationManager.AppSettings("fuchs_intranet_guid")
Protected Overrides ReadOnly Property SQL_admin_debug As String = "EXECUTE [dbo].[fis_admin_debug] @machine, @type, @url, @uniquekey, @authuser, @query, @form_content, @server_variables, @cookies, @authcookie, @files, @isdebug;"
Protected Overrides ReadOnly Property SQL_admin_debug__update As String = "UPDATE [dbo].[fis_admin_debuglog] SET [authuser] = @authuser Where [authuser] = @uniquekey And [type] = 'request';"
Private _SQL_Authenticate As String = "SELECT * FROM [dbo].[fis_admin_authenticate](@email, @password);"
Private _SQL_UserAccountByEmail As String = "SELECT TOP(1) * FROM [dbo].[fis_admin_getUserAccount_byemail]( @email, @include_password );"
Private _SQL_UserAccount As String = "SELECT TOP(1) * FROM [dbo].[fis_admin_getUserAccount]( @useraccount_id );"
Private _SQL_UserSetting As String = "SELECT [dbo].[fis_admin_getUserSetting](@useraccount_id, @key);"
Public Overrides Function get_UserAccountRow_byEmail(ByVal emailaddress As String, Optional include_password As Boolean = False) As DataRow
Dim pl As New List(Of SqlClient.SqlParameter) From {SQL_VarChar("email", emailaddress), SQL_bit("include_password", include_password)}
Dim sql_exception As String = ""
Dim useraccount As DataRow = getSQLFirstRow(Me._SQL_UserAccountByEmail, SQLConnection:=Me.Intranet_SqlCon(), SqlParameterList:=pl, ApplySymmetricKey:=Me.Intranet__sql_symmetric_key, exception:=sql_exception)
If sql_exception <> "" Then
OCMS.debug_log(Me.project_abbreviation & "_intranet_authentication get_UserAccountRow_byEmail", sql_exception, data:=New With {.emailaddress = emailaddress, .sql_exception = sql_exception})
End If
Return useraccount
End Function
Public Overrides Function get_UserAccountRow(ByVal useraccount_id As String) As DataRow
Dim Exception As String = ""
Dim UserAccountRow As DataRow = getSQLFirstRow(Me._SQL_UserAccount, SQLConnection:=Me.Intranet_SqlCon(), SqlParameterList:=New List(Of SqlClient.SqlParameter) From {SQL_VarChar("useraccount_id", useraccount_id)}, ApplySymmetricKey:=Me.Intranet__sql_symmetric_key, exception:=Exception)
If Exception <> "" Then
OCMS.debug_log(Me.project_abbreviation & "_intranet_authentication UserIdentity New:SQL", Exception, data:=New With {.UserAccountID_unverified = useraccount_id, .sql_exception = Exception})
ElseIf IsNothing(UserAccountRow) = True Then
OCMS.debug_log(Me.project_abbreviation & "_intranet_authentication UserIdentity New:SQL (2)", Exception, data:=New With {.UserAccountID_unverified = useraccount_id, .sql_exception = Exception})
End If
Return UserAccountRow
End Function
Public Overrides Function get_UserSetting(ByVal UserIdentity As Global.OCMS.ocms_UserIdentity, key As String) As String
Dim sql_exception As String = Nothing
Dim pl As New List(Of SqlClient.SqlParameter) From {SQL_VarChar("useraccount_id", UserIdentity.useraccount_id), SQL_NVarChar("key", key)}
Dim Result As String = If(getSQLValue(Me._SQL_UserSetting, SQLConnection:=Me.Intranet_SqlCon(), SqlParameterList:=pl, ApplySymmetricKey:=Me.Intranet__sql_symmetric_key, exception:=sql_exception), "")
If sql_exception <> "" Then
OCMS.debug_log(Me.project_abbreviation & "_intranet_authentication authenticate", sql_exception, data:=New With {.useraccount_id = UserIdentity.useraccount_id, .sql_exception = sql_exception})
End If
Return Result
End Function
''' <summary>
''' will verify the credentials against the Database
''' </summary>
''' <param name="email"></param>
''' <param name="password"></param>
''' <param name="exception"></param>
''' <returns></returns>
Public Overrides Function authenticate(email As String, password As String, exception As String) As DataRow
Dim sql_exception As String = Nothing
Dim pl As New List(Of SqlClient.SqlParameter) From {Global.OCMS.SQLHandling.SQL_VarChar("email", email), Global.OCMS.SQLHandling.SQL_NVarChar("password", password)}
Dim AuthRw As DataRow = Global.OCMS.SQLHandling.getSQLFirstRow(Me._SQL_Authenticate, SQLConnection:=Me.Intranet_SqlCon(), SqlParameterList:=pl, ApplySymmetricKey:=Me.Intranet__sql_symmetric_key, exception:=sql_exception)
If sql_exception <> "" Then
OCMS.debug_log(Me.project_abbreviation & "_intranet_authentication authenticate", sql_exception, data:=New With {.email = email, .sql_exception = sql_exception})
Return Nothing
Else
Return AuthRw
End If
End Function
Public Async Function getModuleAuth(authmodule As String, UserAccountID As String) As Task(Of Integer)
Dim pl As New ParamList From {
SQL_VarChar("@authuser", UserAccountID),
SQL_VarChar("@module", authmodule, dbNull_IfEmpty:=True)
}
Dim val As SQLObjectTyped(Of Integer) = Await getSQLValue_async(Of Integer)("SELECT ISNULL([dbo].[fis_getModuleAuth](@module, @authuser),-1);", Me.Intranet__SQLConnectionString, DefaultValue:=-1, SqlParameterList:=pl, ApplySymmetricKey:=Me.Intranet__sql_symmetric_key)
Return If(val.Exception <> "", val.Result, -1)
End Function
''' <summary>
'''
''' </summary>
''' <param name="procedure">Reference to procedure / location in the code</param>
''' <param name="ex">Exception thrown</param>
''' <param name="authuser"></param>
''' <param name="data"></param>
Public Sub debug_log(ByVal procedure As String, ByVal ex As Exception, Optional authuser As String = "", Optional data As Object = Nothing)
Dim datavalue As String = ""
Dim message As String = If(IsNothing(ex) = True, "", ex.Message) & "" 'to make sure it's not a reference, but a new value
Dim stacktrace As String = If(IsNothing(ex) = True, "", ex.StackTrace) & ""
Threading.Tasks.Task.Run(Sub()
If IsNothing(data) = True Then
datavalue = ""
ElseIf data.GetType = GetType(String) Then
datavalue = data
Else
datavalue = Newtonsoft.Json.JsonConvert.SerializeObject(data)
End If
Dim pl As New List(Of SqlClient.SqlParameter) From {
SQL_VarChar("ExceptionMessage", message, dbNull_IfEmpty:=True),
SQL_VarChar("CodeReference", procedure),
SQL_VarChar("StackTrace", stacktrace),
SQL_VarChar("data", datavalue, dbNull_IfEmpty:=True)
}
Dim sql_exception As String = ""
setSQLValue("EXECUTE [dbo].[fds__admin_logdebug] @CodeReference, @ExceptionMessage, @StackTrace, @Data;", SQLConnection:=Me.Intranet_SqlCon(), SqlParameterList:=pl, exception:=sql_exception)
End Sub)
End Sub
Public Sub debug_log(ByVal procedure As String, ByVal [error] As String, Optional StackTrace As String = "", Optional data As Object = Nothing)
Dim datavalue As String = ""
Threading.Tasks.Task.Run(Sub()
If IsNothing(data) = True Then
datavalue = ""
ElseIf data.GetType = GetType(String) Then
datavalue = data
Else
datavalue = Newtonsoft.Json.JsonConvert.SerializeObject(data)
End If
Dim pl As New List(Of SqlClient.SqlParameter) From {
SQL_VarChar("ExceptionMessage", [error], dbNull_IfEmpty:=True),
SQL_VarChar("CodeReference", procedure),
SQL_VarChar("StackTrace", StackTrace),
SQL_VarChar("data", datavalue, dbNull_IfEmpty:=True)
}
Dim sql_exception As String = ""
setSQLValue("EXECUTE [dbo].[fds__admin_logdebug] @CodeReference, @ExceptionMessage, @StackTrace, @Data;", SQLConnection:=Me.Intranet_SqlCon(), SqlParameterList:=pl, exception:=sql_exception)
End Sub)
End Sub
End Class
Public Class FIS_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
End Namespace
Intranet_Legacy/code/fuchs_ocms_intranet.vb
+204
View File
@@ -0,0 +1,204 @@
Option Explicit On
Imports System.Threading.Tasks
Imports OCMS
Imports OCMS.intranet
Imports OCMS.SQLHandling
Imports njson = Newtonsoft.Json.JsonConvert
Namespace Global.OCMS.intranet.Controllers
Public Class IntranetController
Inherits Global.OCMS.intranet.Controllers.IntranetController_base
Private intranet_do_allowedNONAUTH As New List(Of String) From {"spwc", "spw"}
Public Overrides ReadOnly Property LocalSSL As Integer = 44360
Public Sub New()
MyBase.New()
Me._UserIdent = New Global.OCMS.intranet.OCMS_intranet_useridentity(Me.Intranet) ' by intention initially empty
Me.intranet_do_allowedGET.Add("inv|datevzip")
Me.intranet_do_allowedGET.Add("inv|rdoc")
Me.intranet_do_allowedGET.Add("inv|rdocn")
Me.intranet_do_allowedGET.Add("req|idoc")
Me.intranet_do_allowedGET.Add("req|resend")
Me.intranet_do_allowedGET.Add("rem|idoc")
Me.intranet_do_allowedGET.Add("rem|resend")
Me.intranet_do_allowedGET.Add("bam|up")
Me.intranet_do_allowedGET.Add("mfr")
Me.intranet_do_allowedGET.Add("mfr_update")
Me.intranet_do_allowedGET.Add("todos")
End Sub
Public Overrides ReadOnly Property Intranet As OCMS_intranet
Get
If IsNothing(Global.Fuchs.intranet.fuchs_ocms_intranet.Intranet) Then
Global.Fuchs.intranet.fuchs_ocms_intranet.Intranet = New Global.Fuchs.intranet.Fuchs_intranet("Fuchs.intranet")
End If
Return Global.Fuchs.intranet.fuchs_ocms_intranet.Intranet
End Get
End Property
Public ReadOnly Property FuchsIntranet As Global.Fuchs.intranet.Fuchs_intranet
Get
If IsNothing(Global.Fuchs.intranet.fuchs_ocms_intranet.Intranet) Then
Global.Fuchs.intranet.fuchs_ocms_intranet.Intranet = New Global.Fuchs.intranet.Fuchs_intranet("Fuchs.intranet")
End If
Return Global.Fuchs.intranet.fuchs_ocms_intranet.Intranet
End Get
End Property
Public Async Function opx(fn As String, id As String, code As String) As Task(Of ActionResult)
Return Await Global.OCMS.intranet.proxy.vmp(Me, path:=Me.Request.Url.BaseUrl.AppendIf("/") & "intranet/")
End Function
Public Overrides Async Function _Do(fn As String, id As String, code As String) As Task(Of ActionResult)
Dim Action As ActionResult = Nothing
Try
If Global.Fuchs.My.Settings.FDS_Intranet_DebugState = True Then
Dim t As New Threading.Tasks.Task(Sub()
Dim pl As List(Of SqlClient.SqlParameter) = Me.StdParamlist(SQL_VarChar("@activity", "IntranetController.do"), SQL_VarChar("@info", njson.SerializeObject(New With {.fn = fn, .id = id, .code = code})), SQL_NVarChar("@data", Me.Form.CustomParamsToJson))
setSQLValue("INSERT INTO [dbo].[fds__admin_activity]([timestamp],[activity],[authuser],[info],[data]) VALUES (GETUTCDATE(), @activity, @authuser, @info, @data);", Me.Intranet.Intranet_SqlCon, pl)
End Sub)
t.Start() 'fire and forget
End If
If Me.UserIdent.isAuthenticated = False AndAlso Me.intranet_do_allowedNONAUTH.Contains(fn.ToLower) = False Then Return New NotAuthenticatedResult()
Select Case fn.ToLower
Case "ping"
Action = New OKResult()
Case "auth"
If Me.Form.CheckParams(StrA("module")) = False Then Return New InputMissingResult()
If Me.Form("array") = "1" Then
Dim authresult As SQLDataTable = Await getSQLDatatable_async("SELECT * FROM [dbo].[fis_getModuleAuthList](@module, @authuser);", Me.Intranet.Intranet__SQLConnectionString, SqlParameterList:=Me.StdParamlist("module", Me.Form("module")), ApplySymmetricKey:=Me.Intranet.Intranet__sql_symmetric_key, options:=SQLOptBasic(fn, id, code, Me.Form))
Action = Await JSONAsync(authresult.DataTable.ToDictionary(KeyColumn:="module", ValueColumn:="auth"))
Else
Dim authresult As SQLObject = Await getSQLValue_async("SELECT [dbo].[fis_getModuleAuth](@module, @authuser);", Me.Intranet.Intranet__SQLConnectionString, SqlParameterList:=Me.StdParamlist("module", Me.Form("module")), ApplySymmetricKey:=Me.Intranet.Intranet__sql_symmetric_key, options:=SQLOptBasic(fn, id, code, Me.Form))
Action = Await JSONAsync(New With {.auth = CInt(OCMS.ocms_commons.n_int(authresult.Result, -1))})
End If
Case "wdg"
Return Await Global.Fuchs.intranet.intranet_wdg(Me, fn:=id)
Case "spwc"
If Me.Form.CheckParams(New String() {"lastname", "email"}) = False Then Return New InputMissingResult()
Dim ua As SQLDataTable = Await getSQLDatatable_async("SELECT TOP(1) * FROM [dbo].[fis_admin_getUserAccount_byemail](@email, @include_password);", Me.Intranet.Intranet__SQLConnectionString, Me.StdParamlist(SQL_VarChar("@email", Me.Form("email")), SQL_bit("@include_password", True)), "user", ApplySymmetricKey:=Me.Intranet.Intranet__sql_symmetric_key, options:=SQLOptBasic(fn, id, code, Me.Form))
Dim uadic As Dictionary(Of String, String) = ua.FirstRow.toStringDictionary()
If uadic("email").Length > 5 AndAlso uadic("name").ToLower.Trim = Me.Form("lastname").ToLower.Trim() Then
If uadic("mobile").Length > 5 Then
Dim sms As New Global.OCMS.sms.SMS(Me.FuchsIntranet.Intranet__SMS_API_key, "ProcessWeb")
Dim totp As String = Global.OCMS.security.generateTotp_12h(Me.FuchsIntranet.Intranet__TOTPsharedsecret_base)
If Me.Request.Url.Host.ToLower.Contains("localhost") = False Then
Dim apiresponse As GenericObjectDictionary = sms.SendSMS(uadic("mobile").Replace("+", "00").Replace(" ", ""), "Zur Bestätigungs des Passwortversands auf sanitarfuchs.de, verwenden Sie bitte folgenden Code:" & totp)
Else
Diagnostics.Debug.Print(totp)
End If
End If
End If
Action = New OKResult() ' No exception for safety reasons, so that robots can't misuse this form
Case "spw"
If Me.Form.CheckParams(New String() {"lastname", "email", "code"}) = False Then Return New InputMissingResult()
If Global.OCMS.security.validateTotp_12h(Me.FuchsIntranet.Intranet__TOTPsharedsecret_base, Me.Form("code")) = True Then
Dim ua As SQLDataTable = Await getSQLDatatable_async("SELECT TOP(1) * FROM [dbo].[fis_admin_getUserAccount_byemail](@email, @include_password);", Me.Intranet.Intranet__SQLConnectionString, Me.StdParamlist(SQL_VarChar("@email", Me.Form("email")), SQL_bit("@include_password", True)), "user", ApplySymmetricKey:=Me.Intranet.Intranet__sql_symmetric_key, options:=SQLOptBasic(fn, id, code, Me.Form))
Dim uadic As Dictionary(Of String, String) = ua.FirstRow.toStringDictionary()
If uadic("email").Length > 5 Then
Dim sets As String = System.Configuration.ConfigurationManager.AppSettings("ocms_serviceemail")
If (Await Global.OCMS.SendEmail(sets, "Password", "sanitaerfuchs.de Intranet Passwort", "<p>Guten Tag " & uadic("firstname") & " " & uadic("name") & ",<br />Sie haben für das Intranet der Seite 'sanitaerfuchs.de' angefordert, dass Ihnen das Passwort zugeschickt wird.<br />Sie finden es unten aufgeführt zu Ihrer Information. Bitte stellen Sie sicher, dass dieses Passwort niemandem zugänglich wird. Diese Email sollten Sie ebenfalls aus Sicherheitsgründen löschen.<br />&nbsp;<br />&nbsp;</p></div><table><tr><td style=""padding:6px 12px"">Ihr Passwort</td><td style=""padding:6px 12px"">" & HttpUtility.HtmlEncode(uadic("password")) & "</td></tr></table><p>&nbsp;<br />&nbsp;</p>", uadic("email"), uadic("firstname") & " " & uadic("name"), files:=Nothing, logdebug:=Nothing) = True) Then
Action = New OKResult()
End If
End If
End If
Action = New OKResult() ' No exception for safety reasons, so that robots can't misuse this form
Case "account"
Select Case id.ToLower()
Case "sms"
Dim ua As SQLDataTable = Await getSQLDatatable_async("SELECT TOP(1) * FROM [dbo].[fis_admin_getUserAccount_byemail](@email, @include_password);", Me.Intranet.Intranet__SQLConnectionString, Me.StdParamlist(SQL_VarChar("@email", Me.UserIdent.Email), SQL_bit("@include_password", True)), "user", ApplySymmetricKey:=Me.Intranet.Intranet__sql_symmetric_key, options:=SQLOptBasic(fn, id, code, Me.Form))
Dim uadic As Dictionary(Of String, String) = ua.FirstRow.toStringDictionary()
If uadic("mobile").Length > 5 Then
Dim sms As New Global.OCMS.sms.SMS(Me.FuchsIntranet.Intranet__SMS_API_key, "ProcessWeb")
Dim totp As String = Global.OCMS.security.generateTotp_3h(Me.FuchsIntranet.Intranet__TOTPsharedsecret_base & "3MDR")
If Me.Request.Url.Host.ToLower.Contains("localhost") = False Then
Dim apiresponse As GenericObjectDictionary = sms.SendSMS(uadic("mobile").Replace("+", "00").Replace(" ", ""), "Zur Bestätigungs der Passwortänderung auf sanitarfuchs.de, verwenden Sie bitte folgenden Code:" & totp)
Else
Diagnostics.Debug.Print(totp)
End If
End If
Action = New OKResult()
Case "changepassword"
If Me.Form.CheckParams(New String() {"npw", "npwc", "code"}) = False Then Return New InputMissingResult()
If Me.Form("npw").ValidatePassword(minLength:=6, numSpecial:=0) = False Then
Action = New ExceptionResult("requirements", OCMS_StatusCodes.exception)
ElseIf Global.OCMS.security.validateTotp_3h(Me.FuchsIntranet.Intranet__TOTPsharedsecret_base & "3MDR", Me.Form("code")) = False Then
Action = New ExceptionResult("sms", OCMS_StatusCodes.exception)
ElseIf (Await getSQLDatatable_async("SELECT TOP(1) * FROM [dbo].[fis_admin_authenticate_byID](@useraccount_id, @password);", Me.Intranet.Intranet__SQLConnectionString, SqlParameterList:=New List(Of SqlClient.SqlParameter) From {SQL_VarChar("@useraccount_id", Me.UserAccountID), SQL_VarChar("@password", Me.Form("opw"))}, ApplySymmetricKey:=Me.Intranet.Intranet__sql_symmetric_key, options:=SQLOptBasic(fn, id, code, Me.Form))).FirstRow.nz("useraccount_id") <> Me.UserAccountID AndAlso Me.UserAccountID <> "" Then
Action = New ExceptionResult("valid", OCMS_StatusCodes.exception)
Else
Await setSQLValue_async("EXECUTE [dbo].[fis_admin_setNewPassword] @useraccount_id, @oldpassword, @newpassword, @enc_key;", Me.Intranet.Intranet__SQLConnectionString, SqlParameterList:=New List(Of SqlClient.SqlParameter) From {SQL_VarChar("@useraccount_id", Me.UserAccountID), SQL_VarChar("@oldpassword", Me.Form("opw")), SQL_VarChar("@newpassword", Me.Form("npw"))}, ApplySymmetricKey:=Me.Intranet.Intranet__sql_symmetric_key, options:=SQLOptBasic(fn, id, code, Me.Form))
Action = New OKResult()
End If
End Select
Case "todos"
Action = New FilePathResult(OCMS.ocms_commons.ApplicationBase.FullName & "\Areas\Intranet\Data\ProjectToDos.html", "text/html")
Case "mfr"
If id = "" Then
Action = New ContentResult() With {.Content = Await Global.fds.getSchema(), .ContentType = "text/xml", .ContentEncoding = Encoding.UTF8}
ElseIf Me.UserAccountID <> "" AndAlso IsNothing(Me.UserIdent) = False AndAlso Me.UserIdent.authorization > 3 Then
Action = New ContentResult() With {.Content = Await Global.fds.getAnything(id & If(code <> "", "/" & code, HttpUtility.UrlDecode(Me.Request.Url.Query)), throwerror_if_nOK:=False), .ContentType = "text/json", .ContentEncoding = Encoding.UTF8}
End If
Case "mfr_update"
Dim et As MFR_RESTClient.generic._generic.EntityTypes = MFR_RESTClient.generic._generic.EntityValue(Me.Form("type"))
If Not et = MFR_RESTClient.generic._generic.EntityTypes.none AndAlso Me.Form("need") = "" Then
Await Global.fds.UpdateIfNecessary_Single_async(et:=et)
Action = New OKResult()
ElseIf Not et = MFR_RESTClient.generic._generic.EntityTypes.none AndAlso Me.Form("need") <> "" Then
Dim need As fds.fds_mfr.UpdateNeed = fds.fds_mfr.UpdateNeedValue(Me.Form("need"))
If IsNothing(need) = false Then
Using mfr As New fds.fds_MFR_Client()
Await mfr.Update__entitytable(et, UpdateNeed:=need, EntityID:=Nothing, DebugDetails:=False)
End Using
End If
Else
Action = New InputMissingResult()
End If
Case "req"
Action = Await Do_Process_Requests(fn:=fn, id:=id, code:=code)
Case "inv"
Action = Await Do_Process_Invoices(fn:=fn, id:=id, code:=code)
Case "rem"
Action = Await Do_Process_Reminder(fn:=fn, id:=id, code:=code)
Case "rep"
Action = Await Do_Process_Reports(fn:=fn, id:=id, code:=code)
Case "bam" 'bank-account-management
Action = Await Do_Process_Bankings(fn:=fn, id:=id, code:=code)
End Select
Catch _DOex As Exception
Me.FuchsIntranet.debug_log("IntranetController._Do", ex:=_DOex, data:=New With {.fn = fn, .id = id, .code = code, .form = Me.Form.CustomParamsToJson(), .account = Me.AuthAccount, .user = Me.UserAccountID})
Action = New ExceptionResult("", OCMS_StatusCodes.exception)
End Try
Return Action
End Function
#Disable Warning BC42356 ' This async method lacks 'Await' operators and so will run synchronously
Public Overrides Async Function _Index(fn As String, id As String, code As String) As Task(Of ActionResult)
Return View("intranet", New Global.OCMS.intranet.intranet_model(Me, True))
End Function
Protected Overrides Function IntranetView() As ViewResult
Return View("intranet", New Global.OCMS.intranet.intranet_model(Me, True))
End Function
Public Function SQLOptBasic(fn As String, id As String, code As String, form As RequestFormHandler) As Fuchs.intranet.FIS_SQLOptions
Return New Fuchs.intranet.FIS_SQLOptions(New Dictionary(Of String, Object) From {{"fn", fn}, {"id", id}, {"code", code}, {"form", form.toDic}})
End Function
End Class
#Enable Warning BC42356 ' This async method lacks 'Await' operators and so will run synchronously
End Namespace
Intranet_Legacy/code/fuchs_ocms_intranet_invoices.vb
+360
View File
@@ -0,0 +1,360 @@
Option Explicit On
Imports System.Threading.Tasks
Imports OCMS
Imports OCMS.intranet
Imports OCMS.SQLHandling
Imports njson = Newtonsoft.Json.JsonConvert
Namespace Global.OCMS.intranet.Controllers
Partial Public Class IntranetController
Private Async Function Do_Process_Invoices(fn As String, id As String, code As String) As Task(Of ActionResult)
Dim Action As ActionResult = Nothing
Select Case id.ToLower
Case "auth"
Action = Await JSONAsync(New With {.manage = 1})
Case "setpyd"
If Me.Form.CheckParams(StrA("id")) = False Then Return New InputMissingResult()
'Dim sqlopt As New sqloptions() With {.OnError = Sub(ex As Exception)
' Me.FuchsIntranet.debug_log("IntranetController._Do.inv.setpyd - sql exception command after: ", ex:=ex, data:=New With {.Id = Me.Form("id")})
' End Sub}
Dim res As Boolean = Await setSQLValue_async("EXECUTE [dbo].[fds__setInvoicePayed] @Id, @authuser;", Me.Intranet.Intranet__SQLConnectionString, SqlParameterList:=Me.StdParamlist("Id", Me.Form("id")), ApplySymmetricKey:=Me.Intranet.Intranet__sql_symmetric_key, options:=SQLOptBasic(fn, id, code, Me.Form))
Return If(res = True, New OKResult(), New ExceptionResult("", OCMS_StatusCodes.exception))
Case "setupd"
If Me.Form.CheckParams(StrA("id")) = False Then Return New InputMissingResult()
'Dim sqlopt As New sqloptions() With {.OnError = Sub(ex As Exception)
' Me.FuchsIntranet.debug_log("IntranetController._Do.inv.setupd - sql exception command after: ", ex:=ex, data:=New With {.Id = Me.Form("id")})
' End Sub}
Dim res As Boolean = Await setSQLValue_async("EXECUTE [dbo].[fds__setInvoiceUNPayed] @Id, @authuser;", Me.Intranet.Intranet__SQLConnectionString, SqlParameterList:=Me.StdParamlist("Id", Me.Form("id")), ApplySymmetricKey:=Me.Intranet.Intranet__sql_symmetric_key, options:=SQLOptBasic(fn, id, code, Me.Form))
Return If(res = True, New OKResult(), New ExceptionResult("", OCMS_StatusCodes.exception))
Case "setvat"
Dim val As Single
If Single.TryParse(Me.Form("val").Replace("%", "").Replace(",", ".").Trim(), style:=System.Globalization.NumberStyles.AllowDecimalPoint, provider:=Globalization.CultureInfo.InvariantCulture, result:=val) = True Then
Dim pl As ParamList = Me.StdParamlist(New SqlClient.SqlParameter() {
SQL_BigInt("@id", Me.Form("id")),
SQL_VarChar("@entitytype", "report"),
New SqlClient.SqlParameter("@vat", val),
SQL_VarChar("@userid", Me.UserAccountID)
})
Dim sqlException As String = ""
setSQLValue("EXECUTE [dbo].[fds__setReportVAT] @id, @entitytype, @vat, @authuser;", Me.Intranet.Intranet_SqlCon, SqlParameterList:=pl, ApplySymmetricKey:=Me.Intranet.Intranet__sql_symmetric_key, exception:=sqlException)
If sqlException = "" Then
Action = New OKResult
Else
Action = New ExceptionResult("Der Wert konnte möglicherweise nicht gespeichert werden", InternalCode:=OCMS_StatusCodes.exception, internalDescription:=sqlException)
End If
Else
Action = New InputMissingResult()
End If
Case "sis"
If Me.Form.CheckParams(StrA("id")) = False Then Return New InputMissingResult()
Dim pl As ParamList = Me.StdParamlist("Id", Me.Form("id"))
pl.Add(SQL_bit("@auto", False))
Dim dt2 As SQLDataSet = Await getSQLDataSet_async("EXECUTE [dbo].[fds__setInvoiceSent] @Id, @auto, @authuser;", Me.Intranet.Intranet__SQLConnectionString, SqlParameterList:=pl, ApplySymmetricKey:=Me.Intranet.Intranet__sql_symmetric_key, options:=SQLOptBasic(fn, id, code, Me.Form))
Action = If(If(dt2.Exception, "") = "", New OKResult, New ExceptionResult("not successful", OCMS_StatusCodes.exception))
Case "pget"
Dim tgtid As Long
If Me.Form.CheckParams(StrA("id")) = False Then Return New InputMissingResult()
If 1 = 1 OrElse (Me.Request.Url.Host.ToLower <> "localhost" AndAlso Diagnostics.Debugger.IsAttached = False) Then
If Long.TryParse(Me.Form("id"), tgtid) = True Then
Using mfr As New fds.fds_MFR_Client()
Await mfr.Update__entitytable(MFR_RESTClient.generic._generic.EntityTypes.Invoice, UpdateNeed:=fds.fds_mfr.UpdateNeed.Reset, EntityID:=New Long() {tgtid}, DebugDetails:=False)
End Using
End If
Dim dt As SQLDataTable = Await getSQLDatatable_async("SELECT * FROM [dbo].[fds__getInvoiceTreeIds](@srqid);", Me.Intranet.Intranet__SQLConnectionString, SqlParameterList:=Me.StdParamlist("srqid", tgtid), ApplySymmetricKey:=Me.Intranet.Intranet__sql_symmetric_key, options:=SQLOptBasic(fn, id, code, Me.Form))
If dt.Count > 0 Then
Dim invoice_ids As New List(Of Long), srq_ids As New List(Of Long)
For Each rw As DataRow In dt.DataTable.Rows
Dim iid As Long = rw.nint("Id", -1)
Select Case rw.nz("type")
Case "invoice"
If iid > 0 AndAlso invoice_ids.Contains(iid) = False Then invoice_ids.Add(iid)
Case "servicerequest"
If iid > 0 AndAlso srq_ids.Contains(iid) = False Then srq_ids.Add(iid)
End Select
Next
Using mfr As New fds.fds_MFR_Client()
For Each iid As Long In invoice_ids
Await mfr.Update__entitytable(MFR_RESTClient.generic._generic.EntityTypes.Invoice, UpdateNeed:=fds.fds_mfr.UpdateNeed.Reset, EntityID:=New Long() {iid}, DebugDetails:=False)
Next
For Each iid As Long In srq_ids
Await mfr.Update__entitytable(MFR_RESTClient.generic._generic.EntityTypes.ServiceRequest, UpdateNeed:=fds.fds_mfr.UpdateNeed.Reset, EntityID:=New Long() {iid}, DebugDetails:=False)
Next
End Using
End If
End If
Action = New OKResult()
Case "get"
Try
If Me.Form.CheckParams(StrA("id")) = False Then Return New InputMissingResult()
Dim pl As ParamList = Me.StdParamlist(New SqlClient.SqlParameter() {SQL_VarChar("@Id", Me.Form("id"))})
Dim sqldset As SQLDataSet = Await getSQLDataSet_async("EXECUTE [dbo].[fds__getInvoice] @Id, @authuser;", Me.Intranet.Intranet__SQLConnectionString, SqlParameterList:=pl, ApplySymmetricKey:=Me.Intranet.Intranet__sql_symmetric_key, tablenames:=New String() {"admin", "inv", "req", "itm"}, options:=SQLOptBasic(fn, id, code, Me.Form))
Dim ldic As New List(Of Dictionary(Of String, Object))
For Each rq As DataRow In sqldset.Tables("req").Select("", If(sqldset.Tables("req").Columns.Contains("order"), "order", ""))
Dim rdic As Dictionary(Of String, Object) = rq.toObjectDictionary()
Dim sdic As New Dictionary(Of String, Object) From {
{"Id", rdic("mfr__servicerequest")},
{"InvRqId", rdic("Id")},
{"text", HttpUtility.HtmlDecode(rdic("title"))}
}
If sqldset.Contains("itm") Then
Dim itm As New List(Of Dictionary(Of String, Object))
' the InvRqId here is a STRING !
For Each sitm As DataRow In sqldset.Tables("itm").Select($"[InvRqId] = '{rdic("Id")}'", If(sqldset.Tables("itm").Columns.Contains("order"), "order", ""))
Dim idic As Dictionary(Of String, Object) = sitm.toObjectDictionary()
'{ Id: ix.Id, net_val: ix.net_val || 0, vat_val: ix.vat_val || 0, svcnet_val: 0, svcvat_val: 0, net: ix.net || 0, Note: ix.Note || '' }
Dim ndic As New Dictionary(Of String, Object) From {
{"Id", idic("Id")},
{"net_val", idic("value_total")},
{"vat_val", idic.no("value_total", 0) * idic.no("vat", 0) * 0.01},
{"vat", If(idic.no("vat", 0) = 0, "", CSng(idic.no("vat", 0)).ToString("0.00", Fuchs.intranet.pdf._pdf.deculture) & "%")},
{"svcnet_val", idic("value_service")},
{"net", idic("value")},
{"quantity", idic("Quantity")},
{"quantityhours", If(idic.no("value", 0) <> 0 AndAlso idic("Quantity").startswith(CLng(idic("value_total") / idic("value")).ToString() & " "), CLng(idic("value_total") / idic("value")), "")},
{"UnitString", If(idic.nz("Quantity", "") <> "", idic("Quantity").ToString.RightFromFirst(" "), "")},
{"Type", idic("Type")},
{"Note", Nothing},
{"NameOrNumber", ""},
{"htmltext", idic("Text")},
{"position", idic("Position")},
{"SortOrder", idic("SortOrder")}
}
itm.Add(ndic)
Next
sdic.Add("items", itm)
End If
ldic.Add(sdic)
Next
Dim AdminDic As Dictionary(Of String, Object) = sqldset.Table("admin").FirstRow.toObjectDictionary()
Dim InvDic As Dictionary(Of String, Object) = sqldset.Table("inv").FirstRow.toObjectDictionary()
If InvDic.nz("InvoiceOptions", "").Split(",").Contains("§13b") Then AdminDic.Add("p13b", True)
Action = Await JSONAsync(New With {.admin = AdminDic, .inv = InvDic, .req = ldic})
Catch ex As Exception
Action = New ExceptionResult("", InternalCode:=OCMS_StatusCodes.exception)
End Try
Case "icget"
If Me.Form.CheckParams(StrA("id")) = False Then Return New InputMissingResult()
'Using mfr As New fds.fds_MFR_Client()
' Await mfr.Update__entitytable(MFR_RESTClient.generic._generic.EntityTypes.ServiceRequest, UpdateNeed:=fds.fds_mfr.UpdateNeed.Reset, EntityID:=CLng(Me.Form("id")), DebugDetails:=False)
'End Using
Dim pl As ParamList = Me.StdParamlist(New SqlClient.SqlParameter() {SQL_VarChar("@InvId", Me.Form("id"))})
Dim tn As String() = New String() {"admin", "requests", "items", "steps", "companies", "locations"}
Dim sqldset As SQLDataSet = Await getSQLDataSet_async("EXECUTE [dbo].[fds__prepStorno_recreate] @InvId, @authuser;", Me.Intranet.Intranet__SQLConnectionString, SqlParameterList:=pl, ApplySymmetricKey:=Me.Intranet.Intranet__sql_symmetric_key, tablenames:=tn, options:=SQLOptBasic(fn, id, code, Me.Form))
Dim ldic As New List(Of Dictionary(Of String, Object))
For Each sq As DataRow In sqldset.Tables("requests").Select("", If(sqldset.Tables("requests").Columns.Contains("order"), "order", ""))
Dim sdic As Dictionary(Of String, Object) = sq.toObjectDictionary()
If sqldset.Contains("items") Then
Dim itm As New List(Of Dictionary(Of String, Object))
' the ServiceRequestId here is a number !
For Each sitm As DataRow In sqldset.Tables("items").Select("[ServiceRequestId] = " & sdic("Id"), If(sqldset.Tables("items").Columns.Contains("order"), "order", ""))
itm.Add(sitm.toObjectDictionary)
Next
sdic.Add("items", itm)
End If
If sqldset.Contains("steps") Then
Dim stp As New List(Of Dictionary(Of String, Object))
' the ServiceRequestId here is a number !
For Each sitm As DataRow In sqldset.Tables("steps").Select("[ServiceRequestId] = " & sdic("Id"), If(sqldset.Tables("steps").Columns.Contains("order"), "order", ""))
stp.Add(sitm.toObjectDictionary)
Next
sdic.Add("steps", stp)
End If
ldic.Add(sdic)
Next
Action = Await JSONAsync(New With {.admin = sqldset.Table("admin").FirstRow.toObjectDictionary(), .requests = ldic, .companies = sqldset.Tables("companies").toArrayofObjectDictionaries(), .locations = sqldset.Tables("locations").toArrayofObjectDictionaries()})
Case "storno", "credit"
If Me.Form.CheckParams(New String() {"id", "mode"}) = False Then Return New InputMissingResult()
Dim pl As ParamList = Me.StdParamlist(New SqlClient.SqlParameter() {SQL_VarChar("@Id", Me.Form("id"))})
Dim sqlcmd As String = ""
Select Case Me.Form("mode")
Case "credit"
sqlcmd = "EXECUTE [dbo].[fds__createCredit_simple] @Id, @authuser;"
Case "simple"
sqlcmd = "EXECUTE [dbo].[fds__createStorno_simple] @Id, @authuser;"
Case "copy"
sqlcmd = "EXECUTE [dbo].[fds__createStorno_copy] @Id, @authuser;"
End Select
If sqlcmd = "" Then Return New ExceptionResult("function not allowed", OCMS_StatusCodes.exception)
Dim sqldset As SQLDataSet = Await getSQLDataSet_async(sqlcmd, Me.Intranet.Intranet__SQLConnectionString, SqlParameterList:=pl, ApplySymmetricKey:=Me.Intranet.Intranet__sql_symmetric_key, tablenames:=New String() {"admin", "inv", "req", "itm"}, options:=SQLOptBasic(fn, id, code, Me.Form))
Dim ldic As New List(Of Dictionary(Of String, Object))
For Each rq As DataRow In sqldset.Tables("req").Select("", If(sqldset.Tables("req").Columns.Contains("order"), "order", ""))
Dim rdic As Dictionary(Of String, Object) = rq.toObjectDictionary()
Dim sdic As New Dictionary(Of String, Object) From {
{"Id", rdic("mfr__servicerequest")},
{"InvRqId", rdic("Id")},
{"text", HttpUtility.HtmlDecode(rdic("title"))}
}
If sqldset.Contains("itm") Then
Dim itm As New List(Of Dictionary(Of String, Object))
' the InvRqId here is a STRING !
For Each sitm As DataRow In sqldset.Tables("itm").Select($"[InvRqId] = '{rdic("Id")}'", If(sqldset.Tables("itm").Columns.Contains("order"), "order", ""))
Dim idic As Dictionary(Of String, Object) = sitm.toObjectDictionary()
'{ Id: ix.Id, net_val: ix.net_val || 0, vat_val: ix.vat_val || 0, svcnet_val: 0, svcvat_val: 0, net: ix.net || 0, Note: ix.Note || '' }
Dim ndic As New Dictionary(Of String, Object) From {
{"Id", idic("Id")},
{"net_val", idic("value_total")},
{"vat_val", idic.no("value_total", 0) * idic.no("vat", 0) * 0.01},
{"vat", If(idic.no("vat", 0) = 0, "", CSng(idic.no("vat", 0)).ToString("0.00", Fuchs.intranet.pdf._pdf.deculture) & "%")},
{"svcnet_val", idic("value_service")},
{"net", idic("value")},
{"quantity", idic("Quantity")},
{"quantityhours", If(idic.ContainsKey("value") AndAlso idic.ContainsKey("value_total") AndAlso idic.ContainsKey("Quantity") AndAlso ocms_commons.n_int(idic("value"), 0) <> 0 AndAlso ocms_commons.nz(idic("Quantity")).StartsWith(CLng(idic("value_total") / idic("value")).ToString() & " "), CLng(idic("value_total") / idic("value")), "")},
{"UnitString", If(idic.ContainsKey("Quantity") AndAlso ocms_commons.nz(value:=idic("Quantity")) <> "", idic("Quantity").ToString.RightFromFirst(" "), "")},
{"Type", idic("Type")},
{"Note", Nothing},
{"NameOrNumber", ""},
{"htmltext", idic("Text")},
{"position", idic("Position")},
{"SortOrder", idic("SortOrder")}
}
itm.Add(ndic)
Next
sdic.Add("items", itm)
End If
ldic.Add(sdic)
Next
Action = Await JSONAsync(New With {.admin = sqldset.Table("admin").FirstRow().toObjectDictionary(), .inv = sqldset.Table("inv").FirstRow().toObjectDictionary(), .req = ldic})
Case "invl"
If Me.Form.CheckParams(StrA("mode")) = False Then Return New InputMissingResult()
Dim tgtdate As Date, mode As String = Me.Form("mode").ToLower
If mode = "s" AndAlso Me.Form("tgt").Contains(":") Then
Dim pl As ParamList = Me.StdParamlist(New SqlClient.SqlParameter() {SQL_date("@tgtdate", tgtdate), SQL_VarChar("@mode", Me.Form("mode").ne("m")), SQL_bit("@include_drafts", Me.Form("all"))})
pl.Add(SQL_VarChar("@search", Me.Form("tgt")))
Dim sqldt As SQLDataSet = Await getSQLDataSet_async("EXECUTE [dbo].[fds__getInvoices_list2] @tgtdate, @mode, @include_drafts, @search, @authuser;", Me.Intranet.Intranet__SQLConnectionString, SqlParameterList:=pl, ApplySymmetricKey:=Me.Intranet.Intranet__sql_symmetric_key, tablenames:=New String() {"admin", "invoices"}, options:=SQLOptBasic(fn, id, code, Me.Form))
Action = Await JSONAsync(New With {.admin = sqldt.Table("admin").FirstRow().toObjectDictionary(), .invoices = sqldt.Tables("invoices").toArrayofObjectDictionaries})
ElseIf Date.TryParseExact(Me.Form("tgt"), "yy-MM-dd", Globalization.CultureInfo.InvariantCulture, System.Globalization.DateTimeStyles.AllowWhiteSpaces, tgtdate) = True Then
Dim pl As ParamList = Me.StdParamlist(New SqlClient.SqlParameter() {SQL_date("@tgtdate", tgtdate), SQL_VarChar("@mode", Me.Form("mode").ne("m")), SQL_VarChar("@includes", Me.Form("includes").ne(If(Me.Form("all") = "true", "all", "")))})
Dim sqldt As SQLDataSet = Await getSQLDataSet_async("EXECUTE [dbo].[fds__getInvoices_list_vario] @tgtdate, @mode, @includes, @authuser;", Me.Intranet.Intranet__SQLConnectionString, SqlParameterList:=pl, ApplySymmetricKey:=Me.Intranet.Intranet__sql_symmetric_key, tablenames:=New String() {"admin", "invoices"}, options:=SQLOptBasic(fn, id, code, Me.Form))
Action = Await JSONAsync(New With {.admin = sqldt.Table("admin").FirstRow().toObjectDictionary(), .invoices = sqldt.Tables("invoices").toArrayofObjectDictionaries})
Else
Action = New InputMissingResult()
End If
Case "rqi"
If Me.Form.CheckParams(StrA("id")) = False Then Return New InputMissingResult()
Dim pl As ParamList = Me.StdParamlist(SQL_VarChar("@invoiceid", Me.Form("id")))
Dim sqldt As SQLDataSet = Await getSQLDataSet_async("EXECUTE [dbo].[fds__getInvRequestItems] @invoiceid, @authuser;", Me.Intranet.Intranet__SQLConnectionString, SqlParameterList:=pl, ApplySymmetricKey:=Me.Intranet.Intranet__sql_symmetric_key, tablenames:=New String() {"requests", "items"}, options:=SQLOptBasic(fn, id, code, Me.Form))
Dim ldic As New List(Of Dictionary(Of String, Object))
For Each sq As DataRow In sqldt.Tables("requests").Select("", If(sqldt.Tables("requests").Columns.Contains("order"), "order", ""))
Dim sdic As Dictionary(Of String, Object) = sq.toObjectDictionary()
Dim itm As New List(Of Dictionary(Of String, Object))
' the ServiceRequestId here is a number !
For Each sitm As DataRow In sqldt.Tables("items").Select("[ServiceRequestId] = " & sdic("id"), If(sqldt.Tables("items").Columns.Contains("order"), "order", ""))
itm.Add(sitm.toObjectDictionary)
Next
sdic.Add("items", itm)
ldic.Add(sdic)
Next
Action = Await JSONAsync(New With {.requests = ldic})
Case "pyi"
If Me.Form.CheckParams(StrA("id")) = False Then Return New InputMissingResult()
Dim pl As ParamList = Me.StdParamlist(SQL_VarChar("@invoiceid", Me.Form("id")))
Dim sqldt As SQLDataSet = Await getSQLDataSet_async("EXECUTE [dbo].[fds__getInvPayments] @invoiceid, @authuser;", Me.Intranet.Intranet__SQLConnectionString, SqlParameterList:=pl, ApplySymmetricKey:=Me.Intranet.Intranet__sql_symmetric_key, tablenames:=New String() {"items"}, options:=SQLOptBasic(fn, id, code, Me.Form))
Dim ldic As New List(Of Dictionary(Of String, Object))
For Each sitm As DataRow In sqldt.Tables("items").Select("", If(sqldt.Tables("items").Columns.Contains("order"), "order", ""))
ldic.Add(sitm.toObjectDictionary)
Next
Action = Await JSONAsync(New With {.payments = ldic})
Case "datev"
Dim tgtdate As Date
If Date.TryParseExact(Me.Form("tgt"), "yy-MM-dd", Globalization.CultureInfo.InvariantCulture, System.Globalization.DateTimeStyles.AllowWhiteSpaces, tgtdate) = True Then
Dim pl As ParamList = Me.StdParamlist(New SqlClient.SqlParameter() {SQL_date("@tgtdate", tgtdate), SQL_VarChar("@mode", Me.Form("mode").ne("m"))})
Dim sqldt As SQLDataSet = Await getSQLDataSet_async("EXECUTE [dbo].[fds__getDatevExports] @tgtdate, @mode, @authuser;", Me.Intranet.Intranet__SQLConnectionString, SqlParameterList:=pl, ApplySymmetricKey:=Me.Intranet.Intranet__sql_symmetric_key, tablenames:=New String() {"files", "invoices", "debits"}, options:=SQLOptBasic(fn, id, code, Me.Form))
Action = Await JSONAsync(New With {.files = sqldt.Tables("files").toArrayofObjectDictionaries, .invoices = sqldt.Tables("invoices").toArrayofObjectDictionaries})
Else
Action = New InputMissingResult()
End If
Case "rdoc"
Dim reportid As String = Me.Form("id")
Dim filecontent As Byte() = Nothing
Dim file As IO.FileInfo = Global.fds.getReportDoc(file:=filecontent, reportid:=reportid)
If IsNothing(file) = False Then
If Me.Form("typ") <> "img" Then
Action = Await FileContentResultAsync(filecontent, file.MimeType, file.Name)
Else
Dim imgarray As String() = (Await Global.OCMS.pdf.pdfImageresultAsync(filecontent)).ToArray.Convert(Of String)(Function(i As Drawing.Image) "data:image/png;base64," & i.ToBase64()).ToArray()
Action = Await JSONAsync(New With {.id = reportid, .img = imgarray})
End If
Else
Action = New ExceptionResult("Dokument wurde nicht gefunden", OCMS_StatusCodes.exception)
End If
Case "rdocn"
If Me.Form.CheckParams(New String() {"name"}) = False Then Return New InputMissingResult()
Dim nme As String = Me.Form("name").ToString().LeftToFirst("(").Trim()
Dim reportid As String = ""
If nme <> "" Then
Dim so As SQLObject = Await getSQLValue_async("SELECT [dbo].[fds__fn_InvoiceIdByName](@nme);", SQLConnectionString:=Me.Intranet.Intranet__SQLConnectionString, SqlParameterList:=Me.StdParamlist("nme", nme), ApplySymmetricKey:=Me.Intranet.Intranet__sql_symmetric_key, options:=SQLOptBasic(fn, id, code, Me.Form))
reportid = ocms_commons.nz(so.Result, "")
End If
If reportid <> "" Then
Dim filecontent As Byte() = Nothing
Dim file As IO.FileInfo = Global.fds.getReportDoc(file:=filecontent, reportid:=reportid)
If IsNothing(file) = False Then
If Me.Form("typ") <> "img" Then
Action = Await FileContentResultAsync(filecontent, file.MimeType, file.Name)
Else
Dim imgarray As String() = (Await Global.OCMS.pdf.pdfImageresultAsync(filecontent)).ToArray.Convert(Of String)(Function(i As Drawing.Image) "data:image/png;base64," & i.ToBase64()).ToArray()
Action = Await JSONAsync(New With {.id = reportid, .img = imgarray})
End If
Else
Action = New ExceptionResult("Dokument wurde nicht gefunden", OCMS_StatusCodes.exception)
End If
Else
Action = New ExceptionResult("Not found", OCMS_StatusCodes.exception)
End If
Case "datevzip"
Dim tgtdate As Date
If Date.TryParseExact(Me.Form("tgt"), "yy-MM-dd", Globalization.CultureInfo.InvariantCulture, System.Globalization.DateTimeStyles.AllowWhiteSpaces, tgtdate) = True Then
Dim ms As New IO.MemoryStream
Dim file As IO.FileInfo = Global.fds.getDatevZip(stream:=ms, tgtdate, mode:=Me.Form("mode").ne("m"), AuthUser:=Me.UserAccountID, includeFiles:=If(Me.Form("files", "1") = "0", False, True))
If IsNothing(file) = False Then
ms.Position = 0
Action = Await FileStreamResultAsync(ms, file.MimeType, file.Name)
End If
Else
Action = New InputMissingResult()
End If
Case "getrem"
If Me.Form.CheckParams(StrA("id")) = False Then Return New InputMissingResult()
Dim pl As ParamList = Me.StdParamlist(SQL_VarChar("@InvId", Me.Form("id")))
pl.Add(SQL_bit("@include_drafts", Me.Form("drafts")))
Dim sqldt As SQLDataSet = Await getSQLDataSet_async("EXECUTE [dbo].[fds__getInvoiceReminder] @InvId, @include_drafts, @authuser;", Me.Intranet.Intranet__SQLConnectionString, SqlParameterList:=pl, ApplySymmetricKey:=Me.Intranet.Intranet__sql_symmetric_key, tablenames:=New String() {"reminder"}, options:=SQLOptBasic(fn, id, code, Me.Form))
Action = Await JSONAsync(sqldt.Table("reminder").DataTable.toArrayofObjectDictionaries())
Case "mfrrel"
If Me.Form.CheckParams(StrA("id")) = False Then Return New InputMissingResult()
Dim tgtid As Long
If Long.TryParse(Me.Form("id"), tgtid) = True Then
Using mfr As New fds.fds_MFR_Client()
Await mfr.Update__entitytable(MFR_RESTClient.generic._generic.EntityTypes.Invoice, UpdateNeed:=fds.fds_mfr.UpdateNeed.Reset, EntityID:=New Long() {tgtid}, DebugDetails:=False)
End Using
Action = New OKResult
Else
Action = New InputMissingResult()
End If
End Select
Return Action
End Function
End Class
End Namespace
Intranet_Legacy/code/fuchs_ocms_intranet_reminder.vb
+180
View File
@@ -0,0 +1,180 @@
Option Explicit On
Imports System.Threading.Tasks
Imports OCMS
Imports OCMS.intranet
Imports OCMS.SQLHandling
Imports njson = Newtonsoft.Json.JsonConvert
Namespace Global.OCMS.intranet.Controllers
Partial Public Class IntranetController
Private Async Function Do_Process_Reminder(fn As String, id As String, code As String) As Task(Of ActionResult)
Dim Action As ActionResult = Nothing
Select Case id.ToLower
Case "get"
If Me.Form.CheckParams(StrA("id")) = False Then Return New InputMissingResult()
Dim pl As ParamList = Me.StdParamlist(New SqlClient.SqlParameter() {SQL_VarChar("@InvId", Me.Form("id"))})
pl.Add(SQL_VarChar("@type", Me.Form("type")))
pl.Add(SQL_int("@level", Me.Form("level")))
Dim sqldset As SQLDataSet = Await getSQLDataSet_async("EXECUTE [dbo].[fds__prepReminder] @InvId, @authuser, @type, @level;", Me.Intranet.Intranet__SQLConnectionString, SqlParameterList:=pl, ApplySymmetricKey:=Me.Intranet.Intranet__sql_symmetric_key, tablenames:=New String() {"rem"}, options:=SQLOptBasic(fn, id, code, Me.Form))
Action = Await JSONAsync(New With {.rm = sqldset.Table("rem").FirstRow.toObjectDictionary()})
Case "prep"
If Me.Form.CheckParams(New String() {"remc"}) = False Then Return New InputMissingResult()
Dim ct As String = Me.Form("remc")
Dim ctd As Object = njson.DeserializeObject(ct)
Dim fd_rem As New Fuchs.intranet.fds__reminder_data(ctd)
fd_rem.RegisterReminder(Me, change:=False, RemId:="")
If fd_rem.Id <> "" Then
Dim imgcol As Global.OCMS.pdf.ImageCollection = Await Global.OCMS.pdf.pdfImageresultAsync(fd_rem.ReminderPDF(Me))
Action = Await JSONAsync(New With {.id = fd_rem.Id, .img = imgcol.ImgB64Array(), .total = imgcol.TotalPages})
Else
Action = New ExceptionResult("Erinnerung wurde nicht registriert", OCMS_StatusCodes.exception)
End If
Case "conf"
If Me.Form.CheckParams(StrA("id")) = False Then Return New InputMissingResult()
Dim dt As SQLDataTable = Await getSQLDatatable_async("EXECUTE [dbo].[fds__setReminderFinal] @Id, @authuser;", Me.Intranet.Intranet__SQLConnectionString, SqlParameterList:=Me.StdParamlist("Id", Me.Form("id")), ApplySymmetricKey:=Me.Intranet.Intranet__sql_symmetric_key, options:=SQLOptBasic(fn, id, code, Me.Form))
Dim frdic As Dictionary(Of String, Object) = dt.FirstRow.toObjectDictionary()
If frdic.ContainsKey("IsFinal") = True AndAlso frdic("IsFinal") = True Then
Dim RemID As String = frdic("Id")
Dim fd_rem As New Fuchs.intranet.fds__reminder_data(RemID, Me)
Dim filebyte As Byte() = Await fd_rem.StoreReminderDocumentFile(Me)
If frdic.nz("SendToEmail", "") <> "" AndAlso If(filebyte, New Byte() {}).Length > 0 Then ' Make sure no reminder is sent without file
Dim remdoc As New Dictionary(Of String, Byte()) From {{frdic.nz("DocumentName", "").ne("Zahlungserinnerung.pdf"), filebyte}}
If frdic.nz("InvoiceFileName") <> "" AndAlso frdic.no("InvoiceFile", "").GetType = GetType(Byte()) Then
remdoc.Add(frdic.nz("InvoiceFileName"), frdic("InvoiceFile"))
End If
Dim reminderbody As String = "<p>Sehr geehrte Damen und Herren,<br/>" &
"wir vermissen Ihren Zahlungseingang.</p>" &
If(frdic.no("amount_open", 0) <> 0, "<p>Der offene Betrag beläuft sich auf (inkl. MwSt.): " & CSng(frdic("amount_open")).ToString("0.00 €", Fuchs.intranet.pdf._pdf.deculture) & "</p>", "<p>Die Erinnerung mit allen Details finden Sie angehängt an diese Email.</p>") &
"<p>Bitte überweisen Sie den Rechnungsbetrag innerhalb von einer Woche auf unser Konto:<br />" &
"IBAN: DE76300501100045014800, BIC DUSSSDEDDXXX (Stadtsparkasse Düsseldorf)</p>" &
"<p>Wenn Sie mit uns zufrieden waren, empfehlen Sie uns gerne weiter, wenn nicht, dann sagen Sie es uns unter <a href=""mailto:info@sanitaerfuchs.de"">info@sanitaerfuchs.de</a>.<br />&nbsp;<br />&nbsp;<p>"
Dim SendToEmail As String = frdic("SendToEmail").trim()
Dim isSent As Boolean = Await Fuchs.intranet.fuchs_fds_email.SendEmail(Ref:="inv_" & RemID, Subject:="SanitärFuchs - " & frdic.nz("subject").ne(frdic.nz("DocumentName")), html:=reminderbody, Email:=SendToEmail, Name:="", files:=remdoc, Fuchs_intranet:=Me.Intranet)
If isSent = True Then
Dim pl As ParamList = Me.StdParamlist("Id", RemID)
pl.Add(SQL_bit("@auto", True))
dt = Await getSQLDatatable_async("EXECUTE [dbo].[fds__setReminderSent] @Id, @auto, @authuser;", Me.Intranet.Intranet__SQLConnectionString, SqlParameterList:=pl, ApplySymmetricKey:=Me.Intranet.Intranet__sql_symmetric_key, options:=SQLOptBasic(fn, id, code, Me.Form))
End If
End If
Action = New OKResult()
Else
Action = New ExceptionResult("Aktion war nicht erfolgreich", OCMS_StatusCodes.exception)
End If
Case "srs"
If Me.Form.CheckParams(StrA("id")) = False Then Return New InputMissingResult()
Dim pl As ParamList = Me.StdParamlist("Id", Me.Form("id"))
pl.Add(SQL_bit("@auto", False))
Dim dt2 As SQLDataSet = Await getSQLDataSet_async("EXECUTE [dbo].[fds__setReminderSent] @Id, @auto, @authuser;", Me.Intranet.Intranet__SQLConnectionString, SqlParameterList:=pl, ApplySymmetricKey:=Me.Intranet.Intranet__sql_symmetric_key, options:=SQLOptBasic(fn, id, code, Me.Form))
Action = If(If(dt2.Exception, "") = "", New OKResult, New ExceptionResult("not successful", OCMS_StatusCodes.exception))
Case "rdoc"
If Me.Form.CheckParams(StrA("id")) = False Then Return New InputMissingResult()
Dim reportid As String = Me.Form("id")
Dim filecontent As Byte() = Nothing
Dim file As IO.FileInfo = Fuchs.intranet.fds__reminder_data.getStoredFile(file:=filecontent, reminderid:=reportid, Me)
If IsNothing(file) = False Then
If Me.Form("typ") <> "img" Then
Action = Await FileContentResultAsync(filecontent, file.MimeType, file.Name)
Else
Dim imgarray As String() = (Await Global.OCMS.pdf.pdfImageresultAsync(filecontent)).ToArray.Convert(Of String)(Function(i As Drawing.Image) "data:image/png;base64," & i.ToBase64()).ToArray()
Action = Await JSONAsync(New With {.id = reportid, .img = imgarray})
End If
Else
Action = New ExceptionResult("Dokument wurde nicht gefunden", OCMS_StatusCodes.exception)
End If
Case "idoc"
If Me.Form.CheckParams(StrA("id")) = False Then Return New InputMissingResult()
If Me.Form("id") <> "" AndAlso Me.Form("typ") <> "img" Then
Dim fd_rem As New Fuchs.intranet.fds__reminder_data(Me.Form("id"), Me)
If fd_rem.Id <> "" Then
Dim filename As String = fd_rem.ReminderRegistration.nz("DocumentName").ne("Zahlungserinnerung_zu_" & fd_rem.ReminderRegistration("invoiceid", ReturnAlternative:="").ToString().ne("draft" & fd_rem.Id.ToString()) & ".pdf")
If Me.Form("create", "0") <> "1" Then
Dim ct As Byte() = Await fd_rem.getReminderFile(Me)
If IsNothing(ct) OrElse ct.Length = 0 Then ct = Await fd_rem.StoreReminderDocumentFile(Me)
Action = Await FileContentResultAsync(content:=ct, contenttype:="application/pdf", inline:=True, FileDownloadName:=filename)
Else
Action = Await Global.OCMS.pdf.pdfFileresultAsync(fd_rem.ReminderPDF(Me), filename:=filename, Locale:=New Globalization.CultureInfo("de-de"), inline:=True)
End If
Else
Action = New ExceptionResult("Erinnerung wurde nicht gefunden", OCMS_StatusCodes.exception)
End If
ElseIf Me.Form("id") <> "" Then
Dim fd_rem As New Fuchs.intranet.fds__reminder_data(Me.Form("id"), Me)
If fd_rem.Id <> "" Then
Dim img As New List(Of Drawing.Image), ct As Byte()
Dim filename As String = fd_rem.ReminderRegistration.nz("DocumentName").ne("Zahlungserinnerung_zu_" & fd_rem.ReminderRegistration("invoiceid", ReturnAlternative:="").ToString().ne("draft" & fd_rem.Id.ToString()) & ".pdf")
If Me.Form("create", "0") <> "1" Then
ct = Await fd_rem.getReminderFile(Me)
If IsNothing(ct) OrElse ct.Length = 0 Then ct = Await fd_rem.StoreReminderDocumentFile(Me)
Else
ct = Global.OCMS.pdf.pdfFileContent(fd_rem.ReminderPDF(Me))
End If
Dim imgcol As Global.OCMS.pdf.ImageCollection = Await Global.OCMS.pdf.pdfImageresultAsync(fd_rem.ReminderPDF(Me))
Action = Await JSONAsync(New With {.id = fd_rem.Id, .img = imgcol.ImgB64Array(), .total = imgcol.TotalPages})
Else
Action = New ExceptionResult("Erinnerung wurde nicht gefunden", OCMS_StatusCodes.exception)
End If
Else
Action = New ExceptionResult("Not found", OCMS_StatusCodes.exception)
End If
Case "resend"
If Me.Form.CheckParams(StrA("id")) = False Then Return New InputMissingResult()
If Me.Form("id") <> "" Then
Dim pl As List(Of SqlClient.SqlParameter) = Me.StdParamlist("Id", Me.Form("id"))
pl.Add(SQL_bit("@includefile", True))
Dim dtset As SQLDataSet = Await getSQLDataSet_async("EXECUTE [dbo].[fds__getReminder] @Id, @includefile, @authuser;", Me.Intranet.Intranet__SQLConnectionString, SqlParameterList:=pl, ApplySymmetricKey:=Me.Intranet.Intranet__sql_symmetric_key, tablenames:=New String() {"admin", "inv", "req", "itm"}, options:=SQLOptBasic(fn, id, code, Me.Form))
Dim frdic As Dictionary(Of String, Object) = dtset.Table("inv").FirstRow.toObjectDictionary()
If frdic.ContainsKey("IsFinal") = True AndAlso frdic("IsFinal") = True Then
Dim RemID As String = frdic("Id")
Dim fd_rem As New Fuchs.intranet.fds__reminder_data(RemID, Me)
Dim filebyte As Byte() = frdic.no("file", New Byte() {})
If frdic.nz("SendToEmail", "") <> "" AndAlso filebyte.Length > 0 Then ' Make sure no reminder is sent without file
Dim remdoc As New Dictionary(Of String, Byte()) From {{frdic.nz("DocumentName", "").ne("Zahlungserinnerung.pdf"), filebyte}}
If frdic.nz("InvoiceFileName") <> "" AndAlso frdic.no("InvoiceFile", "").GetType = GetType(Byte()) Then
remdoc.Add(frdic.nz("InvoiceFileName"), frdic("InvoiceFile"))
End If
Dim reminderbody As String = "<p>Sehr geehrte Damen und Herren,<br/>" &
"wir vermissen Ihren Zahlungseingang.</p>" &
If(frdic.no("amount_open", 0) <> 0, "<p>Der offene Betrag beläuft sich auf (inkl. MwSt.): " & CSng(frdic("amount_open")).ToString("0.00 €", Fuchs.intranet.pdf._pdf.deculture) & "</p>", "<p>Die Erinnerung mit allen Details finden Sie angehängt an diese Email.</p>") &
"<p>Bitte überweisen Sie den Rechnungsbetrag innerhalb von einer Woche auf unser Konto:<br />" &
"IBAN: DE76300501100045014800, BIC DUSSSDEDDXXX (Stadtsparkasse Düsseldorf)</p>" &
"<p>Wenn Sie mit uns zufrieden waren, empfehlen Sie uns gerne weiter, wenn nicht, dann sagen Sie es uns unter <a href=""mailto:info@sanitaerfuchs.de"">info@sanitaerfuchs.de</a>.<br />&nbsp;<br />&nbsp;<p>"
Dim SendToEmail As String = frdic("SendToEmail").trim()
Dim isSent As Boolean = Await Fuchs.intranet.fuchs_fds_email.SendEmail(Ref:="rem_" & RemID, Subject:="SanitärFuchs - " & frdic.nz("subject").ne(frdic.nz("DocumentName")), html:=reminderbody, Email:=SendToEmail, Name:="", files:=remdoc, Fuchs_intranet:=Me.Intranet)
If isSent = True Then
Dim pls As ParamList = Me.StdParamlist("Id", RemID)
pls.Add(SQL_bit("@auto", True))
Dim dt2 As SQLDataSet = Await getSQLDataSet_async("EXECUTE [dbo].[fds__setReminderSent] @Id, @authuser;", Me.Intranet.Intranet__SQLConnectionString, SqlParameterList:=pls, ApplySymmetricKey:=Me.Intranet.Intranet__sql_symmetric_key, options:=SQLOptBasic(fn, id, code, Me.Form))
End If
End If
Action = New OKResult()
Else
Action = New ExceptionResult("Aktion war nicht erfolgreich", OCMS_StatusCodes.exception)
End If
Else
Action = New ExceptionResult("Not found", OCMS_StatusCodes.exception)
End If
Case "lrem"
If Me.Form.CheckParams(StrA("id")) = False Then Return New InputMissingResult()
Dim dtset As SQLDataSet = Await getSQLDataSet_async("EXECUTE [dbo].[fds__lookupReminders] @InvId, @authuser;", Me.Intranet.Intranet__SQLConnectionString, SqlParameterList:=Me.StdParamlist("@InvId", Me.Form("id")), ApplySymmetricKey:=Me.Intranet.Intranet__sql_symmetric_key, tablenames:=New String() {"ov", "rem"}, options:=SQLOptBasic(fn, id, code, Me.Form))
Action = Await JSONAsync(New With {.ov = dtset.Table("ov").FirstRow().toStringDictionary(), .lst = dtset.Tables("rem").toArrayofObjectDictionaries()})
Case "del"
End Select
Return Action
End Function
End Class
End Namespace
Intranet_Legacy/code/fuchs_ocms_intranet_requests.vb
+318
View File
@@ -0,0 +1,318 @@
Option Explicit On
Imports System.Threading.Tasks
Imports OCMS
Imports OCMS.intranet
Imports OCMS.SQLHandling
Imports njson = Newtonsoft.Json.JsonConvert
Namespace Global.OCMS.intranet.Controllers
Partial Public Class IntranetController
Private Async Function Do_Process_Requests(fn As String, id As String, code As String) As Task(Of ActionResult)
Dim Action As ActionResult = Nothing
Select Case id.ToLower
Case "auth"
Action = Await JSONAsync(New With {.manage = 1})
Case "rthd"
If Me.Form.CheckParams(StrA("id")) = False Then Return New InputMissingResult()
Dim pl As ParamList = Me.StdParamlist(New SqlClient.SqlParameter() {SQL_BigInt("@id", Me.Form("id"))})
Dim sqldt As SQLDataTable = Await getSQLDatatable_async("EXECUTE [dbo].[fds__toggleRequestHidden] @Id, @authuser;", Me.Intranet.Intranet__SQLConnectionString, SqlParameterList:=pl, ApplySymmetricKey:=Me.Intranet.Intranet__sql_symmetric_key, options:=SQLOptBasic(fn, id, code, Me.Form))
If sqldt.Count > 0 Then
Dim dic As Dictionary(Of String, Object) = sqldt.FirstRow.toObjectDictionary
Action = Await JSONAsync(New With {.id = dic("EntityId"), .visible = (dic.no("hidden", False) = False)})
Else
Action = New ExceptionResult("not found", OCMS_StatusCodes.exception)
End If
Case "reql"
If Me.Form.CheckParams(StrA("mode")) = False Then Return New InputMissingResult()
Dim tgtdate As Date, mode As String = Me.Form("mode").ToLower
If mode = "s" AndAlso Me.Form("tgt").Contains(":") Then
Dim pl As ParamList = Me.StdParamlist(New SqlClient.SqlParameter() {SQL_date("@tgtdate", DBNull.Value), SQL_VarChar("@mode", mode), SQL_bit("@completed", True)})
pl.Add(SQL_VarChar("@search", Me.Form("tgt")))
Dim sqldt As SQLDataSet = Await getSQLDataSet_async("EXECUTE [dbo].[fds__getRequests_list2] @tgtdate, @mode, @completed, @search, @authuser;", Me.Intranet.Intranet__SQLConnectionString, SqlParameterList:=pl, ApplySymmetricKey:=Me.Intranet.Intranet__sql_symmetric_key, tablenames:=New String() {"admin", "requests", "reports"}, options:=SQLOptBasic(fn, id, code, Me.Form))
Dim req As New List(Of Dictionary(Of String, Object))(sqldt.Tables("requests").toArrayofObjectDictionaries())
For Each r As Dictionary(Of String, Object) In req
Try
r.Add("reports", sqldt.Tables("reports").toArrayofObjectDictionaries(selectstring:="[requestID] = " & r("Id")))
Catch ex As Exception
End Try
Next
Action = Await JSONAsync(New With {.admin = sqldt.Table("admin").FirstRow().toObjectDictionary(), .requests = req})
ElseIf Date.TryParseExact(Me.Form("tgt"), "yy-MM-dd", Globalization.CultureInfo.InvariantCulture, System.Globalization.DateTimeStyles.AllowWhiteSpaces, tgtdate) = True Then
Dim pl As ParamList = Me.StdParamlist(New SqlClient.SqlParameter() {SQL_date("@tgtdate", tgtdate), SQL_VarChar("@mode", mode), SQL_bit("@completed", True)})
Dim sqldt As SQLDataSet = Await getSQLDataSet_async("EXECUTE [dbo].[fds__getRequests_list] @tgtdate, @mode, @completed, @authuser;", Me.Intranet.Intranet__SQLConnectionString, SqlParameterList:=pl, ApplySymmetricKey:=Me.Intranet.Intranet__sql_symmetric_key, tablenames:=New String() {"admin", "requests", "reports"}, options:=SQLOptBasic(fn, id, code, Me.Form))
Dim req As New List(Of Dictionary(Of String, Object))(sqldt.Tables("requests").toArrayofObjectDictionaries())
For Each r As Dictionary(Of String, Object) In req
Try
r.Add("reports", sqldt.Tables("reports").toArrayofObjectDictionaries(selectstring:="[requestID] = " & r("Id")))
Catch ex As Exception
End Try
Next
Action = Await JSONAsync(New With {.admin = sqldt.Table("admin").FirstRow().toObjectDictionary(), .requests = req})
Else
Action = New InputMissingResult()
End If
Case "pget"
Dim tgtid As Long
If Me.Form.CheckParams(StrA("id")) = False OrElse Long.TryParse(Me.Form("id"), tgtid) = False Then Return New InputMissingResult()
If 1 = 1 OrElse (Me.Request.Url.Host.ToLower <> "localhost" AndAlso Diagnostics.Debugger.IsAttached = False) Then
Dim dt As SQLDataTable = Await getSQLDatatable_async("SELECT * FROM [dbo].[fds__getRequestTreeIds](@srqid);", Me.Intranet.Intranet__SQLConnectionString, SqlParameterList:=Me.StdParamlist("srqid", tgtid), ApplySymmetricKey:=Me.Intranet.Intranet__sql_symmetric_key, options:=SQLOptBasic(fn, id, code, Me.Form))
If dt.Count > 0 Then
Dim ids As New List(Of Long) From {Me.Form("id")}
For Each rw As DataRow In dt.DataTable.Rows
Dim iid As Long = rw.nint("Id", -1)
If iid > 0 AndAlso ids.Contains(iid) = False Then ids.Add(iid)
Next
Dim SchemaDic As New Dictionary(Of String, fds.fds_MFR_Client.DatabaseSchema), thisEntityNAme As String = MFR_RESTClient.generic._generic.EntityName(MFR_RESTClient.generic._generic.EntityTypes.ServiceRequest)
SchemaDic.Add(thisEntityNAme, New fds.fds_MFR_Client.DatabaseSchema(MFR_RESTClient.generic._generic.EntityTypes.ServiceRequest))
Using mfr As New fds.fds_MFR_Client()
Diagnostics.Debug.Print("pget - srq " & ids.Count.ToString & "start " & Now.ToShortTimeString)
Await mfr.Update__entitytable(MFR_RESTClient.generic._generic.EntityTypes.ServiceRequest, UpdateNeed:=fds.fds_mfr.UpdateNeed.Reset, EntityID:=ids.ToArray, SchemaDic:=SchemaDic)
Diagnostics.Debug.Print("pget - srq " & ids.Count.ToString & "complete " & Now.ToShortTimeString)
End Using
Else
Using mfr As New fds.fds_MFR_Client()
Await mfr.Update__entitytable(MFR_RESTClient.generic._generic.EntityTypes.ServiceRequest, UpdateNeed:=fds.fds_mfr.UpdateNeed.Reset, EntityID:=New Long() {tgtid}, DebugDetails:=False)
End Using
End If
End If
Action = New OKResult()
Case "get"
If Me.Form.CheckParams(StrA("id")) = False Then Return New InputMissingResult()
'Using mfr As New fds.fds_MFR_Client()
' Await mfr.Update__entitytable(MFR_RESTClient.generic._generic.EntityTypes.ServiceRequest, UpdateNeed:=fds.fds_mfr.UpdateNeed.Reset, EntityID:=CLng(Me.Form("id")), DebugDetails:=False)
'End Using
Dim pl As ParamList = Me.StdParamlist(New SqlClient.SqlParameter() {SQL_BigInt("@servicerequestid", Me.Form("id")), SQL_Char("@typ", Me.Form("typ").Substr(0, 1).ToLower()), SQL_VarChar("@mode", Me.Form("mode").ne("ov"))})
Dim tn As String() = New String() {"requests", "items"}
Select Case Me.Form("mode").ne("ov")
Case "r"
tn = New String() {"admin", "requests", "inv"}
Case "ov"
tn = New String() {"admin", "requests", "items", "inv"}
Case "ful"
tn = New String() {"admin", "requests", "items", "steps", "companies", "locations", "inv"}
End Select
Dim sqldset As SQLDataSet = Await getSQLDataSet_async("EXECUTE [dbo].[fds__getRequest_details] @servicerequestid, @mode, @authuser;", Me.Intranet.Intranet__SQLConnectionString, SqlParameterList:=pl, ApplySymmetricKey:=Me.Intranet.Intranet__sql_symmetric_key, tablenames:=tn, options:=SQLOptBasic(fn, id, code, Me.Form))
Dim ldic As New List(Of Dictionary(Of String, Object))
For Each sq As DataRow In sqldset.Tables("requests").Select("", If(sqldset.Tables("requests").Columns.Contains("order"), "order", ""))
Dim sdic As Dictionary(Of String, Object) = sq.toObjectDictionary()
If sqldset.Contains("items") Then
Dim itm As New List(Of Dictionary(Of String, Object))
For Each sitm As DataRow In sqldset.Tables("items").Select("[ServiceRequestId] = " & sdic("Id"), If(sqldset.Tables("items").Columns.Contains("order"), "order", ""))
itm.Add(sitm.toObjectDictionary)
Next
sdic.Add("items", itm)
End If
If sqldset.Contains("steps") Then
Dim stp As New List(Of Dictionary(Of String, Object))
For Each sitm As DataRow In sqldset.Tables("steps").Select("[ServiceRequestId] = " & sdic("Id"), If(sqldset.Tables("steps").Columns.Contains("order"), "order", ""))
stp.Add(sitm.toObjectDictionary)
Next
sdic.Add("steps", stp)
End If
ldic.Add(sdic)
Next
Dim AdminDic As Dictionary(Of String, Object) = sqldset.Table("admin").FirstRow.toObjectDictionary()
Action = Await JSONAsync(New With {.admin = AdminDic, .requests = ldic, .companies = sqldset.Tables("companies").toArrayofObjectDictionaries(), .locations = sqldset.Tables("locations").toArrayofObjectDictionaries(), .inv = sqldset.Tables("inv").toArrayofObjectDictionaries()})
Case "iget"
If Me.Form.CheckParams(New String() {"id", "typ"}) = False Then Return New InputMissingResult()
'Using mfr As New fds.fds_MFR_Client()
' Await mfr.Update__entitytable(MFR_RESTClient.generic._generic.EntityTypes.ServiceRequest, UpdateNeed:=fds.fds_mfr.UpdateNeed.Reset, EntityID:=CLng(Me.Form("id")), DebugDetails:=False)
'End Using
Dim pl As ParamList = Me.StdParamlist(New SqlClient.SqlParameter() {SQL_BigInt("@servicerequestid", Me.Form("id")), SQL_Char("@type", Me.Form("typ").Substr(0, 1).ToLower()), SQL_VarChar("@mode", Me.Form("mode").ne("ov"))})
pl.Add(SQL_VarChar("sel", Me.Form("sel")))
Dim tn As String() = New String() {"admin", "requests", "items", "steps", "companies", "locations"}
Dim sqldset As SQLDataSet = Await getSQLDataSet_async("EXECUTE [dbo].[fds__prepInvoice] @servicerequestid, @mode, @authuser, @type, @sel;", Me.Intranet.Intranet__SQLConnectionString, SqlParameterList:=pl, ApplySymmetricKey:=Me.Intranet.Intranet__sql_symmetric_key, tablenames:=tn, options:=SQLOptBasic(fn, id, code, Me.Form))
Dim ldic As New List(Of Dictionary(Of String, Object))
For Each sq As DataRow In sqldset.Tables("requests").Select("", If(sqldset.Tables("requests").Columns.Contains("order"), "order", ""))
Dim sdic As Dictionary(Of String, Object) = sq.toObjectDictionary()
If sqldset.Contains("items") Then
Dim itm As New List(Of Dictionary(Of String, Object))
For Each sitm As DataRow In sqldset.Tables("items").Select("[ServiceRequestId] = " & sdic("Id"), If(sqldset.Tables("items").Columns.Contains("order"), "order", ""))
itm.Add(sitm.toObjectDictionary)
Next
sdic.Add("items", itm)
End If
If sqldset.Contains("steps") Then
Dim stp As New List(Of Dictionary(Of String, Object))
For Each sitm As DataRow In sqldset.Tables("steps").Select("[ServiceRequestId] = " & sdic("Id"), If(sqldset.Tables("steps").Columns.Contains("order"), "order", ""))
stp.Add(sitm.toObjectDictionary)
Next
sdic.Add("steps", stp)
End If
ldic.Add(sdic)
Next
Action = Await JSONAsync(New With {.admin = sqldset.Table("admin").FirstRow.toObjectDictionary(), .requests = ldic, .companies = sqldset.Tables("companies").toArrayofObjectDictionaries(), .locations = sqldset.Tables("locations").toArrayofObjectDictionaries()})
Case "save"
If Me.Form.CheckParams(New String() {"invc"}) = False Then Return New InputMissingResult()
Dim ct As String = Me.Form("invc")
Dim ctd As Object = njson.DeserializeObject(ct)
Dim fd_inv As New Fuchs.intranet.fds__invoice_data(ctd)
fd_inv.RegisterInvoice(Me, change:=Me.Form("id") <> "", InvId:=Me.Form("id"))
If fd_inv.Id <> "" Then
Action = Await JSONAsync(New With {.id = fd_inv.Id})
Else
Action = New ExceptionResult("Rechnung wurde nicht gespeichert", OCMS_StatusCodes.exception)
End If
Case "sprep"
If Me.Form.CheckParams(New String() {"invc"}) = False Then Return New InputMissingResult()
Dim ct As String = Me.Form("invc")
Dim ctd As Object = njson.DeserializeObject(ct)
Dim fd_inv As New Fuchs.intranet.fds__invoice_data(ctd)
fd_inv.RegisterInvoice(Me, change:=False, InvId:="")
If fd_inv.Id <> "" Then
Dim imgcol As Global.OCMS.pdf.ImageCollection = Await Global.OCMS.pdf.pdfImageresultAsync(fd_inv.InvoicePDF(Me))
Action = Await JSONAsync(New With {.id = fd_inv.Id, .img = imgcol.ImgB64Array(), .total = imgcol.TotalPages})
Else
Action = New ExceptionResult("Rechnung wurde nicht registriert", OCMS_StatusCodes.exception)
End If
Case "sedit"
If Me.Form.CheckParams(New String() {"id", "invc"}) = False Then Return New InputMissingResult()
Dim ct As String = Me.Form("invc"), invoiceid As String = Me.Form("id")
Dim ctd As Object = njson.DeserializeObject(ct)
Dim fd_inv As New Fuchs.intranet.fds__invoice_data(ctd)
fd_inv.RegisterInvoice(Me, change:=True, InvId:=invoiceid)
If fd_inv.Id <> "" Then
Dim imgcol As Global.OCMS.pdf.ImageCollection = Await Global.OCMS.pdf.pdfImageresultAsync(fd_inv.InvoicePDF(Me))
Action = Await JSONAsync(New With {.id = fd_inv.Id, .img = imgcol.ImgB64Array(), .total = imgcol.TotalPages})
Else
Action = New ExceptionResult("Rechnung wurde nicht registriert", OCMS_StatusCodes.exception)
End If
Case "sdel"
If Me.Form.CheckParams(StrA("id")) = False Then Return New InputMissingResult()
Await setSQLValue_async("EXECUTE [dbo].[fds__remInvoice] @Id, @authuser;", Me.Intranet.Intranet__SQLConnectionString, SqlParameterList:=Me.StdParamlist("Id", Me.Form("id")), ApplySymmetricKey:=Me.Intranet.Intranet__sql_symmetric_key, options:=SQLOptBasic(fn, id, code, Me.Form))
Action = New OKResult()
Case "sconf"
If Me.Form.CheckParams(StrA("id")) = False Then Return New InputMissingResult()
Dim dt As SQLDataTable = Await getSQLDatatable_async("EXECUTE [dbo].[fds__setInvoiceFinal] @Id, @authuser;", Me.Intranet.Intranet__SQLConnectionString, SqlParameterList:=Me.StdParamlist("Id", Me.Form("id")), ApplySymmetricKey:=Me.Intranet.Intranet__sql_symmetric_key, options:=SQLOptBasic(fn, id, code, Me.Form))
Dim frdic As Dictionary(Of String, Object) = dt.FirstRow.toObjectDictionary()
If frdic.ContainsKey("IsFinal") = True AndAlso frdic("IsFinal") = True Then
Dim InvID As String = frdic("Id")
Dim fd_inv As New Fuchs.intranet.fds__invoice_data(InvID, Me)
Dim filebyte As Byte() = Await fd_inv.StoreInvoiceDocumentFile(Me)
Dim dtset As SQLDataSet = Await getSQLDataSet_async("EXECUTE [dbo].[fds__getInvoice] @Id, @authuser;", Me.Intranet.Intranet__SQLConnectionString, SqlParameterList:=Me.StdParamlist("Id", Me.Form("id")), ApplySymmetricKey:=Me.Intranet.Intranet__sql_symmetric_key, tablenames:=New String() {"admin", "inv", "req", "itm"}, options:=SQLOptBasic(fn, id, code, Me.Form))
frdic = dtset.Table("inv").FirstRow.toObjectDictionary()
If frdic.nz("SendToEmail", "") <> "" AndAlso If(filebyte, New Byte() {}).Length > 0 Then ' make sure that no invoice is sent without file !!
Dim inv As New Dictionary(Of String, Byte()) From {{frdic("DocumentName"), filebyte}}
Dim invoicebody As String = "<p>Sehr geehrte Damen und Herren,<br/>" &
"vielen Dank für Ihren Auftrag, wir haben gern für Sie gearbeitet.</p>" &
If(frdic.no("InvoiceBalance", 0) <> 0, "<p>Unsere Dienstleistung stellen wir wie folgt In Rechnung (inkl. MwSt.): " & CSng(frdic("InvoiceBalance")).ToString("0.00 €", Fuchs.intranet.pdf._pdf.deculture) & "</p>", "<p>Die Abrechnung unserer Dienstleistung finden Sie angehängt an diese Email.</p>") &
"<p>Bitte überweisen Sie den Rechnungsbetrag innerhalb von " & fd_inv.paymentterms.Replace("wd", " Werktagen").Replace("d", " Tagen").Replace("wk", " Wochen").ne("10 Tagen") & " auf unser Konto:<br />" &
"IBAN: DE76300501100045014800, BIC DUSSSDEDDXXX (Stadtsparkasse Düsseldorf)</p>" &
"<p>Bei Rückfragen antworten Sie bitte nicht an diese Absenderadresse, sondern wenden Sie sich direkt an Ihre/n Sachberarbeiter/in oder an die <a href=""mailto:info@sanitaerfuchs.de"">info@sanitaerfuchs.de</a>.</p>" &
"<p>Wenn Sie mit uns zufrieden waren, empfehlen Sie uns gerne weiter, wenn nicht, dann sagen Sie es uns unter <a href=""mailto:info@sanitaerfuchs.de"">info@sanitaerfuchs.de</a>.<br />&nbsp;<br />&nbsp;<p>"
Dim SendToEmail As String = frdic("SendToEmail").trim()
Dim isSent As Boolean = Await Fuchs.intranet.fuchs_fds_email.SendEmail(Ref:="inv_" & InvID, Subject:="SanitärFuchs - " & frdic("DocumentName"), html:=invoicebody, Email:=SendToEmail, Name:="", files:=inv, Fuchs_intranet:=Me.Intranet)
If isSent = True Then
Dim pl As ParamList = Me.StdParamlist("Id", InvID)
pl.Add(SQL_bit("@auto", True))
dt = Await getSQLDatatable_async("EXECUTE [dbo].[fds__setInvoiceSent] @Id, @auto, @authuser;", Me.Intranet.Intranet__SQLConnectionString, SqlParameterList:=pl, ApplySymmetricKey:=Me.Intranet.Intranet__sql_symmetric_key, options:=SQLOptBasic(fn, id, code, Me.Form))
End If
End If
Action = New OKResult()
Else
Action = New ExceptionResult("Aktion war nicht erfolgreich", OCMS_StatusCodes.exception)
End If
Case "idoc"
If Me.Form.CheckParams(StrA("id")) = False Then Return New InputMissingResult()
If Me.Form("id") <> "" AndAlso Me.Form("typ") <> "img" Then
Dim fd_inv As New Fuchs.intranet.fds__invoice_data(Me.Form("id"), Me)
If fd_inv.Id <> "" Then
Dim filename As String = fd_inv.InvoiceRegistration.nz("DocumentName").ne("Rechnung_" & fd_inv.InvoiceRegistration("invoiceid", ReturnAlternative:="").ToString().ne("draft" & fd_inv.Id.ToString()) & ".pdf")
If Me.Form("create", "0") <> "1" Then
Dim ct As Byte() = Await fd_inv.getInvoiceFile(Me)
If IsNothing(ct) OrElse ct.Length = 0 Then ct = Await fd_inv.StoreInvoiceDocumentFile(Me)
If IsNothing(ct) = False Then
Action = Await FileContentResultAsync(content:=ct, contenttype:="application/pdf", inline:=True, FileDownloadName:=filename)
Else
Action = New ExceptionResult("Rechnungs-PDF konnte nicht erstellt werden", OCMS_StatusCodes.exception)
End If
Else
Action = Await Global.OCMS.pdf.pdfFileresultAsync(fd_inv.InvoicePDF(Me), filename:=filename, Locale:=New Globalization.CultureInfo("de-de"), inline:=True)
End If
Else
Action = New ExceptionResult("Rechnung wurde nicht gefunden", OCMS_StatusCodes.exception)
End If
ElseIf Me.Form("id") <> "" Then
Dim fd_inv As New Fuchs.intranet.fds__invoice_data(Me.Form("id"), Me)
If fd_inv.Id <> "" Then
Dim img As New List(Of Drawing.Image), ct As Byte()
Dim filename As String = fd_inv.InvoiceRegistration.nz("DocumentName").ne("Rechnung_" & fd_inv.InvoiceRegistration("invoiceid", ReturnAlternative:="").ToString().ne("draft" & fd_inv.Id.ToString()) & ".pdf")
If Me.Form("create", "0") <> "1" Then
ct = Await fd_inv.getInvoiceFile(Me)
If IsNothing(ct) OrElse ct.Length = 0 Then ct = Await fd_inv.StoreInvoiceDocumentFile(Me)
Else
ct = Global.OCMS.pdf.pdfFileContent(fd_inv.InvoicePDF(Me))
End If
Dim imgcol As Global.OCMS.pdf.ImageCollection = Await Global.OCMS.pdf.pdfImageresultAsync(fd_inv.InvoicePDF(Me))
Action = Await JSONAsync(New With {.id = fd_inv.Id, .img = imgcol.ImgB64Array(), .total = imgcol.TotalPages})
Else
Action = New ExceptionResult("Rechnung wurde nicht gefunden", OCMS_StatusCodes.exception)
End If
Else
Action = New ExceptionResult("Not found", OCMS_StatusCodes.exception)
End If
Case "resend"
If Me.Form.CheckParams(StrA("id")) = False Then Return New InputMissingResult()
If Me.Form("id") <> "" Then
Dim dtset As SQLDataSet = Await getSQLDataSet_async("EXECUTE [dbo].[fds__getInvoice] @Id, @authuser;", Me.Intranet.Intranet__SQLConnectionString, SqlParameterList:=Me.StdParamlist("Id", Me.Form("id")), ApplySymmetricKey:=Me.Intranet.Intranet__sql_symmetric_key, tablenames:=New String() {"admin", "inv", "req", "itm"})
Dim frdic As Dictionary(Of String, Object) = dtset.Table("inv").FirstRow.toObjectDictionary()
If frdic.ContainsKey("IsFinal") = True AndAlso frdic("IsFinal") = True Then
Dim InvID As String = frdic("Id")
Dim fd_inv As New Fuchs.intranet.fds__invoice_data(InvID, Me)
Dim filebyte As Byte() = Global.OCMS.pdf.pdfFileContent(fd_inv.InvoicePDF(Me))
If frdic.nz("SendToEmail", "") <> "" AndAlso If(filebyte, New Byte() {}).Length > 0 Then ' Make sure no reminder is sent without file
Dim inv As New Dictionary(Of String, Byte()) From {{frdic("DocumentName"), filebyte}}
Dim invoicebody As String = "<p>Sehr geehrte Damen und Herren,<br/>" &
"vielen Dank für Ihren Auftrag, wir haben gern für Sie gearbeitet.</p>" &
If(frdic.no("InvoiceBalance", 0) <> 0, "<p>Unsere Dienstleistung stellen wir wie folgt In Rechnung (inkl. MwSt.): " & CSng(frdic("InvoiceBalance")).ToString("0.00 €", Fuchs.intranet.pdf._pdf.deculture) & "</p>", "<p>Die Abrechnung unserer Dienstleistung finden Sie angehängt an diese Email.</p>") &
"<p>Bitte überweisen Sie den Rechnungsbetrag innerhalb von " & fd_inv.paymentterms.Replace("wd", " Werktagen").Replace("d", " Tagen").Replace("wk", " Wochen").ne("10 Tagen") & " auf unser Konto:<br />" &
"IBAN: DE76300501100045014800, BIC DUSSSDEDDXXX (Stadtsparkasse Düsseldorf)</p>" &
"<p>Wenn Sie mit uns zufrieden waren, empfehlen Sie uns gerne weiter, wenn nicht, dann sagen Sie es uns unter <a href=""mailto:info@sanitaerfuchs.de"">info@sanitaerfuchs.de</a>.<br />&nbsp;<br />&nbsp;<p>"
Dim SendToEmail As String = frdic("SendToEmail").trim()
Dim isSent As Boolean = Await Fuchs.intranet.fuchs_fds_email.SendEmail(Ref:="inv_" & InvID, Subject:="SanitärFuchs - " & frdic("DocumentName"), html:=invoicebody, Email:=SendToEmail, Name:="", files:=inv, Fuchs_intranet:=Me.Intranet)
If isSent = True Then
Dim pl As ParamList = Me.StdParamlist("Id", InvID)
pl.Add(SQL_bit("@auto", True))
Dim dt2 As SQLDataSet = Await getSQLDataSet_async("EXECUTE [dbo].[fds__setInvoiceSent] @Id, @auto, @authuser;", Me.Intranet.Intranet__SQLConnectionString, SqlParameterList:=pl, ApplySymmetricKey:=Me.Intranet.Intranet__sql_symmetric_key)
End If
End If
Action = New OKResult()
Else
Action = New ExceptionResult("Aktion war nicht erfolgreich", OCMS_StatusCodes.exception)
End If
Else
Action = New ExceptionResult("Not found", OCMS_StatusCodes.exception)
End If
End Select
Return Action
End Function
End Class
End Namespace
Intranet_Legacy/code/fuchs_reports.vb
+294
View File
@@ -0,0 +1,294 @@
Imports System.Threading.Tasks
Imports OCMS
Imports OCMS.intranet
Imports OCMS.SQLHandling
Imports json = Newtonsoft.Json.JsonConvert
Namespace Global.Fuchs.intranet
Module fuchs_reports
'Public Function LogReport(ReportId As Long) As Boolean
' Try
' Dim t As System.Threading.Tasks.Task(Of Object) = SO_Tools.setSQLValue_async("EXECUTE [dbo].[ctm__reports_logReport] @report_id;", SQLConnectionString:=System.Configuration.ConfigurationManager.ConnectionStrings("CTM_Reporting").ConnectionString, SqlParameterList:=New List(Of SqlClient.SqlParameter) From {New SqlClient.SqlParameter("@report_id", ReportId)})
' t.Start()
' Catch ex As Exception
' Debug.Print("fds_reports - LogReport_async", ex:=ex, data:=json.SerializeObject(New With {.report_id = ReportId}))
' End Try
' Return True
'End Function
'Public Function LogReport(ReportId As String, parameter As String, Optional sync As Boolean = False) As Boolean
' Try
' Dim report As Long
' If Long.TryParse(ReportId, report) = False Then
' Throw New Exception("ReportID '" & ReportId & "' not valid")
' End If
' Dim spl As New List(Of SqlClient.SqlParameter) From {
' New SqlClient.SqlParameter("@report_id", report),
' New SqlClient.SqlParameter("@parameter", parameter)
' }
' Dim setSql As Action = Sub() Call setSQLValue("EXECUTE [dbo].[ctm__reports_logReport] @report_id, @parameter;", SQLConnection:=Intranet.Intranet_SqlCon, SqlParameterList:=spl)
' If sync = False Then
' Threading.Tasks.Task.Run(setSql)
' Else
' Call setSql()
' End If
' Catch ex As Exception
' OCMS.debug_log("fds_reports - LogReport", ex:=ex, data:=json.SerializeObject(New With {.report_id = ReportId}))
' End Try
' Return True
'End Function
'Public Sub SendReports(Optional ByVal ReportId As String = "")
' Dim Reports As New DataTable
' If ReportId = "" Then
' Reports = getSQLDatatable("EXECUTE [dbo].[fds__reports_getReports];", Intranet.Intranet_SqlCon)
' Else
' Reports = getSQLDatatable("EXECUTE [dbo].[ctm__reports_getSingleReport] @report_id;", Intranet.Intranet_SqlCon, New List(Of SqlClient.SqlParameter) From {New SqlClient.SqlParameter("@report_id", Long.Parse(ReportId))})
' End If
' If Reports.Rows.Count > 0 Then
' For Each rw As DataRow In Reports.Select("", "Time")
' Try
' Dim type As String = rw.nz("type", "")
' Dim report As String = rw.Item("report")
' ReportId = rw.Item("report_id")
' Dim parameter_str As String = rw.nz("parameter", "")
' Dim parameter_nvc As Specialized.NameValueCollection = If(parameter_str = "", New Specialized.NameValueCollection, json.DeserializeObject(Of NameValueCollection)(rw.Item("parameter")))
' Dim email_csv As String = rw.Item("recipients").Replace(";", ",")
' Select Case type
' Case "generic"
' Dim ctm_email As New ctm_email.ctm_email(email_csv.Split(","), subject:="CTM_Reporting: " & report, htmlbody:="")
' AddHandler ctm_email.DebugLogRequest, AddressOf OCMS.debug_logStandard
' AddHandler ctm_email.SentSuccess, Function() LogReport(ReportId:=ReportId, parameter:=parameter_str)
' 'AddHandler ctm_email.SentSuccess, Function() LogReport(ReportId:=ReportId)
' Dim hp As ocms_visualization.HtmlPage = ocms_visualization.renderQueryAsHtmlPage(report, report, ocms_visualization.queryTypes.generic, params:=parameter_nvc, destination:=ocms_visualization.destinationTypes.email, allowcache:=False)
' Dim html As String = hp.toString(destination:=ocms_visualization.destinationTypes.email)
' Dim ac As New MimeKit.AttachmentCollection()
' For Each imgcid In hp.LinkedImages.Keys
' 'There are guid-like id used by the html creation function, those need to be replaced by valid IDs as provided by email library
' Dim contentid As ctm_email.ctm_email.EmbeddedImageID = ctm_email.AddEmbeddedImage(ac.Add(hp.LinkedImages(imgcid).filename, hp.LinkedImages(imgcid).filecontent))
' html = html.Replace(imgcid, contentid.ID)
' Next
' ctm_email.AppendHtml(html)
' If Reports.Columns.Contains("attachment") Then
' Select Case (If(IsDBNull(rw.Item("attachment")), "", If(rw.Item("attachment"), "")).ToString.ToLower())
' Case "excel"
' Try
' Dim ADT As New DataTable, DList As New List(Of DataTable)
' Call ocms_visualization.GetQuery(report, parameter_nvc, ADT, DList)
' Dim xls As New ocms_Excel.SimpleExcel(report.Replace(" ", "_"), DList, "en")
' Dim xlscontent As Byte() = xls.toBytes()
' ctm_email.AddFile(xlscontent, report & "_" & Now.ToString("yyyyMMdd_HHmm") & ".xlsx")
' Catch ex As Exception
' Call OCMS.debug_log("fds_reports - SendReports generic excel", ex:=ex, data:=json.SerializeObject(rw))
' End Try
' End Select
' End If
' ctm_email.send(Sub() LogReport(ReportId:=ReportId, parameter:=parameter_str, sync:=True))
' Case "chart"
' Dim ctm_email As New ctm_email.ctm_email(email_csv.Split(","), subject:="CTM_Reporting: " & report, htmlbody:="")
' AddHandler ctm_email.DebugLogRequest, AddressOf OCMS.debug_logStandard
' AddHandler ctm_email.SentSuccess, Function() LogReport(ReportId:=ReportId, parameter:=parameter_str)
' 'AddHandler ctm_email.SentSuccess, Function() LogReport(ReportId:=ReportId)
' Dim chart As Byte() = ocms_visualization.renderQueryAsChart(report, ocms_visualization.queryTypes.generic)
' If IsNothing(chart) = False Then
' ctm_email.AppendHtml(ctm_email.AddEmbeddedImage("chart.png", chart).ImageHtml)
' ctm_email.send(Sub() LogReport(ReportId:=ReportId, parameter:=parameter_str, sync:=True))
' End If
' End Select
' Catch rex As Exception
' OCMS.debug_log("fds_reports - SendReports (loop)", ex:=rex, data:=json.SerializeObject(rw))
' End Try
' Next
' End If
'End Sub
'Public Sub SendNotifications()
' Dim ndt As DataTable = Nothing
' ndt = getSQLDatatable("EXECUTE [dbo].[ctm__admin_getNotifications];", Intranet.Intranet_SqlCon)
' If IsNothing(ndt) = False AndAlso ndt.Rows.Count > 0 Then
' For Each rw As DataRow In ndt.Rows
' Dim bdy As String = rw.nz("body", "")
' Dim ctm_email As New ctm_email.ctm_email(rw.nz("to_csv", "").ToString().Split(","), subject:="Fuchs DatenService: " & rw.nz("subject", ""), htmlbody:=If(left(bdy, 1) = "<", bdy, "<div>" & Web.HttpUtility.HtmlEncode(bdy) & "</div>"))
' ctm_email.send(Sub() Diagnostics.Debug.Print("success"))
' Next
' End If
'End Sub
Public ReloadSeconds As Integer = 60 * 10
Public Async Function process_fdsrequest(ByVal ctrl As Global.OCMS.intranet.Controllers.IntranetController_base, ByVal fnc As String, ByVal id As String) As Threading.Tasks.Task(Of ActionResult)
Dim parameter As RequestFormHandler = ctrl.Form()
parameter.SetValue("@authuser", ctrl.UserAccountID) 'overwrite also
Dim tgt_function As String = If(fnc <> "", fnc, parameter.Item("fnc", ReturnAlternative:=fnc)).Replace("gct", "generic_content")
Dim report As String = parameter.Item("report", ReturnAlternative:=If(id <> "", id, ""))
Dim Catalog As SQLDataTable = Await getSQLDatatable_async("EXECUTE [dbo].[fds__admin_getReportCatalog] @report_name, @authuser;", ctrl.Intranet.Intranet__SQLConnectionString, SqlParameterList:=New List(Of SqlClient.SqlParameter) From {New SqlClient.SqlParameter("@report_name", report), New SqlClient.SqlParameter("@authuser", ctrl.UserAccountID)})
Dim HtmlPage_TemplatePath As String = ctrl.ApplicationBaseDirectory().FullName.AppendIf("\") & "Content\FDS_Template.html"
Dim reportdic As Dictionary(Of String, Object) = Catalog.FirstRow.toObjectDictionary
Try
Select Case tgt_function
Case "generic_content"
Dim responseData = New With {.Date = DateTime.Now}
Dim ci_auth As Boolean = If(reportdic.ContainsKey("auth") AndAlso IsNothing(reportdic("auth")) = False AndAlso reportdic("auth").GetType() = GetType(Boolean), reportdic("auth"), True)
'Dim ci_refresh As Int16 = If(reportdic.ContainsKey("refresh") AndAlso IsNothing(reportdic("refresh")) = False AndAlso reportdic("refresh").GetType() = GetType(Int16), reportdic("refresh"), -2)
Dim ci_cache As Boolean = reportdic.ContainsKey("functions") AndAlso IsNothing(reportdic("functions")) = False AndAlso reportdic("functions").ToString().Split(",").Contains("cache")
Dim ci_forceReload As Boolean = parameter.Contains("cache") AndAlso parameter("cache").ToLower = "0"
If ci_cache = True Then
End If
Try
'create
If report = "" Then
Return New Mvc.HttpStatusCodeResult(Net.HttpStatusCode.Ambiguous, "No report defined")
Else
Dim DebugPrint As Action(Of Exception, String, String) = Sub(exs, ref, data)
Call OCMS.debug_log(ref, ex:=exs, data:=data)
End Sub
Dim hp As String = Await ocms_visualization.renderQueryAsHtml(report, report, ocms_visualization.queryTypes.generic, params:=parameter, AuthUserAccountID:=ctrl.UserAccountID, destination:=ocms_visualization.destinationTypes.content, templatePath:=HtmlPage_TemplatePath, context:=ctrl.HttpContext, allowcache:=ci_cache, forceReload:=ci_forceReload)
Return New Mvc.ContentResult() With {.Content = hp, .ContentType = "text/html", .ContentEncoding = Encoding.UTF8}
End If
Catch exi As Exception
Call OCMS.debug_log("process_fdsrequest generic", ex:=exi, data:=json.SerializeObject(parameter))
Return New Mvc.HttpStatusCodeResult(Net.HttpStatusCode.InternalServerError, "Bei der Bearbeitung der Anfrage ist ein Fehler aufgetreten.")
End Try
Case "generic"
Dim responseData = New With {.Date = DateTime.Now}
Dim ci_auth As Boolean = If(reportdic.ContainsKey("auth") AndAlso IsNothing(reportdic("auth")) = False AndAlso reportdic("auth").GetType() = GetType(Boolean), reportdic("auth"), True)
Dim ci_refresh As Int16 = If(reportdic.ContainsKey("refresh") AndAlso IsNothing(reportdic("refresh")) = False AndAlso reportdic("refresh").GetType() = GetType(Int16), reportdic("refresh"), -2)
Dim ci_cache As Boolean = reportdic.ContainsKey("functions") AndAlso IsNothing(reportdic("functions")) = False AndAlso reportdic("functions").ToString().Split(",").Contains("cache")
Dim ci_forceReload As Boolean = parameter.Contains("cache") AndAlso parameter("cache").ToLower = "0"
If ci_cache = True Then
End If
Try
'create
If report = "" Then
Return New Mvc.HttpStatusCodeResult(Net.HttpStatusCode.Ambiguous, "No report defined")
Else
Dim DebugPrint As Action(Of Exception, String, String) = Sub(exs, ref, data)
Call OCMS.debug_log(ref, ex:=exs, data:=data)
End Sub
Dim hp As ocms_visualization.HtmlPage = Await ocms_visualization.renderQueryAsHtml(report, report, ocms_visualization.queryTypes.generic, params:=parameter, AuthUserAccountID:=ctrl.UserAccountID, destination:=ocms_visualization.destinationTypes.web, templatePath:=HtmlPage_TemplatePath, context:=ctrl.HttpContext, allowcache:=ci_cache, forceReload:=ci_forceReload)
If parameter.Item("reload") <> "" Then
Dim ReloadSeconds As Integer
If Integer.TryParse(parameter("reload"), ReloadSeconds) = True Then
hp.ReloadSeconds = ReloadSeconds
End If
ElseIf ci_refresh > -2 Then
hp.ReloadSeconds = ci_refresh
ElseIf ReloadSeconds > 0 Then
hp.ReloadSeconds = ReloadSeconds
End If
If hp.QueryDuration > 180 AndAlso hp.ReloadSeconds > 0 AndAlso hp.ReloadSeconds < 3600 Then
hp.ReloadSeconds = 1200
ElseIf hp.QueryDuration > 60 AndAlso hp.ReloadSeconds > 0 AndAlso hp.ReloadSeconds < 1200 Then
hp.ReloadSeconds = 1200
End If
Return New Mvc.ContentResult() With {.Content = hp.toString(destination:=ocms_visualization.destinationTypes.web), .ContentType = "text/html", .ContentEncoding = Encoding.UTF8}
End If
Catch exi As Exception
Call OCMS.debug_log("process_fdsrequest generic", ex:=exi, data:=json.SerializeObject(parameter))
Return New Mvc.HttpStatusCodeResult(Net.HttpStatusCode.InternalServerError, "Bei der Bearbeitung der Anfrage ist ein Fehler aufgetreten.")
End Try
Case "chart"
Dim chart As Byte() = Await ocms_visualization.renderQueryAsChart(report, ocms_visualization.queryTypes.generic)
If IsNothing(chart) = False Then
Return New Mvc.FileContentResult(chart, "image/png") With {.FileDownloadName = report.Replace(" ", "_") & "_" & Now().ToString("yyyyMMdd_HHmm") & ".png"}
Else
Return New Mvc.HttpStatusCodeResult(Net.HttpStatusCode.InternalServerError, "Bei der Bearbeitung der Anfrage ist ein Fehler aufgetreten.")
End If
Case "xls"
Throw New NotImplementedException
'Try
' If report = "" Then
' Return New Mvc.HttpStatusCodeResult(Net.HttpStatusCode.Ambiguous, "No report defined")
' Else
' Dim ADT As New DataTable, DList As New List(Of DataTable)
' Call ocms_visualization.GetQuery(report, parameter, ADT, DList)
' Dim xls As New ctm_Excel.SimpleExcel(report.Replace(" ", "_"), DList, "en")
' Dim xlscontent As Byte() = xls.toBytes()
' If IsNothing(xlscontent) = False Then
' Return New Mvc.FileContentResult(xlscontent, "application/vnd.openxmlformats-officedocument.spreadsheetml.sheet") With {.FileDownloadName = report.Replace(" ", "_") & "_" & Now().ToString("yyyyMMdd_HHmm") & ".xlsx"}
' Else
' Return New Mvc.HttpStatusCodeResult(Net.HttpStatusCode.InternalServerError, "Bei der Bearbeitung der Anfrage ist ein Fehler aufgetreten.")
' End If
' End If
'Catch exi As Exception
' Call OCMS.debug_log("process_fdsrequest xls", ex:=exi, data:=json.SerializeObject(parameter))
' Return New Mvc.HttpStatusCodeResult(Net.HttpStatusCode.InternalServerError, "Bei der Bearbeitung der Anfrage ist ein Fehler aufgetreten.")
'End Try
Case Else
Dim responseData = New With {.Date = DateTime.Now}
Try
Dim querytype As ocms_visualization.queryTypes
If [Enum].TryParse(Of ocms_visualization.queryTypes)(fnc, querytype) = True Then
'create chart
If report = "" Then
Return New Mvc.HttpStatusCodeResult(Net.HttpStatusCode.Ambiguous, "No report defined")
Else
Dim hp As ocms_visualization.HtmlPage = Await ocms_visualization.renderQueryAsHtml(report, report, qtype:=querytype, params:=parameter, AuthUserAccountID:=ctrl.UserAccountID, destination:=ocms_visualization.destinationTypes.web, templatePath:=HtmlPage_TemplatePath, context:=ctrl.HttpContext)
If parameter.Item("reload") <> "" Then
Dim ReloadSeconds As Integer
If Integer.TryParse(parameter("reload"), ReloadSeconds) = True Then
hp.ReloadSeconds = ReloadSeconds
End If
ElseIf ReloadSeconds > 0 Then
hp.ReloadSeconds = ReloadSeconds
End If
If hp.QueryDuration > 180 AndAlso hp.ReloadSeconds > 0 AndAlso hp.ReloadSeconds < 3600 Then
hp.ReloadSeconds = 1200
ElseIf hp.QueryDuration > 60 AndAlso hp.ReloadSeconds > 0 AndAlso hp.ReloadSeconds < 1200 Then
hp.ReloadSeconds = 1200
End If
Return New Mvc.ContentResult() With {.Content = hp.toString(destination:=ocms_visualization.destinationTypes.web), .ContentType = "text/html", .ContentEncoding = Encoding.UTF8}
End If
Else
Return New Mvc.HttpStatusCodeResult(Net.HttpStatusCode.Ambiguous, "No report defined")
End If
Catch exi As Exception
Call OCMS.debug_log("process_fdsrequest else", ex:=exi, data:=json.SerializeObject(parameter))
Return New Mvc.HttpStatusCodeResult(Net.HttpStatusCode.InternalServerError, "Bei der Bearbeitung der Anfrage ist ein Fehler aufgetreten.")
End Try
End Select
Catch exo As Exception
Call OCMS.debug_log("process_fdsrequest outer", ex:=exo)
Return New Mvc.HttpStatusCodeResult(Net.HttpStatusCode.InternalServerError, "Bei der Bearbeitung der Anfrage ist ein Fehler aufgetreten.")
End Try
End Function
End Module
End Namespace
Intranet_Legacy/code/fuchs_services.vb
+182
View File
@@ -0,0 +1,182 @@
Imports OCMS
Namespace Global.Fuchs.intranet.services
Public Module WeatherCom
Public Async Function GetWeather(ByVal CityCode As String) As Threading.Tasks.Task(Of ContiDateDataDic)
Dim WeatherData As New ContiDateDataDic(7, 3)
Try
'returndic.Add("date", Format(tgtDateTime, SO_Tools.DateTime_Tools.GetDateFormat(SO_Tools.DateTime_Tools.DateFormat.ISO_DateTime_long)))
Dim APIKey As String = "1a5b6bd10406dad7d4159f2001a90bdb"
Dim ProjektName As String = "scheduler"
Dim IconBaseUrl As String = "https://cs3.wettercomassets.com/wcomv5/images/icons/weather/d_" '"http://ls1.wetter.com/img/icons/weather/small/d_"
Dim IconBaseExt As String = ".svg" '"_S.png"
Dim Authstring As String = ProjektName & APIKey & CityCode
Dim iMD5 As System.Security.Cryptography.MD5 = System.Security.Cryptography.MD5.Create()
Dim data = iMD5.ComputeHash(Encoding.UTF8.GetBytes(Authstring))
Dim sb As New StringBuilder()
Array.ForEach(data, Function(x) sb.Append(x.ToString("X2")))
Dim AuthCode As String = sb.ToString().ToLower
Dim TgtURL = "http://api.wetter.com/forecast/weather/city/" & CityCode & "/project/" & ProjektName & "/cs/" & AuthCode
Dim responseText As String = Await GetWebResponse(TgtURL)
Dim xmlDocument As New System.Xml.XmlDocument()
xmlDocument.LoadXml(responseText)
Dim root As System.Xml.XmlElement = xmlDocument.DocumentElement
For Each E As System.Xml.XmlElement In root.SelectNodes("//time")
Dim elementdic As New Global.OCMS.ocms_dictionaries.GenericStringDictionary
Dim localTime As Date = Date.ParseExact(E.SelectSingleNode("dhl").InnerText, "yyyy\-MM\-dd HH\:mm", New Globalization.CultureInfo("de")) 'lokale Zeit ISO 8601
Dim validTimespan As Integer = E.SelectSingleNode("p").InnerText
Dim statuscode As String = E.SelectSingleNode("w").InnerText
Dim statustext As String = E.SelectSingleNode("w_txt").InnerText
Dim T_Min As String = E.SelectSingleNode("tn").InnerText
Dim T_Max As String = E.SelectSingleNode("tx").InnerText
Dim W_angle As String = E.SelectSingleNode("wd").InnerText
Dim W_dir As String = E.SelectSingleNode("wd_txt").InnerText
Dim W_v As String = E.SelectSingleNode("ws").InnerText
Dim rainProb As String = E.SelectSingleNode("pc").InnerText
With elementdic
.Add("localdate", localTime.ToString("yyyy\-MM\-ddTHH\:mm\:ss", New Globalization.CultureInfo("de")))
.Add("valid", validTimespan)
.Add("valid_hours", "(" & localTime.ToString("HH") & " - " & localTime.AddHours(validTimespan).ToString("HH") & " h)")
.Add("t_min", T_Min & " °C")
.Add("t_max", T_Max & " °C")
.Add("t_min_rw", T_Min)
.Add("t_max_rw", T_Max)
.Add("rain", rainProb & " %")
.Add("wind", W_v & " km/h")
.Add("wind_angle", W_angle & "°")
.Add("wind_dir", W_dir)
.Add("status", statuscode)
.Add("status_txt", statustext)
.Add("credit_text", root.SelectSingleNode("//credit/text").InnerText)
.Add("credit_link", root.SelectSingleNode("//credit/link").InnerText)
.Add("icon_url_s", IconBaseUrl & left(statuscode, 1) & IconBaseExt)
.Add("icon_url_m", IconBaseUrl.Replace("small", "medium") & left(statuscode, 1) & IconBaseExt.Replace("S", "M"))
.Add("icon_url_l", IconBaseUrl.Replace("small", "large") & left(statuscode, 1) & IconBaseExt.Replace("S", "L"))
End With
WeatherData.Add(localTime, elementdic)
Next
Return WeatherData
Catch ex As Exception
Debug.Print("Shared_VM_SvcTools GetWeather", ex, Nothing, False)
Return WeatherData
End Try
End Function
End Module
Public Module svc
'Public Async Function getGermanHolidays(Ctrl As Global.OCMS.ocms_ClientController) As Threading.Tasks.Task(Of Mvc.ActionResult)
' Dim Startyear As Integer, Endyear As Integer
' If Integer.TryParse(Ctrl.Form("start"), Startyear) = True AndAlso Integer.TryParse(Ctrl.Form("end"), Endyear) = True Then
' Try
' Return Await JSONAsync(Await getGermanHolidays(Startyear:=Startyear, Endyear:=Endyear))
' Catch ex As Exception
' End Try
' Else
' Return New OCMS_HttpStatusCodeResult(Net.HttpStatusCode.BadRequest, Internal_Code:=OCMS_StatusCodes.inputmissing)
' End If
' 'if function reaches this point, an exception happened
' Return New OCMS_HttpStatusCodeResult(Net.HttpStatusCode.InternalServerError, Internal_Code:=OCMS_StatusCodes.exception)
'End Function
'Public Async Function getGermanHolidays(Startyear As Integer, Endyear As Integer) As Threading.Tasks.Task(Of String)
' Dim dic As New Dictionary(Of String, String)
' Dim tgtState As String = "NW"
' For yr As Integer = Startyear To Endyear
' Dim req As Net.HttpWebRequest = Net.HttpWebRequest.Create(My.Settings.FeiertageAPI_Url & "?jahr=" & yr.ToString) ' & "&nur_land=" & tgtState)
' Using res As Net.HttpWebResponse = Await req.GetResponseAsync()
' Using reader As New System.IO.StreamReader(res.GetResponseStream())
' Dim responsecontent As String = reader.ReadToEnd
' Dim d As Dictionary(Of String, Dictionary(Of String, Dictionary(Of String, String))) = Newtonsoft.Json.JsonConvert.DeserializeObject(responsecontent, GetType(Dictionary(Of String, Dictionary(Of String, Dictionary(Of String, String)))))
' If d.ContainsKey(tgtState) = True Then
' Dim stateDic As Dictionary(Of String, Dictionary(Of String, String)) = d(tgtState)
' For Each ky As String In stateDic.Keys
' Dim di As Dictionary(Of String, String) = stateDic(ky)
' dic.Add(di("datum").Replace("-", ""), ky)
' Next
' End If
' End Using
' End Using
' Next
' Return Newtonsoft.Json.JsonConvert.SerializeObject(dic)
'End Function
End Module
Public Class ContiDateDataDic
Inherits SortedDictionary(Of Date, Global.OCMS.ocms_dictionaries.GenericStringDictionary)
Private _timespan As Integer
Private _validHours As Integer
Public Sub New(timespan As Integer, validHours As Integer)
_timespan = timespan
_validHours = validHours
End Sub
Public Shadows Sub Add(key As Date, value As Global.OCMS.ocms_dictionaries.GenericStringDictionary)
If Not value.ContainsKey("DateCreated") Then value.Add("DateCreated", Now())
If Not value.ContainsKey("DateValid") Then value.Add("DateValid", DateAdd(DateInterval.Hour, (_validHours), Now()))
If Me.ContainsKey(key) Then Me.Remove(key)
MyBase.Add(key, value)
Call ClearOldValues()
End Sub
Public Sub ClearOldValues()
For Each ky As Date In Me.Keys
If ky < DateAdd(DateInterval.Day, (_timespan * -1), Now) Then
Me.Remove(ky)
End If
Next
End Sub
Public Function GetValidItem(TgtDate As Date) As Global.OCMS.ocms_dictionaries.GenericStringDictionary
Dim Ret As New Global.OCMS.ocms_dictionaries.GenericStringDictionary
Try
For Each ky As Date In Me.Keys
If ky > TgtDate And DateDiff(DateInterval.Hour, TgtDate, ky) <= 12 Then
Ret = Me.Item(ky)
Exit For
ElseIf ky > TgtDate Then
Exit For
ElseIf ky <= TgtDate And DateAdd(DateInterval.Hour, CInt(Me.Item(ky)("valid")), ky) > TgtDate Then
Ret = Me.Item(ky)
Exit For
End If
Next
Catch ex As Exception
Debug.Print("ContiDateDataDic GetvalidItem", ex, TgtDate.ToString, Nothing)
End Try
Return Ret
End Function
Public Function getNextValid(TgtDate As Date, NextCount As Byte) As SortedDictionary(Of Date, Global.OCMS.ocms_dictionaries.GenericStringDictionary)
Dim returndic As New SortedDictionary(Of Date, Global.OCMS.ocms_dictionaries.GenericStringDictionary)
For Each ky As Date In Me.Keys
If ky > TgtDate And returndic.Count < NextCount Then
returndic.Add(ky, Me.Item(ky))
End If
Next
Return returndic
End Function
End Class
End Namespace
Intranet_Legacy/code/fucns_ocms_intranet_banking.vb
+89
View File
@@ -0,0 +1,89 @@
Option Explicit On
Imports System.Threading.Tasks
Imports OCMS
Imports OCMS.intranet
Imports OCMS.SQLHandling
Imports njson = Newtonsoft.Json.JsonConvert
Namespace Global.OCMS.intranet.Controllers
Partial Public Class IntranetController
Private Async Function Do_Process_Bankings(fn As String, id As String, code As String) As Task(Of ActionResult)
Dim Action As ActionResult = Nothing
Select Case id.ToLower
Case "auth"
Action = Await JSONAsync(New With {.manage = 1})
Case "up"
For f As Integer = 0 To Me.Request.Files.Count - 1
Dim fle As HttpPostedFileWrapper = Me.Request.Files(f), SchemaDatatable = (Await getSQLDatatable_async(" DECLARE @tmp [dbo].[fds__tt__bankingtransactions]; SELECT TOP(0) * FROM @tmp;", SqlConnectionString:=Me.FuchsIntranet.Intranet__SQLConnectionString, ApplySymmetricKey:=Me.Intranet.Intranet__sql_symmetric_key, options:=SQLOptBasic(fn, id, code, Me.Form))).DataTable
Dim tbl As DataTable = Global.Fuchs.intranet.banking.parseToDatatable(stream:=fle.InputStream, SchemaDatatable:=SchemaDatatable)
Dim dtwa As New DatatableWriterAsync(tbl, Global.Fuchs.intranet.fuchs_ocms_intranet.Intranet.Intranet__SQLConnectionString)
Dim tmptbl As String = "bs_" & Guid.NewGuid().ToString.ToLower.Replace("-", "")
dtwa.CommandAfterError = New SqlClient.SqlCommand("Select * INTO [" & tmptbl & "] FROM " & dtwa.DestinationTableName & ";")
dtwa.CommandAfter = New SqlClient.SqlCommand("EXECUTE [dbo].[fds__merge_bankingtransactions] @tblname, @authuser;")
dtwa.CommandAfter.Parameters.AddRange(New SqlClient.SqlParameter() {New SqlClient.SqlParameter("@tblname", dtwa.DestinationTableName), SQL_VarChar("@authuser", Me.UserAccountID)})
AddHandler dtwa.OnError, Sub(sender As DatatableWriterAsync, exc As Exception, message As String)
Me.FuchsIntranet.debug_log("IntranetController._Do.bam.up - sql exception: ", ex:=exc, data:=New With {.uid = dtwa.InstanceGUID, .tmptbl = tmptbl})
End Sub
AddHandler dtwa.OnCommandAfterError, Sub(sender As DatatableWriterAsync, exc As Exception)
Me.FuchsIntranet.debug_log("IntranetController._Do.bam.up - sql exception command after: ", ex:=exc, data:=New With {.uid = dtwa.InstanceGUID, .tmptbl = tmptbl})
End Sub
Diagnostics.Debug.Print("bankingtransactions table: " & dtwa.DestinationTableName)
dtwa.DoSubmit()
Next
Action = New OKResult()
Case "qtl"
If Me.Form.CheckParams(StrA("mode")) = False Then Return New InputMissingResult()
'Dim tgtdate As Date
'If Date.TryParseExact(Me.Form("tgt"), "yy-MM-dd", Globalization.CultureInfo.InvariantCulture, System.Globalization.DateTimeStyles.AllowWhiteSpaces, tgtdate) = True Then
If 1 = 1 Then 'conditional fame kept just in case the date-parameter will be added at some point
Dim pl As ParamList = Me.StdParamlist(New SqlClient.SqlParameter() {SQL_VarChar("@mode", Me.Form("mode"))})
Dim sqldt As SQLDataSet = Await getSQLDataSet_async("EXECUTE [dbo].[fds__getBankingtransfers_questionable] @mode, @authuser;", Me.Intranet.Intranet__SQLConnectionString, SqlParameterList:=pl, ApplySymmetricKey:=Me.Intranet.Intranet__sql_symmetric_key, tablenames:=New String() {"admin", "transfers"}, options:=SQLOptBasic(fn, id, code, Me.Form))
Dim bsl As New List(Of Dictionary(Of String, Object))(sqldt.Tables("transfers").toArrayofObjectDictionaries())
Action = Await JSONAsync(New With {.admin = sqldt.Table("admin").FirstRow().toObjectDictionary(), .bs = bsl})
Else
Action = New InputMissingResult()
End If
Case "btl"
If Me.Form.CheckParams(StrA("mode")) = False Then Return New InputMissingResult()
Dim tgtdate As Date, mode As String = Me.Form("mode").ToLower
If mode = "s" AndAlso Me.Form("tgt").Contains(":") Then
Dim pl As ParamList = Me.StdParamlist(New SqlClient.SqlParameter() {SQL_date("@tgtdate", tgtdate), SQL_VarChar("@mode", Me.Form("mode").ne("m")), SQL_bit("@include_drafts", Me.Form("all"))})
pl.Add(SQL_VarChar("@search", Me.Form("tgt")))
Dim sqldt As SQLDataSet = Await getSQLDataSet_async("EXECUTE [dbo].[fds__getBankingtransfers_list2] @tgtdate, @mode, @search, @authuser;", Me.Intranet.Intranet__SQLConnectionString, SqlParameterList:=pl, ApplySymmetricKey:=Me.Intranet.Intranet__sql_symmetric_key, tablenames:=New String() {"admin", "bank"}, options:=SQLOptBasic(fn, id, code, Me.Form))
Action = Await JSONAsync(New With {.admin = sqldt.Table("admin").FirstRow().toObjectDictionary(), .bank = sqldt.Tables("bank").toArrayofObjectDictionaries})
ElseIf Date.TryParseExact(Me.Form("tgt"), "yy-MM-dd", Globalization.CultureInfo.InvariantCulture, System.Globalization.DateTimeStyles.AllowWhiteSpaces, tgtdate) = True Then
Dim pl As ParamList = Me.StdParamlist(New SqlClient.SqlParameter() {SQL_date("@tgtdate", tgtdate), SQL_VarChar("@mode", Me.Form("mode").ne("m")), SQL_VarChar("@includes", Me.Form("includes").ne(If(Me.Form("all") = "true", "all", "")))})
Dim sqldt As SQLDataSet = Await getSQLDataSet_async("EXECUTE [dbo].[fds__getBankingtransfers_list] @tgtdate, @mode, @authuser;", Me.Intranet.Intranet__SQLConnectionString, SqlParameterList:=pl, ApplySymmetricKey:=Me.Intranet.Intranet__sql_symmetric_key, tablenames:=New String() {"admin", "bank"}, options:=SQLOptBasic(fn, id, code, Me.Form))
Action = Await JSONAsync(New With {.admin = sqldt.Table("admin").FirstRow().toObjectDictionary(), .bank = sqldt.Tables("bank").toArrayofObjectDictionaries})
Else
Action = New InputMissingResult()
End If
Case "smd"
If Me.Form.CheckParams(StrA("taid")) = False Then Return New InputMissingResult()
Dim pl As ParamList = Me.StdParamlist(SQL_VarChar("@taID", Me.Form("taid"), dbNull_IfEmpty:=True))
Dim res As SQLObject = Await getSQLValue_async("EXECUTE [dbo].[fds__setBankingtransaction_done] @taID, @authuser;", Me.Intranet.Intranet__SQLConnectionString, SqlParameterList:=pl, ApplySymmetricKey:=Me.Intranet.Intranet__sql_symmetric_key, options:=SQLOptBasic(fn, id, code, Me.Form))
Action = If(IsNothing(res.Result) = False AndAlso res.Result.GetType = GetType(Boolean) AndAlso res.Result = True, New OKResult, New ExceptionResult("not successful", OCMS_StatusCodes.exception))
Case "ati"
If Me.Form.CheckParams(StrA("taid", "iid")) = False Then Return New InputMissingResult()
Dim pl As ParamList = Me.StdParamlist(SQL_VarChar("@taid", Me.Form("taid"), dbNull_IfEmpty:=True), SQL_VarChar("@invoice_id", Me.Form("iid"), dbNull_IfEmpty:=True))
Dim res As SQLObject = Await getSQLValue_async("EXECUTE [dbo].[fds__setBankingtransaction_assignToIvoice] @taID, @invoice_id, @authuser;", Me.Intranet.Intranet__SQLConnectionString, SqlParameterList:=pl, ApplySymmetricKey:=Me.Intranet.Intranet__sql_symmetric_key, options:=SQLOptBasic(fn, id, code, Me.Form))
Action = If(IsNothing(res.Result) = False AndAlso res.Result.GetType = GetType(Boolean) AndAlso res.Result = True, New OKResult, New ExceptionResult("not successful", OCMS_StatusCodes.exception))
Case "vfi"
If Me.Form.CheckParams(StrA("invid")) = False Then Return New InputMissingResult()
Dim pl As ParamList = Me.StdParamlist(SQL_VarChar("@InvoiceId", Me.Form("invid"), dbNull_IfEmpty:=True))
Dim res As SQLDataTable = Await getSQLDatatable_async("Select [Id], [InvoiceId], [SendToAddress] FROM [dbo].[fds__invoices] WHERE [InvoiceId] Like ('%' + @InvoiceId) AND [InvoiceId] is not null AND [DateFinalized] is not null;", Me.Intranet.Intranet__SQLConnectionString, SqlParameterList:=pl, ApplySymmetricKey:=Me.Intranet.Intranet__sql_symmetric_key, options:=SQLOptBasic(fn, id, code, Me.Form))
Action = Await JSONAsync(res.DataTable.toArrayofObjectDictionaries)
End Select
Return Action
End Function
End Class
End Namespace
Intranet_Legacy/code/fucns_ocms_intranet_reports.vb
+40
View File
@@ -0,0 +1,40 @@
Option Explicit On
Imports System.Threading.Tasks
Imports OCMS
Imports OCMS.intranet
Imports OCMS.SQLHandling
Imports njson = Newtonsoft.Json.JsonConvert
Namespace Global.OCMS.intranet.Controllers
Partial Public Class IntranetController
Private Async Function Do_Process_Reports(fn As String, id As String, code As String) As Task(Of ActionResult)
Dim Action As ActionResult = Nothing
Select Case id.ToLower
Case "auth"
Action = Await JSONAsync(New With {.manage = 1})
Case "catalog"
Dim pl As ParamList = Me.StdParamlist(SQL_VarChar("@report_name", Me.Form("report"), dbNull_IfEmpty:=True))
Dim dset As SQLDataSet = Await getSQLDataSet_async("EXECUTE [dbo].[fds__admin_getReportCatalog] @report_name, @authuser;", Me.Intranet.Intranet__SQLConnectionString, SqlParameterList:=pl, ApplySymmetricKey:=Me.Intranet.Intranet__sql_symmetric_key, tablenames:=New String() {"reports", "params", "categories", "tags"}, options:=SQLOptBasic(fn, id, code, Me.Form))
Dim reps As Dictionary(Of String, Object)() = dset.Tables("reports").toArrayofObjectDictionaries()
For Each ri As Dictionary(Of String, Object) In reps
Dim params As Dictionary(Of String, Object)() = New Dictionary(Of String, Object)() {}
Try
params = dset.Tables("params").toArrayofObjectDictionaries(selectstring:="[object_id] = " & ri("object_id") & " AND [name] <> '@authuser'")
Finally
ri.Add("params", params)
End Try
Next
Return Await JSONAsync(New With {.reports = reps, .categories = dset.Tables("categories").toArrayofObjectDictionaries(), .tags = dset.Tables("tags").toArrayofObjectDictionaries()})
Case Else
Action = Await Global.Fuchs.intranet.fuchs_reports.process_fdsrequest(Me, id.ToLower, id:=code)
End Select
Return Action
End Function
End Class
End Namespace
Intranet_Legacy/code/migradoc_Extensions.vb
+118
View File
@@ -0,0 +1,118 @@
Imports MigraDoc.DocumentObjectModel
Imports cs = System.Runtime.CompilerServices
Imports System
Imports System.Collections.Generic
Namespace Global.MigraDoc.Extensions.Html
Public Module Extensions
<cs.Extension()>
Public Function AddHtml(ByVal section As Section, ByVal html As String) As Section
Return section.Add(html, New HtmlConverter())
End Function
<cs.Extension()>
Public Function AddHtml(ByVal cell As MigraDoc.DocumentObjectModel.Tables.Cell, ByVal html As String) As Tables.Cell
Return cell.Add(html, New HtmlConverter())
End Function
<cs.Extension()>
Public Function AddHtml(ByVal cell As Shapes.TextFrame, ByVal html As String) As Shapes.TextFrame
Return cell.Add(html, New HtmlConverter())
End Function
End Module
End Namespace
Namespace Global.MigraDoc.Extensions
Public MustInherit Class IConverter
Public MustOverride Function Convert(ByVal contents As String) As Action(Of Section)
Public MustOverride Function ConvertTextFrame(ByVal contents As String) As Action(Of Shapes.TextFrame)
Public MustOverride Function ConvertCell(ByVal contents As String) As Action(Of MigraDoc.DocumentObjectModel.Tables.Cell)
End Class
Public Module Extensions
<cs.Extension()>
Public Function Add(ByVal cell As MigraDoc.DocumentObjectModel.Tables.Cell, ByVal contents As String, ByVal converter As IConverter) As MigraDoc.DocumentObjectModel.Tables.Cell
If String.IsNullOrEmpty(contents) Then
Throw New ArgumentNullException("contents")
End If
If converter Is Nothing Then
Throw New ArgumentNullException("converter")
End If
Dim addAction As Action(Of MigraDoc.DocumentObjectModel.Tables.Cell) = converter.ConvertCell(contents)
addAction(cell)
Return cell
End Function
<cs.Extension()>
Public Function Add(ByVal frame As Shapes.TextFrame, ByVal contents As String, ByVal converter As IConverter) As Shapes.TextFrame
If String.IsNullOrEmpty(contents) Then
Throw New ArgumentNullException("contents")
End If
If converter Is Nothing Then
Throw New ArgumentNullException("converter")
End If
Dim addAction As Action(Of Shapes.TextFrame) = converter.ConvertTextFrame(contents)
addAction(frame)
Return frame
End Function
<cs.Extension()>
Public Function Add(ByVal section As Section, ByVal contents As String, ByVal converter As IConverter) As Section
If String.IsNullOrEmpty(contents) Then
Throw New ArgumentNullException("contents")
End If
If converter Is Nothing Then
Throw New ArgumentNullException("converter")
End If
Dim addAction As Action(Of Section) = converter.Convert(contents)
addAction(section)
Return section
End Function
<cs.Extension()>
Public Function SetStyle(ByVal paragraph As Paragraph, ByVal style As String) As Paragraph
If paragraph Is Nothing Then
Throw New ArgumentNullException("paragraph")
End If
If String.IsNullOrEmpty(style) Then
Throw New ArgumentNullException("style")
End If
paragraph.Style = style
Return paragraph
End Function
End Module
Public Module FormattedTextExtensions
Private formats As Dictionary(Of TextFormat, Action(Of FormattedText)) = New Dictionary(Of TextFormat, Action(Of FormattedText)) From {
{TextFormat.Bold, Sub(text) text.Bold = True},
{TextFormat.NotBold, Sub(text) text.Bold = False},
{TextFormat.Italic, Sub(text) text.Italic = True},
{TextFormat.NotItalic, Sub(text) text.Italic = False},
{TextFormat.Underline, Sub(text) text.Underline = Underline.[Single]},
{TextFormat.NoUnderline, Sub(text) text.Underline = Underline.None}
}
<cs.Extension()>
Public Function Format(ByVal formattedText As FormattedText, ByVal textFormat As TextFormat) As FormattedText
If formattedText Is Nothing Then
Throw New ArgumentNullException("formattedText")
End If
Dim formatter As Action(Of FormattedText) = Nothing
If formats.TryGetValue(textFormat, formatter) Then
formatter(formattedText)
End If
Return formattedText
End Function
End Module
End Namespace
Intranet_Legacy/code/migradoc_HtmlConverter.vb
+252
View File
@@ -0,0 +1,252 @@
Imports HtmlAgilityPack
Imports MigraDoc.DocumentObjectModel
Imports System
Imports System.Collections.Generic
Imports System.Net
Imports System.Linq
Imports MigraDoc.Extensions
Namespace Global.MigraDoc.Extensions.Html
Public Class HtmlConverter
Inherits IConverter
Private nodeHandlersField As IDictionary(Of String, Func(Of HtmlNode, DocumentObject, DocumentObject)) = New Dictionary(Of String, Func(Of HtmlNode, DocumentObject, DocumentObject))()
Public Sub New()
AddDefaultNodeHandlers()
End Sub
Public ReadOnly Property NodeHandlers As IDictionary(Of String, Func(Of HtmlNode, DocumentObject, DocumentObject))
Get
Return nodeHandlersField
End Get
End Property
Public Overrides Function Convert(ByVal contents As String) As Action(Of Section)
Return Sub(section As Section) Me.ConvertHtml(contents, section)
End Function
Public Overrides Function ConvertTextFrame(ByVal contents As String) As Action(Of Shapes.TextFrame)
Return Sub(frame As Shapes.TextFrame) Me.ConvertHtml(contents, frame)
End Function
Public Overrides Function ConvertCell(ByVal contents As String) As Action(Of MigraDoc.DocumentObjectModel.Tables.Cell)
Return Sub(cell As Tables.Cell) Me.ConvertHtml(contents, cell)
End Function
Private Overloads Sub ConvertHtml(ByVal html As String, ByVal section As Section)
If String.IsNullOrEmpty(html) Then
Throw New ArgumentNullException("html")
ElseIf section Is Nothing Then
Throw New ArgumentNullException("section")
End If
Dim doc As New HtmlDocument()
doc.LoadHtml(html)
ConvertHtmlNodes(doc.DocumentNode.ChildNodes, section)
End Sub
Private Overloads Sub ConvertHtml(ByVal html As String, ByVal cell As Tables.Cell)
If String.IsNullOrEmpty(html) Then
Throw New ArgumentNullException("html")
ElseIf cell Is Nothing Then
Throw New ArgumentNullException("cell")
End If
Dim doc As New HtmlDocument()
doc.LoadHtml(html)
ConvertHtmlNodes(doc.DocumentNode.ChildNodes, cell)
End Sub
Private Overloads Sub ConvertHtml(ByVal html As String, ByVal frame As Shapes.TextFrame)
If String.IsNullOrEmpty(html) Then
Throw New ArgumentNullException("html")
ElseIf frame Is Nothing Then
Throw New ArgumentNullException("frame")
End If
Dim doc As New HtmlDocument()
doc.LoadHtml(html)
ConvertHtmlNodes(doc.DocumentNode.ChildNodes, frame)
End Sub
Private Sub ConvertHtmlNodes(ByVal nodes As HtmlNodeCollection, ByRef section As DocumentObject, ByVal Optional current As DocumentObject = Nothing)
For Each node In nodes
Dim nodeHandler As Func(Of HtmlNode, DocumentObject, DocumentObject) = Nothing
If nodeHandlersField.TryGetValue(node.Name, nodeHandler) Then
' pass the current container or section
Dim result = nodeHandler(node, If(current, section))
If IsNothing(result) = False AndAlso node.HasChildNodes Then
ConvertHtmlNodes(node.ChildNodes, section, result)
End If
Else
If node.HasChildNodes Then
ConvertHtmlNodes(node.ChildNodes, section, current)
End If
End If
Next
End Sub
Private Sub AddDefaultNodeHandlers()
' Block Elements
' could do with a predicate/regex matcher so we could just use one handler for all headings
nodeHandlersField.Add("h1", New Func(Of HtmlNode, DocumentObject, DocumentObject)(AddressOf HtmlConverter.AddHeading))
nodeHandlersField.Add("h2", New Func(Of HtmlNode, DocumentObject, DocumentObject)(AddressOf HtmlConverter.AddHeading))
nodeHandlersField.Add("h3", New Func(Of HtmlNode, DocumentObject, DocumentObject)(AddressOf HtmlConverter.AddHeading))
nodeHandlersField.Add("h4", New Func(Of HtmlNode, DocumentObject, DocumentObject)(AddressOf HtmlConverter.AddHeading))
nodeHandlersField.Add("h5", New Func(Of HtmlNode, DocumentObject, DocumentObject)(AddressOf HtmlConverter.AddHeading))
nodeHandlersField.Add("h6", New Func(Of HtmlNode, DocumentObject, DocumentObject)(AddressOf HtmlConverter.AddHeading))
nodeHandlersField.Add("p", Function(node As HtmlNode, parent As DocumentObject) If(parent.GetType() = GetType(Tables.Cell), CType(parent, Tables.Cell).AddParagraph(), CType(parent, Section).AddParagraph()))
' Inline Elements
nodeHandlersField.Add("strong", Function(node As HtmlNode, parent As DocumentObject) AddFormattedText(node, parent, TextFormat.Bold))
nodeHandlersField.Add("i", Function(node As HtmlNode, parent As DocumentObject) AddFormattedText(node, parent, TextFormat.Italic))
nodeHandlersField.Add("em", Function(node As HtmlNode, parent As DocumentObject) AddFormattedText(node, parent, TextFormat.Italic))
nodeHandlersField.Add("u", Function(node As HtmlNode, parent As DocumentObject) AddFormattedText(node, parent, TextFormat.Underline))
nodeHandlersField.Add("a", Function(node As HtmlNode, parent As DocumentObject) HtmlConverter.GetParagraph(parent).AddHyperlink(node.GetAttributeValue("href", ""), HyperlinkType.Web))
nodeHandlersField.Add("hr", Function(node As HtmlNode, parent As DocumentObject) HtmlConverter.GetParagraph(parent).SetStyle("HorizontalRule"))
nodeHandlersField.Add("br", Function(node As HtmlNode, parent As DocumentObject)
If TypeOf parent Is FormattedText Then
' inline elements can contain line breaks
CType(parent, FormattedText).AddLineBreak()
Return parent
End If
Dim paragraph As Paragraph = HtmlConverter.GetParagraph(parent)
If IsNothing(paragraph) = False Then
paragraph.AddLineBreak()
End If
Return paragraph
End Function)
nodeHandlersField.Add("li", Function(node As HtmlNode, parent As DocumentObject)
Dim listStyle As String = If(node.ParentNode.Name Is "ul", "UnorderedList", "OrderedList")
If parent.GetType() = GetType(Tables.Cell) Then
Dim cell As Tables.Cell = CType(parent, Tables.Cell)
Dim isFirst As Boolean = node.ParentNode.Elements("li").First() Is node
Dim isLast As Boolean = node.ParentNode.Elements("li").Last() Is node
' if this is the first item add the ListStart paragraph
If isFirst Then
cell.AddParagraph().SetStyle("ListStart")
End If
Dim listItem As Paragraph = cell.AddParagraph().SetStyle(listStyle)
' disable continuation if this is the first list item
listItem.Format.ListInfo.ContinuePreviousList = Not isFirst
' if the this is the last item add the ListEnd paragraph
If isLast Then
cell.AddParagraph().SetStyle("ListEnd")
End If
Return listItem
ElseIf parent.GetType() = GetType(Shapes.TextFrame) Then
Dim frame As Shapes.TextFrame = CType(parent, Shapes.TextFrame)
Dim isFirst As Boolean = node.ParentNode.Elements("li").First() Is node
Dim isLast As Boolean = node.ParentNode.Elements("li").Last() Is node
' if this is the first item add the ListStart paragraph
If isFirst Then
frame.AddParagraph().SetStyle("ListStart")
End If
Dim listItem As Paragraph = frame.AddParagraph().SetStyle(listStyle)
' disable continuation if this is the first list item
listItem.Format.ListInfo.ContinuePreviousList = Not isFirst
' if the this is the last item add the ListEnd paragraph
If isLast Then
frame.AddParagraph().SetStyle("ListEnd")
End If
Return listItem
Else
Dim section As Section = CType(parent, Section)
Dim isFirst As Boolean = node.ParentNode.Elements("li").First() Is node
Dim isLast As Boolean = node.ParentNode.Elements("li").Last() Is node
' if this is the first item add the ListStart paragraph
If isFirst Then
section.AddParagraph().SetStyle("ListStart")
End If
Dim listItem As Paragraph = section.AddParagraph().SetStyle(listStyle)
' disable continuation if this is the first list item
listItem.Format.ListInfo.ContinuePreviousList = Not isFirst
' if the this is the last item add the ListEnd paragraph
If isLast Then
section.AddParagraph().SetStyle("ListEnd")
End If
Return listItem
End If
End Function)
nodeHandlersField.Add("#text", Function(node As HtmlNode, parent As DocumentObject)
' remove line breaks
Dim innerText As String = node.InnerText.Replace(vbCr, "").Replace(vbLf, "")
If String.IsNullOrWhiteSpace(innerText) Then
Return parent
End If
' decode escaped HTML
innerText = WebUtility.HtmlDecode(innerText)
' text elements must be wrapped in a paragraph but this could also be FormattedText or a Hyperlink!!
' this needs some work
If TypeOf parent Is FormattedText Then
Return CType(parent, FormattedText).AddText(innerText)
End If
If TypeOf parent Is Hyperlink Then
Return CType(parent, Hyperlink).AddText(innerText)
End If
' otherwise a section or paragraph
Return HtmlConverter.GetParagraph(parent).AddText(innerText)
End Function)
End Sub
Private Shared Function AddFormattedText(ByVal node As HtmlNode, ByVal parent As DocumentObject, ByVal format As TextFormat) As DocumentObject
Dim formattedText As FormattedText = TryCast(parent, FormattedText)
If formattedText IsNot Nothing Then
Return formattedText.Format(format)
End If
' otherwise parent is paragraph or section
Return HtmlConverter.GetParagraph(parent).AddFormattedText(format)
End Function
Private Shared Function AddHeading(ByVal node As HtmlNode, ByVal parent As DocumentObject) As DocumentObject
If parent.GetType() = GetType(Tables.Cell) Then
Return CType(parent, Tables.Cell).AddParagraph().SetStyle("Heading" & node.Name(1))
Else : Return CType(parent, Section).AddParagraph().SetStyle("Heading" & node.Name(1))
End If
End Function
Private Shared Function GetParagraph(ByVal parent As DocumentObject) As Paragraph
If parent.GetType() = GetType(Tables.Cell) Then
Return CType(parent, Tables.Cell).AddParagraph()
ElseIf parent.GetType() = GetType(Paragraph) Then
Return parent
ElseIf parent.GetType() = GetType(Section) Then
Return CType(parent, Section).AddParagraph()
Else
Return Nothing
End If
End Function
Private Shared Function AddParagraphWithStyle(ByVal parent As DocumentObject, ByVal style As String) As Paragraph
If parent.GetType() = GetType(Tables.Cell) Then
Return CType(parent, Tables.Cell).AddParagraph().SetStyle(style)
Else : Return CType(parent, Section).AddParagraph().SetStyle(style)
End If
End Function
End Class
End Namespace