Files
AVISO/Aviso/frmSendungsDokumentanforderung.vb
2026-03-26 16:43:27 +01:00

1437 lines
66 KiB
VB.net

Imports System.Configuration
Imports System.IO
Imports System.Net
Imports System.Net.Mail
Imports System.Text
Imports Newtonsoft.Json
Imports Newtonsoft.Json.Linq
Imports VERAG_PROG_ALLGEMEIN
Imports AVISO.AvisoStatusFunctions
Public Class frmSendungsDokumentanforderung
Private ReadOnly AvisoDAL As New cAvisoDAL
Private ReadOnly _admin As New cADMIN
Public Property AvisoID As Integer
Public Property SendungID As Integer
Private ReadOnly _anforderungCheckboxes As New List(Of CheckBox)
Private ReadOnly _anhangsartIdByCheckbox As New Dictionary(Of CheckBox, Integer)
Private ReadOnly _backendBezeichnungByCodeId As New Dictionary(Of Integer, String)
Private ReadOnly _selectedAnhangsartIdByCodeId As New Dictionary(Of Integer, Integer)
Private ReadOnly _documentCustomNameByCodeId As New Dictionary(Of Integer, String)
Private ReadOnly _documentBaseTextByCodeId As New Dictionary(Of Integer, String)
Private ReadOnly _anhangsartenOptions As New List(Of AnhangsartOption)
Private ReadOnly _bereichByCodeId As New Dictionary(Of Integer, Integer)
Private _selectedDocumentCodeId As Integer
Private _isLoadingDocumentEditor As Boolean
Private Const DefaultDocumentBaseText As String = "Bitte das Dokument hochladen."
Private Const BereichDokumentMain As Integer = 1
Private Shared _customerPortalJwtToken As String = ""
Private Shared _customerPortalJwtExpUtc As DateTime = DateTime.MinValue
Private Shared _customerPortalAnhangsartenMap As Dictionary(Of String, Integer) = Nothing
Private Shared _customerPortalAnhangsartenFetchedUtc As DateTime = DateTime.MinValue
Private Shared _customerPortalCustomFilenameAnhangsartId As Integer = -1
Private ReadOnly _kontaktEmailRows As New List(Of KontaktEmailRow)
Private ReadOnly _kundenFirmaByNr As New Dictionary(Of Integer, String)
Private _kontaktRolleTabs As TabControl
Private _emailTemplates As DataTable
Public Sub New(ByVal avisoIdValue As Integer, ByVal sendungIdValue As Integer, state As DokumentanforderungState)
InitializeComponent()
AvisoID = avisoIdValue
SendungID = sendungIdValue
Icon = cMeineFunktionenAVISO.GetProgrammIcon
_stateToApply = If(state, New DokumentanforderungState())
End Sub
Private ReadOnly _stateToApply As DokumentanforderungState
Private Sub frmSendungsDokumentanforderung_Load(sender As Object, e As EventArgs) Handles MyBase.Load
ResolveContextIds()
VERAG_PROG_ALLGEMEIN.cAllgemein._TRANSLATE(Me)
If cmbCustomerUploadLanguage.SelectedIndex < 0 Then
Dim idx = cmbCustomerUploadLanguage.Items.IndexOf("de")
If idx >= 0 Then
cmbCustomerUploadLanguage.SelectedIndex = idx
ElseIf cmbCustomerUploadLanguage.Items.Count > 0 Then
cmbCustomerUploadLanguage.SelectedIndex = 0
End If
End If
InitializeDocumentEditor()
SetupDynamicAnforderungCheckboxes()
LoadEmailTemplates()
ApplyStateToUi(_stateToApply)
InitializeKontaktEmailGrid()
LoadKontaktEmails()
End Sub
Private Sub LoadEmailTemplates()
Try
Dim sql As String = "SELECT [txt_Id], [txt_bezeichnung], [txt_sprache], [txt_text] FROM [tblTextkonserve] WHERE txt_kategorie = 'FRM_DOKUMENTANFORDERUNG_MailText' ORDER BY [txt_bezeichnung], [txt_sprache]"
_emailTemplates = (New VERAG_PROG_ALLGEMEIN.SQL).loadDgvBySql(sql, "FMZOLL", 1000, True)
cmbCustomerUploadEmailTemplate.Items.Clear()
If _emailTemplates IsNot Nothing AndAlso _emailTemplates.Rows.Count > 0 Then
Dim bezeichnungen As New HashSet(Of String)()
For Each row As DataRow In _emailTemplates.Rows
Dim bezeichnung As String = If(IsDBNull(row("txt_bezeichnung")), "", CStr(row("txt_bezeichnung"))).Trim()
If bezeichnung <> "" AndAlso Not bezeichnungen.Contains(bezeichnung) Then
bezeichnungen.Add(bezeichnung)
cmbCustomerUploadEmailTemplate.Items.Add(bezeichnung)
End If
Next
End If
If cmbCustomerUploadEmailTemplate.Items.Count > 0 Then
cmbCustomerUploadEmailTemplate.SelectedIndex = 0
End If
Catch ex As Exception
' Fehler beim Laden ignorieren, Vorlagen bleiben leer
End Try
End Sub
Private Sub UpdateEmailText()
If _emailTemplates Is Nothing OrElse _emailTemplates.Rows.Count = 0 Then Return
Dim selectedTemplate = If(cmbCustomerUploadEmailTemplate.SelectedItem, "").ToString()
Dim selectedLang = If(cmbCustomerUploadLanguage.SelectedItem, "").ToString().ToLowerInvariant()
If selectedLang = "" Then selectedLang = "de"
If selectedTemplate <> "" Then
' Suche nach passender Vorlage und Sprache
Dim foundText As String = ""
For Each row As DataRow In _emailTemplates.Rows
Dim bezeichnung = If(IsDBNull(row("txt_bezeichnung")), "", CStr(row("txt_bezeichnung"))).Trim()
Dim sprache = If(IsDBNull(row("txt_sprache")), "", CStr(row("txt_sprache"))).Trim().ToLowerInvariant()
If String.Equals(bezeichnung, selectedTemplate, StringComparison.OrdinalIgnoreCase) Then
' Wenn wir die genaue Sprache finden, nimm diese
If String.Equals(sprache, selectedLang, StringComparison.OrdinalIgnoreCase) Then
foundText = If(IsDBNull(row("txt_text")), "", CStr(row("txt_text")))
Exit For
End If
' Fallback auf 'de' oder die erste gefundene Sprache, falls die gesuchte nicht existiert
If foundText = "" OrElse String.Equals(sprache, "de", StringComparison.OrdinalIgnoreCase) Then
foundText = If(IsDBNull(row("txt_text")), "", CStr(row("txt_text")))
End If
End If
Next
If foundText <> "" Then
txtCustomerUploadEmailText.Text = foundText.Replace("\n", vbCrLf)
End If
End If
End Sub
Private Sub cmbCustomerUploadEmailTemplate_SelectedIndexChanged(sender As Object, e As EventArgs) Handles cmbCustomerUploadEmailTemplate.SelectedIndexChanged
UpdateEmailText()
End Sub
Private Sub cmbCustomerUploadLanguage_SelectedIndexChanged(sender As Object, e As EventArgs) Handles cmbCustomerUploadLanguage.SelectedIndexChanged
UpdateEmailText()
End Sub
Private Sub ResolveContextIds()
If AvisoID > 0 AndAlso SendungID <> 0 Then Return
Dim parentForm = TryCast(Me.Owner, frmAddSendungsvermerkShort)
If parentForm IsNot Nothing Then
If AvisoID <= 0 AndAlso parentForm.AvisoID > 0 Then
AvisoID = parentForm.AvisoID
End If
If SendungID = 0 AndAlso parentForm.SendungID <> 0 Then
SendungID = parentForm.SendungID
End If
End If
End Sub
Private Sub InitializeKontaktEmailGrid()
EnsureKontaktRolleTabs()
If dgvKontaktEmails.Columns.Count > 0 Then Return
dgvKontaktEmails.AutoGenerateColumns = False
Dim colArt As New DataGridViewTextBoxColumn()
colArt.Name = "colArt"
colArt.HeaderText = "Art"
colArt.DataPropertyName = "Art"
colArt.Width = 130
dgvKontaktEmails.Columns.Add(colArt)
Dim colFirma As New DataGridViewTextBoxColumn()
colFirma.Name = "colFirma"
colFirma.HeaderText = "Firma"
colFirma.DataPropertyName = "Firma"
colFirma.Width = 180
dgvKontaktEmails.Columns.Add(colFirma)
Dim colEmail As New DataGridViewTextBoxColumn()
colEmail.Name = "colEmail"
colEmail.HeaderText = "E-Mail"
colEmail.DataPropertyName = "Email"
colEmail.AutoSizeMode = DataGridViewAutoSizeColumnMode.Fill
dgvKontaktEmails.Columns.Add(colEmail)
End Sub
Private Sub LoadKontaktEmails()
_kontaktEmailRows.Clear()
dgvKontaktEmails.Rows.Clear()
Dim dedupe As New HashSet(Of String)(StringComparer.OrdinalIgnoreCase)
Dim fraechterKdNr As Integer = 0
Dim auftraggeberKdNr As Integer = 0
Dim avisiererKdNr As Integer = 0
Dim empfaengerKdNr As Integer = 0
Dim absenderKdNr As Integer = 0
Dim frachtfuehrerKdNr As Integer = 0
Try
If SendungID > 0 Then
Dim dtSnd = AvisoDAL.loadDataTableBySQL("SELECT tblSnd_AvisiererKdNr, tblSnd_AuftraggeberKdNr, tblSnd_EmpfaengerKdNr, tblSnd_AbsenderKdNr, tblSnd_FrachtfuehrerKdNr FROM tblSendungen WHERE tblSnd_SendungID = " & SendungID)
If dtSnd IsNot Nothing AndAlso dtSnd.Rows.Count > 0 Then
Dim r = dtSnd.Rows(0)
avisiererKdNr = ToIntSafe(r("tblSnd_AvisiererKdNr"))
auftraggeberKdNr = ToIntSafe(r("tblSnd_AuftraggeberKdNr"))
empfaengerKdNr = ToIntSafe(r("tblSnd_EmpfaengerKdNr"))
absenderKdNr = ToIntSafe(r("tblSnd_AbsenderKdNr"))
frachtfuehrerKdNr = ToIntSafe(r("tblSnd_FrachtfuehrerKdNr"))
End If
End If
If AvisoID > 0 Then
Dim aviso = AvisoDAL.LesenAviso(AvisoID, "")
If aviso IsNot Nothing Then
fraechterKdNr = ToIntSafe(aviso.Frächter_KdNr)
If auftraggeberKdNr = 0 Then
auftraggeberKdNr = ToIntSafe(aviso.Auftraggeber_KdNr)
End If
End If
End If
Catch
End Try
AddKontaktEmailsByKunde("Frächter", fraechterKdNr, dedupe)
AddKontaktEmailsByKunde("Avisierer", avisiererKdNr, dedupe)
AddKontaktEmailsByKunde("Auftraggeber", auftraggeberKdNr, dedupe)
AddKontaktEmailsByKunde("Empfänger", empfaengerKdNr, dedupe)
AddKontaktEmailsByKunde("Absender", absenderKdNr, dedupe)
AddKontaktEmailsByKunde("Frachtführer", frachtfuehrerKdNr, dedupe)
RefreshKontaktRolleTabs()
End Sub
Private Sub EnsureKontaktRolleTabs()
If _kontaktRolleTabs IsNot Nothing Then Return
_kontaktRolleTabs = New TabControl()
_kontaktRolleTabs.Name = "tbKontaktRollen"
_kontaktRolleTabs.Location = New Point(dgvKontaktEmails.Left, dgvKontaktEmails.Top)
_kontaktRolleTabs.Size = New Size(dgvKontaktEmails.Width, 24)
_kontaktRolleTabs.Anchor = dgvKontaktEmails.Anchor
AddHandler _kontaktRolleTabs.SelectedIndexChanged, AddressOf KontaktRolleTabs_SelectedIndexChanged
Controls.Add(_kontaktRolleTabs)
_kontaktRolleTabs.BringToFront()
dgvKontaktEmails.Top = _kontaktRolleTabs.Bottom + 4
dgvKontaktEmails.Height = btnVermerkSetzen.Top - dgvKontaktEmails.Top - 6
End Sub
Private Sub RefreshKontaktRolleTabs()
EnsureKontaktRolleTabs()
Dim selectedRolle = GetSelectedKontaktRolle()
RemoveHandler _kontaktRolleTabs.SelectedIndexChanged, AddressOf KontaktRolleTabs_SelectedIndexChanged
_kontaktRolleTabs.TabPages.Clear()
Dim rollen As New List(Of String)
For Each row In _kontaktEmailRows
If row Is Nothing Then Continue For
If rollen.Contains(row.Rolle) Then Continue For
rollen.Add(row.Rolle)
Dim page As New TabPage(row.Rolle)
page.Tag = row.Rolle
_kontaktRolleTabs.TabPages.Add(page)
Next
_kontaktRolleTabs.Visible = _kontaktRolleTabs.TabPages.Count > 0
If _kontaktRolleTabs.TabPages.Count > 0 Then
Dim selectedIndex As Integer = 0
For i As Integer = 0 To _kontaktRolleTabs.TabPages.Count - 1
If String.Equals(_kontaktRolleTabs.TabPages(i).Tag.ToString(), selectedRolle, StringComparison.OrdinalIgnoreCase) Then
selectedIndex = i
Exit For
End If
Next
_kontaktRolleTabs.SelectedIndex = selectedIndex
End If
AddHandler _kontaktRolleTabs.SelectedIndexChanged, AddressOf KontaktRolleTabs_SelectedIndexChanged
BindKontaktEmailsForSelectedRolle()
End Sub
Private Function GetSelectedKontaktRolle() As String
If _kontaktRolleTabs Is Nothing Then Return ""
If _kontaktRolleTabs.SelectedTab Is Nothing Then Return ""
Return If(_kontaktRolleTabs.SelectedTab.Tag, "").ToString().Trim()
End Function
Private Sub BindKontaktEmailsForSelectedRolle()
dgvKontaktEmails.Rows.Clear()
Dim selectedRolle = GetSelectedKontaktRolle()
For Each row In _kontaktEmailRows
If row Is Nothing Then Continue For
If selectedRolle <> "" AndAlso Not String.Equals(row.Rolle, selectedRolle, StringComparison.OrdinalIgnoreCase) Then Continue For
dgvKontaktEmails.Rows.Add(row.Art, row.Firma, row.Email)
Next
If If(txtCustomerUploadEmail.Text, "").Trim() = "" AndAlso dgvKontaktEmails.Rows.Count > 0 Then
txtCustomerUploadEmail.Text = If(dgvKontaktEmails.Rows(0).Cells("colEmail").Value, "").ToString().Trim()
End If
End Sub
Private Sub KontaktRolleTabs_SelectedIndexChanged(sender As Object, e As EventArgs)
BindKontaktEmailsForSelectedRolle()
End Sub
Private Sub AddKontaktEmailsByKunde(rolle As String, kundenNr As Integer, dedupe As HashSet(Of String))
If kundenNr <= 0 Then Return
Dim firma = GetKundenFirma(kundenNr)
Try
Dim sql As String = "SELECT * FROM tblKundenKontakt WHERE kkd_KundenNr = " & kundenNr
Using conn As System.Data.SqlClient.SqlConnection = VERAG_PROG_ALLGEMEIN.cSqlDb.GetNewOpenConnectionFMZOLL(False)
Using cmd As New System.Data.SqlClient.SqlCommand(sql, conn)
Using reader = cmd.ExecuteReader()
While reader.Read()
Dim artText = GetStringValue(reader, "kkd_kkaBez")
If artText = "" Then artText = "Kontakt"
Dim emails = GetStringValues(reader, "kkd_EMail", "kkd_EMail2", "kkd_Email", "kkd_Email2", "kkd_Mail", "kkd_Mail2", "EMail", "EMail2", "Email", "Email2", "Mail", "Mail2")
If emails.Count = 0 Then Continue While
For Each email In emails
For Each splitEmail In email.Split({";"c, ","c}, StringSplitOptions.RemoveEmptyEntries)
Dim em = splitEmail.Trim()
If em = "" Then Continue For
Dim key = rolle & "|" & kundenNr.ToString() & "|" & artText & "|" & em.ToLowerInvariant()
If Not dedupe.Contains(key) Then
dedupe.Add(key)
_kontaktEmailRows.Add(New KontaktEmailRow With {.Rolle = rolle, .Art = artText, .Firma = firma, .Email = em})
End If
Next
Next
End While
End Using
End Using
End Using
Catch
End Try
End Sub
Private Function GetStringValue(reader As IDataRecord, fieldName As String) As String
For i As Integer = 0 To reader.FieldCount - 1
If String.Equals(reader.GetName(i), fieldName, StringComparison.OrdinalIgnoreCase) Then
If reader.IsDBNull(i) Then Return ""
Return reader(i).ToString().Trim()
End If
Next
Return ""
End Function
Private Function GetStringValues(reader As IDataRecord, ParamArray fieldNames() As String) As List(Of String)
Dim values As New List(Of String)
Dim seen As New HashSet(Of String)(StringComparer.OrdinalIgnoreCase)
For Each fieldName In fieldNames
Dim value = GetStringValue(reader, fieldName)
If value = "" Then Continue For
If seen.Contains(value) Then Continue For
seen.Add(value)
values.Add(value)
Next
Return values
End Function
Private Function GetKundenFirma(kundenNr As Integer) As String
If kundenNr <= 0 Then Return ""
If _kundenFirmaByNr.ContainsKey(kundenNr) Then Return _kundenFirmaByNr(kundenNr)
Dim firma As String = ""
Try
Dim sql As String = "SELECT TOP 1 [Name 1], [Ordnungsbegriff] FROM Adressen WHERE AdressenNr = " & kundenNr
Using conn As System.Data.SqlClient.SqlConnection = VERAG_PROG_ALLGEMEIN.cSqlDb.GetNewOpenConnectionFMZOLL(False)
Using cmd As New System.Data.SqlClient.SqlCommand(sql, conn)
Using reader = cmd.ExecuteReader()
If reader.Read() Then
firma = If(reader("Name 1") Is DBNull.Value, "", reader("Name 1").ToString().Trim())
If firma = "" Then
firma = If(reader("Ordnungsbegriff") Is DBNull.Value, "", reader("Ordnungsbegriff").ToString().Trim())
End If
End If
End Using
End Using
End Using
Catch
End Try
_kundenFirmaByNr(kundenNr) = firma
Return firma
End Function
Private Function ToIntSafe(value As Object) As Integer
Try
If value Is Nothing Then Return 0
Dim tmp As Integer = 0
If Integer.TryParse(value.ToString(), tmp) Then Return tmp
Catch
End Try
Return 0
End Function
Private Sub dgvKontaktEmails_CellDoubleClick(sender As Object, e As DataGridViewCellEventArgs) Handles dgvKontaktEmails.CellDoubleClick
If e.RowIndex < 0 OrElse e.RowIndex >= dgvKontaktEmails.Rows.Count Then Return
Dim emailObj = dgvKontaktEmails.Rows(e.RowIndex).Cells("colEmail").Value
Dim email = If(emailObj, "").ToString().Trim()
If email = "" Then Return
txtCustomerUploadEmail.Text = email
End Sub
Private Sub InitializeDocumentEditor()
RemoveHandler txtDocumentEditorName.TextChanged, AddressOf DocumentEditorInputChanged
AddHandler txtDocumentEditorName.TextChanged, AddressOf DocumentEditorInputChanged
RemoveHandler txtDocumentEditorInfo.TextChanged, AddressOf DocumentEditorInputChanged
AddHandler txtDocumentEditorInfo.TextChanged, AddressOf DocumentEditorInputChanged
EnsureAnhangsartenOptionsLoaded()
RemoveHandler cmbDocumentEditorAnhangsart.SelectedIndexChanged, AddressOf DocumentEditorAnhangsartChanged
cmbDocumentEditorAnhangsart.BeginUpdate()
cmbDocumentEditorAnhangsart.Items.Clear()
For Each optionItem In _anhangsartenOptions
cmbDocumentEditorAnhangsart.Items.Add(optionItem)
Next
cmbDocumentEditorAnhangsart.EndUpdate()
AddHandler cmbDocumentEditorAnhangsart.SelectedIndexChanged, AddressOf DocumentEditorAnhangsartChanged
ClearDocumentEditor()
End Sub
Private Sub SetupDynamicAnforderungCheckboxes()
_anforderungCheckboxes.Clear()
_anhangsartIdByCheckbox.Clear()
_backendBezeichnungByCodeId.Clear()
_selectedAnhangsartIdByCodeId.Clear()
_documentCustomNameByCodeId.Clear()
_documentBaseTextByCodeId.Clear()
_bereichByCodeId.Clear()
_selectedDocumentCodeId = 0
Dim dt As DataTable = Nothing
Try
dt = AvisoDAL.loadDataTableBySQL("SELECT [VermerkCodeId],[Bezeichnung],[FrontendBezeichnung],[AvisoAnhangsartId],[AnforderungBereich] FROM [VermerkeCodes] WHERE [Anforderung]=1 ORDER BY [Bezeichnung]")
Catch
Try
dt = AvisoDAL.loadDataTableBySQL("SELECT [VermerkCodeId],[Bezeichnung],[AvisoAnhangsartId],[AnforderungBereich] FROM [VermerkeCodes] WHERE [Anforderung]=1 ORDER BY [Bezeichnung]")
Catch
Return
End Try
End Try
If dt Is Nothing OrElse dt.Rows.Count = 0 Then Return
EnsureAnhangsartenOptionsLoaded()
flpDokumenteFehlenMain.Controls.Clear()
For Each row As DataRow In dt.Rows
Dim id As Integer
Try
id = CInt(row("VermerkCodeId"))
Catch
Continue For
End Try
Dim bezeichnung = If(IsDBNull(row("Bezeichnung")), "", CStr(row("Bezeichnung"))).Trim()
If bezeichnung = "" Then Continue For
_backendBezeichnungByCodeId(id) = bezeichnung
Dim frontendBezeichnung = bezeichnung
If dt.Columns.Contains("FrontendBezeichnung") Then
frontendBezeichnung = If(IsDBNull(row("FrontendBezeichnung")), "", CStr(row("FrontendBezeichnung"))).Trim()
If frontendBezeichnung = "" Then frontendBezeichnung = bezeichnung
End If
If bezeichnung.ToLowerInvariant().Contains("nicht leserlich") Then Continue For
Dim bereich As Integer = 0
Try
If Not IsDBNull(row("AnforderungBereich")) Then bereich = CInt(row("AnforderungBereich"))
Catch
End Try
_bereichByCodeId(id) = bereich
If bereich <> BereichDokumentMain Then Continue For
Dim cb As New CheckBox()
cb.Text = frontendBezeichnung
cb.Tag = id
cb.Margin = New Padding(0, 0, 4, 0)
cb.BackColor = Color.Transparent
cb.UseVisualStyleBackColor = False
ConfigureAnforderungCheckbox(cb, flpDokumenteFehlenMain)
AddHandler cb.CheckedChanged, AddressOf DynamicAnforderungCheckboxChanged
flpDokumenteFehlenMain.Controls.Add(cb)
Dim anhangsartId As Integer = 0
Try
If Not IsDBNull(row("AvisoAnhangsartId")) Then anhangsartId = CInt(row("AvisoAnhangsartId"))
Catch
End Try
_anhangsartIdByCheckbox(cb) = anhangsartId
If Not _documentCustomNameByCodeId.ContainsKey(id) Then
_documentCustomNameByCodeId(id) = GetAnhangsartDisplayTextById(anhangsartId)
End If
_anforderungCheckboxes.Add(cb)
Next
End Sub
Private Sub ConfigureAnforderungCheckbox(cb As CheckBox, container As Control)
cb.AutoSize = False
cb.Height = 24
Dim usableWidth = Math.Max(180, container.Width - 24)
Dim cbWidth = CInt(Math.Floor((usableWidth - 12) / 4))
cb.Width = Math.Max(120, Math.Min(cbWidth, 320))
End Sub
Private Sub DocumentEditorInputChanged(sender As Object, e As EventArgs)
If _isLoadingDocumentEditor OrElse _selectedDocumentCodeId <= 0 Then Return
_documentCustomNameByCodeId(_selectedDocumentCodeId) = If(txtDocumentEditorName.Text, "").Trim()
_documentBaseTextByCodeId(_selectedDocumentCodeId) = If(txtDocumentEditorInfo.Text, "").Trim()
Dim tab = TryCast(flpDocumentTabs.Controls("tab_" & _selectedDocumentCodeId), Panel)
If tab Is Nothing Then Return
Dim lblText = TryCast(tab.Controls("lblText"), Label)
Dim lblClose = TryCast(tab.Controls("lblClose"), Label)
If lblText Is Nothing OrElse lblClose Is Nothing Then Return
lblText.Text = _documentCustomNameByCodeId(_selectedDocumentCodeId)
If lblText.Text = "" Then lblText.Text = "Unbenannt"
lblText.PerformLayout()
lblClose.Location = New Point(lblText.Right + 5, 5)
tab.Width = lblClose.Right + 5
End Sub
Private Sub DocumentEditorAnhangsartChanged(sender As Object, e As EventArgs)
If _isLoadingDocumentEditor OrElse _selectedDocumentCodeId <= 0 Then Return
Dim selected = TryCast(cmbDocumentEditorAnhangsart.SelectedItem, AnhangsartOption)
If selected Is Nothing Then Return
_selectedAnhangsartIdByCodeId(_selectedDocumentCodeId) = selected.Id
End Sub
Private Sub EnsureAnhangsartenOptionsLoaded()
If _anhangsartenOptions.Count > 0 Then Return
Dim dt As DataTable = Nothing
Try
dt = AvisoDAL.loadDataTableBySQL("SELECT [aa_id],[aa_bezeichnung],[aa_name] FROM [tblAvisoAnhangsarten] WHERE [aa_aktiv]=1 ORDER BY [aa_sort],[aa_bezeichnung]")
Catch
Return
End Try
If dt Is Nothing Then Return
For Each row As DataRow In dt.Rows
Dim id As Integer = 0
Try
id = CInt(row("aa_id"))
Catch
Continue For
End Try
If id <= 0 Then Continue For
Dim alreadyAdded As Boolean = False
For Each existing In _anhangsartenOptions
If existing.Id = id Then
alreadyAdded = True
Exit For
End If
Next
If alreadyAdded Then Continue For
Dim text = If(IsDBNull(row("aa_bezeichnung")), "", CStr(row("aa_bezeichnung"))).Trim()
If text = "" Then text = If(IsDBNull(row("aa_name")), "", CStr(row("aa_name"))).Trim()
If text = "" Then text = "#" & id.ToString()
_anhangsartenOptions.Add(New AnhangsartOption(id, text))
Next
End Sub
Private Sub SelectAnhangsartInEditor(anhangsartId As Integer)
cmbDocumentEditorAnhangsart.SelectedIndex = -1
If anhangsartId <= 0 Then Return
For i = 0 To cmbDocumentEditorAnhangsart.Items.Count - 1
Dim optionItem = TryCast(cmbDocumentEditorAnhangsart.Items(i), AnhangsartOption)
If optionItem IsNot Nothing AndAlso optionItem.Id = anhangsartId Then
cmbDocumentEditorAnhangsart.SelectedIndex = i
Exit For
End If
Next
End Sub
Private Function GetAnhangsartDisplayTextById(anhangsartId As Integer) As String
If anhangsartId <= 0 Then Return ""
EnsureAnhangsartenOptionsLoaded()
For Each optionItem In _anhangsartenOptions
If optionItem.Id = anhangsartId Then Return If(optionItem.Text, "").Trim()
Next
Return ""
End Function
Private Function TryGetCheckboxCodeId(cb As CheckBox, ByRef codeId As Integer) As Boolean
codeId = 0
If cb Is Nothing OrElse cb.Tag Is Nothing Then Return False
Return Integer.TryParse(cb.Tag.ToString(), codeId) AndAlso codeId > 0
End Function
Private Sub ClearDocumentEditor()
_selectedDocumentCodeId = 0
_isLoadingDocumentEditor = True
txtDocumentEditorName.Text = ""
txtDocumentEditorInfo.Text = ""
cmbDocumentEditorAnhangsart.SelectedIndex = -1
_isLoadingDocumentEditor = False
lblDocumentEditorStatus.Text = "Wählen Sie ein Dokument, um Name und Dokument Info anzupassen."
End Sub
Private Sub SelectDocument(codeId As Integer)
_selectedDocumentCodeId = codeId
If codeId <= 0 Then
ClearDocumentEditor()
SyncTabs()
Return
End If
Dim targetCb As CheckBox = Nothing
For Each cb In _anforderungCheckboxes
If cb.Tag IsNot Nothing AndAlso cb.Tag.ToString() = codeId.ToString() Then
targetCb = cb
Exit For
End If
Next
If targetCb Is Nothing Then Return
Dim anhangsartId = GetEffectiveAnhangsartId(targetCb)
Dim customName = ""
If _documentCustomNameByCodeId.ContainsKey(codeId) Then
customName = If(_documentCustomNameByCodeId(codeId), "").Trim()
Else
customName = GetAnhangsartDisplayTextById(anhangsartId)
_documentCustomNameByCodeId(codeId) = customName
End If
Dim baseText = GetDocumentBaseTextByCodeId(codeId)
_isLoadingDocumentEditor = True
txtDocumentEditorName.Text = customName
txtDocumentEditorInfo.Text = baseText
SelectAnhangsartInEditor(anhangsartId)
_isLoadingDocumentEditor = False
If anhangsartId > 0 Then _selectedAnhangsartIdByCodeId(codeId) = anhangsartId
lblDocumentEditorStatus.ForeColor = Color.FromArgb(0, 102, 153)
lblDocumentEditorStatus.Text = "Ausgewählt: " & If(targetCb.Text, "").Trim()
SyncTabs()
End Sub
Private Function CreateTab(codeId As Integer, text As String) As Panel
Dim pnl As New Panel()
pnl.Name = "tab_" & codeId
pnl.Tag = codeId
pnl.Height = 28
pnl.BackColor = Color.White
pnl.BorderStyle = BorderStyle.FixedSingle
pnl.Margin = New Padding(2, 4, 2, 0)
pnl.Cursor = Cursors.Hand
Dim lblText As New Label()
lblText.Name = "lblText"
lblText.Text = If(text = "", "Unbenannt", text)
lblText.AutoSize = True
lblText.Location = New Point(5, 5)
lblText.Tag = codeId
lblText.Cursor = Cursors.Hand
AddHandler lblText.Click, AddressOf Tab_Click
pnl.Controls.Add(lblText)
Dim lblClose As New Label()
lblClose.Name = "lblClose"
lblClose.Text = "X"
lblClose.AutoSize = True
lblClose.ForeColor = Color.Red
lblClose.Font = New Font("Microsoft Sans Serif", 8.25!, FontStyle.Bold)
lblClose.Cursor = Cursors.Hand
lblClose.Tag = codeId
AddHandler lblClose.Click, AddressOf TabClose_Click
pnl.Controls.Add(lblClose)
lblText.PerformLayout()
lblClose.Location = New Point(lblText.Right + 5, 5)
pnl.Width = lblClose.Right + 5
AddHandler pnl.Click, AddressOf Tab_Click
Return pnl
End Function
Private Sub SyncTabs()
flpDocumentTabs.SuspendLayout()
Dim requiredCodeIds As New List(Of Integer)
For Each cb In _anforderungCheckboxes
If cb.Checked Then
Dim codeId As Integer = 0
If Integer.TryParse(cb.Tag.ToString(), codeId) Then requiredCodeIds.Add(codeId)
End If
Next
Dim i = flpDocumentTabs.Controls.Count - 1
While i >= 0
Dim pnl = TryCast(flpDocumentTabs.Controls(i), Panel)
If pnl IsNot Nothing Then
Dim codeId = CInt(pnl.Tag)
If Not requiredCodeIds.Contains(codeId) Then
flpDocumentTabs.Controls.RemoveAt(i)
pnl.Dispose()
End If
End If
i -= 1
End While
For Each codeId In requiredCodeIds
Dim existingTab = TryCast(flpDocumentTabs.Controls("tab_" & codeId), Panel)
Dim text = If(_documentCustomNameByCodeId.ContainsKey(codeId), _documentCustomNameByCodeId(codeId), "")
If existingTab Is Nothing Then
existingTab = CreateTab(codeId, text)
flpDocumentTabs.Controls.Add(existingTab)
Else
Dim lblText = TryCast(existingTab.Controls("lblText"), Label)
Dim lblClose = TryCast(existingTab.Controls("lblClose"), Label)
If lblText IsNot Nothing AndAlso lblClose IsNot Nothing Then
lblText.Text = If(text = "", "Unbenannt", text)
lblText.PerformLayout()
lblClose.Location = New Point(lblText.Right + 5, 5)
existingTab.Width = lblClose.Right + 5
End If
End If
If codeId = _selectedDocumentCodeId Then
existingTab.BackColor = Color.White
existingTab.BorderStyle = BorderStyle.FixedSingle
existingTab.Height = 28
existingTab.Margin = New Padding(2, 2, 2, 0)
Else
existingTab.BackColor = Color.LightGray
existingTab.BorderStyle = BorderStyle.None
existingTab.Height = 25
existingTab.Margin = New Padding(2, 5, 2, 0)
End If
Next
flpDocumentTabs.ResumeLayout()
If _selectedDocumentCodeId > 0 AndAlso Not requiredCodeIds.Contains(_selectedDocumentCodeId) Then
If requiredCodeIds.Count > 0 Then
SelectDocument(requiredCodeIds(0))
Else
ClearDocumentEditor()
End If
ElseIf _selectedDocumentCodeId = 0 AndAlso requiredCodeIds.Count > 0 Then
SelectDocument(requiredCodeIds(0))
End If
End Sub
Private Sub Tab_Click(sender As Object, e As EventArgs)
Dim ctrl = TryCast(sender, Control)
If ctrl Is Nothing OrElse ctrl.Tag Is Nothing Then Return
Dim codeId As Integer = 0
If Integer.TryParse(ctrl.Tag.ToString(), codeId) Then SelectDocument(codeId)
End Sub
Private Sub TabClose_Click(sender As Object, e As EventArgs)
Dim ctrl = TryCast(sender, Control)
If ctrl Is Nothing OrElse ctrl.Tag Is Nothing Then Return
Dim codeId As Integer = 0
If Not Integer.TryParse(ctrl.Tag.ToString(), codeId) Then Return
For Each cb In _anforderungCheckboxes
If cb.Tag IsNot Nothing AndAlso cb.Tag.ToString() = codeId.ToString() Then
cb.Checked = False
Exit For
End If
Next
End Sub
Private Function GetEffectiveDocumentName(cb As CheckBox) As String
Dim codeId As Integer = 0
If TryGetCheckboxCodeId(cb, codeId) AndAlso _documentCustomNameByCodeId.ContainsKey(codeId) Then
Return If(_documentCustomNameByCodeId(codeId), "").Trim()
End If
Return ""
End Function
Private Function GetDocumentBaseText(cb As CheckBox) As String
Dim codeId As Integer = 0
If TryGetCheckboxCodeId(cb, codeId) Then Return GetDocumentBaseTextByCodeId(codeId)
Return DefaultDocumentBaseText
End Function
Private Function GetDocumentBaseTextByCodeId(codeId As Integer) As String
If codeId > 0 AndAlso _documentBaseTextByCodeId.ContainsKey(codeId) Then
Dim configuredBaseText = If(_documentBaseTextByCodeId(codeId), "").Trim()
If configuredBaseText <> "" Then Return configuredBaseText
End If
Return DefaultDocumentBaseText
End Function
Private Function GetEffectiveAnhangsartId(cb As CheckBox) As Integer
Dim codeId As Integer = 0
If TryGetCheckboxCodeId(cb, codeId) Then
If _selectedAnhangsartIdByCodeId.ContainsKey(codeId) AndAlso _selectedAnhangsartIdByCodeId(codeId) > 0 Then
Return _selectedAnhangsartIdByCodeId(codeId)
End If
End If
Dim defaultId As Integer = 0
If _anhangsartIdByCheckbox.TryGetValue(cb, defaultId) Then Return defaultId
Return 0
End Function
Private Function BuildUploadCustomText(baseText As String) As String
Dim effectiveBaseText = If(baseText, "").Trim()
If effectiveBaseText = "" Then effectiveBaseText = DefaultDocumentBaseText
Return effectiveBaseText
End Function
Private Function ValidateDocumentSelectionPayload(documentName As String, baseText As String, anhangsartId As Integer, ByRef validationError As String) As Boolean
validationError = ""
If anhangsartId <= 0 Then validationError = "ANHANGSART_ID_FEHLT" : Return False
documentName = If(documentName, "").Trim()
If documentName = "" Then validationError = "DOKUMENTNAME_FEHLT" : Return False
If documentName.Length > 120 Then validationError = "DOKUMENTNAME_ZU_LANG" : Return False
If If(baseText, "").Trim().Length > 500 Then validationError = "BASETEXT_ZU_LANG" : Return False
Return True
End Function
Private Sub DynamicAnforderungCheckboxChanged(sender As Object, e As EventArgs)
Dim cb = TryCast(sender, CheckBox)
If cb Is Nothing Then Return
If cb.Checked Then
Dim codeId As Integer = 0
If Integer.TryParse(cb.Tag.ToString(), codeId) Then SelectDocument(codeId)
Else
SyncTabs()
End If
End Sub
Private Function HasPrimaryDokumentSelection() As Boolean
For Each cb In _anforderungCheckboxes
Dim codeId As Integer = 0
If cb IsNot Nothing AndAlso cb.Checked AndAlso Integer.TryParse(If(cb.Tag, "").ToString(), codeId) Then
If _bereichByCodeId.ContainsKey(codeId) AndAlso _bereichByCodeId(codeId) = BereichDokumentMain Then
Return True
End If
End If
Next
Return False
End Function
Private Sub SonstChanged(sender As Object, e As EventArgs) Handles txtSonstigesDokumentFehlt.TextChanged
cbxSonstDok.Checked = (sender.text <> "")
End Sub
Private Sub btnVermerkSetzen_Click(sender As Object, e As EventArgs) Handles btnVermerkSetzen.Click
lblErrDokument.Visible = False
If Not HasPrimaryDokumentSelection() AndAlso Not cbxSonstDok.Checked AndAlso Not cbxNichtLeserlich.Checked Then
lblErrDokument.Visible = True
Exit Sub
End If
If cbxSonstDok.Checked AndAlso txtSonstigesDokumentFehlt.Text.Trim = "" Then
lblErrDokument.Visible = True
txtSonstigesDokumentFehlt.Focus()
Exit Sub
End If
If Not SaveSelectedVermerke() Then
Exit Sub
End If
DialogResult = DialogResult.OK
Close()
End Sub
Private Function SaveSelectedVermerke() As Boolean
Try
If AvisoID <= 0 Then
MsgBox("Aviso konnte nicht ermittelt werden.", vbExclamation)
Return False
End If
Dim sendungsText = GetSendungsAnzeigeText()
For Each cb In _anforderungCheckboxes
If cb Is Nothing OrElse Not cb.Checked Then Continue For
Dim codeId As Integer = 0
If Not Integer.TryParse(If(cb.Tag, "").ToString(), codeId) Then Continue For
If codeId <= 0 Then Continue For
Dim text = GetBackendVermerkText(codeId, If(cb.Text, "").Trim())
If text = "" Then Continue For
text = AppendSendungIfMissing(text, sendungsText)
insertSendungsVermerk(SendungID, AvisoID, text, codeId)
Next
If cbxSonstDok.Checked Then
Dim customDocName = If(txtSonstigesDokumentFehlt.Text, "").Trim()
If customDocName <> "" Then
Dim text = GetBackendVermerkText(25, "")
If text = "" Then
text = customDocName
Else
text = text.Replace("''", "'" & customDocName & "'")
If InStr(text, customDocName, CompareMethod.Text) = 0 Then
text &= " [" & customDocName & "]"
End If
End If
text = AppendSendungIfMissing(text, sendungsText)
insertSendungsVermerk(SendungID, AvisoID, text, 25)
End If
End If
If cbxNichtLeserlich.Checked Then
Dim text = GetBackendVermerkText(42, If(cbxNichtLeserlich.Text, "").Trim())
text = AppendSendungIfMissing(text, sendungsText)
If text <> "" Then
insertSendungsVermerk(SendungID, AvisoID, text, 42)
End If
End If
Return True
Catch ex As Exception
MsgBox("Vermerk konnte nicht gespeichert werden: " & ex.Message, vbExclamation)
Return False
End Try
End Function
Private Function GetSendungsAnzeigeText() As String
If SendungID <= 0 Then Return "KOMPLETT"
Try
Return _admin.getValueTxtBySql(" SELECT convert(varchar(2),[tblSnd_PosUnterNr]) +' - ' +isnull([tblSnd_Empfaenger],'') FROM tblSendungen WHERE [tblSnd_SendungID]=" & SendungID, "AVISO").Trim()
Catch
Return SendungID.ToString()
End Try
End Function
Private Function GetBackendVermerkText(codeId As Integer, fallback As String) As String
If _backendBezeichnungByCodeId.ContainsKey(codeId) Then
Dim value = If(_backendBezeichnungByCodeId(codeId), "").Trim()
If value <> "" Then
Return value
End If
End If
Return If(fallback, "").Trim()
End Function
Private Function AppendSendungIfMissing(text As String, sendungsText As String) As String
Dim value = If(text, "").Trim()
Dim snd = If(sendungsText, "").Trim()
If value = "" OrElse snd = "" Then Return value
If InStr(value, "sendung", CompareMethod.Text) > 0 Then Return value
Return value & " bei Sendung '" & snd & "'"
End Function
Private Sub btnCustomerUploadLink_Click(sender As Object, e As EventArgs) Handles btnCustomerUploadLink.Click
Dim validityHours = CInt(nudCustomerUploadValidityHours.Value)
Dim config = GetCustomerPortalApiConfig()
If config Is Nothing Then Exit Sub
Dim jwtToken = ""
Dim authErr = ""
If Not TryGetCustomerPortalJwtToken(config, jwtToken, authErr) Then
MsgBox("Fehler bei Authentifizierung: " & authErr, vbExclamation)
Exit Sub
End If
Dim anhangsartenMap As Dictionary(Of String, Integer) = Nothing
Dim anhangsartenErr = ""
If Not TryGetCustomerPortalAnhangsartenMap(config, jwtToken, anhangsartenMap, anhangsartenErr) Then
MsgBox("Fehler beim Laden der Dokumentarten: " & anhangsartenErr, vbExclamation)
Exit Sub
End If
Dim requirements = BuildCustomerUploadRequirements(anhangsartenMap)
If requirements Is Nothing Then Exit Sub
If requirements.Count = 0 Then
MsgBox("Bitte mindestens ein Dokument im Bereich 'Dokument(e) fehlen' auswählen.", vbInformation)
Label20.ForeColor = Color.Red
Label20.Text = "Für den Upload-Link muss mindestens ein Dokument ausgewählt sein."
Exit Sub
End If
Label20.ForeColor = Color.FromArgb(0, 102, 153)
Label20.Text = "Bitte zuerst Dokument(e) oben auswählen."
Cursor = Cursors.WaitCursor
Try
Dim linkUrl = ""
Dim errorCode = ""
If Not TryCreateCustomerUploadLinkMultiWithoutEmail(config, requirements, validityHours, linkUrl, errorCode) Then
MsgBox("Fehler beim Erzeugen des Upload-Links: " & errorCode, vbExclamation)
Exit Sub
End If
If linkUrl <> "" Then
Clipboard.SetText(linkUrl)
MsgBox("Upload-Link wurde in die Zwischenablage kopiert.", vbInformation)
Else
MsgBox("Upload-Link konnte nicht aus der Antwort gelesen werden.", vbExclamation)
End If
Finally
Cursor = Cursors.Default
End Try
End Sub
Private Sub btnCustomerUploadEmail_Click(sender As Object, e As EventArgs) Handles btnCustomerUploadEmail.Click
Dim recipient = If(txtCustomerUploadEmail.Text, "").Trim()
If recipient = "" Then MsgBox("Bitte eine E-Mail-Adresse eingeben.", vbInformation) : txtCustomerUploadEmail.Focus() : Exit Sub
Try
Dim addr As New MailAddress(recipient)
recipient = addr.Address
Catch
MsgBox("E-Mail-Adresse ist ungültig.", vbInformation)
txtCustomerUploadEmail.Focus()
Exit Sub
End Try
Dim emailText = If(txtCustomerUploadEmailText.Text, "").Trim()
If emailText = "" Then MsgBox("Bitte den Text eintragen.", vbInformation) : txtCustomerUploadEmailText.Focus() : Exit Sub
Dim validityHours = CInt(nudCustomerUploadValidityHours.Value)
Dim language = If(TryCast(cmbCustomerUploadLanguage.SelectedItem, String), If(cmbCustomerUploadLanguage.Text, "").Trim())
language = language.ToLowerInvariant()
If language <> "de" AndAlso language <> "en" AndAlso language <> "tr" AndAlso language <> "sr" AndAlso language <> "bg" Then language = "de"
Dim config = GetCustomerPortalApiConfig()
If config Is Nothing Then Exit Sub
Dim jwtToken = ""
Dim authErr = ""
If Not TryGetCustomerPortalJwtToken(config, jwtToken, authErr) Then MsgBox("Fehler bei Authentifizierung: " & authErr, vbExclamation) : Exit Sub
Dim anhangsartenMap As Dictionary(Of String, Integer) = Nothing
Dim anhangsartenErr = ""
If Not TryGetCustomerPortalAnhangsartenMap(config, jwtToken, anhangsartenMap, anhangsartenErr) Then MsgBox("Fehler beim Laden der Dokumentarten: " & anhangsartenErr, vbExclamation) : Exit Sub
Dim requirements = BuildCustomerUploadRequirements(anhangsartenMap)
If requirements Is Nothing Then Exit Sub
If requirements.Count = 0 Then
MsgBox("Bitte mindestens ein Dokument im Bereich 'Dokument(e) fehlen' auswählen.", vbInformation)
Label20.ForeColor = Color.Red
Label20.Text = "Für den Upload-Link muss mindestens ein Dokument ausgewählt sein."
Exit Sub
End If
Label20.ForeColor = Color.FromArgb(0, 102, 153)
Label20.Text = "Bitte zuerst Dokument(e) oben auswählen."
Cursor = Cursors.WaitCursor
Try
Dim linkUrl = ""
Dim errorCode = ""
If Not TryRequestCustomerUploadLinkMultiWithEmail(config, requirements, recipient, emailText, language, validityHours, linkUrl, errorCode) Then
MsgBox("Fehler beim Versand der E-Mail: " & errorCode, vbExclamation)
Exit Sub
End If
If linkUrl <> "" Then Clipboard.SetText(linkUrl)
MsgBox("E-Mail wurde ausgelöst.", vbInformation)
Finally
Cursor = Cursors.Default
End Try
End Sub
Public Function BuildState() As DokumentanforderungState
Dim result As New DokumentanforderungState()
result.SelectedCodeIds = New List(Of Integer)
For Each cb In _anforderungCheckboxes
Dim codeId As Integer = 0
If cb.Checked AndAlso Integer.TryParse(If(cb.Tag, "").ToString(), codeId) Then result.SelectedCodeIds.Add(codeId)
Next
result.SelectedAnhangsartIdByCodeId = New Dictionary(Of Integer, Integer)(_selectedAnhangsartIdByCodeId)
result.DocumentCustomNameByCodeId = New Dictionary(Of Integer, String)(_documentCustomNameByCodeId)
result.DocumentBaseTextByCodeId = New Dictionary(Of Integer, String)(_documentBaseTextByCodeId)
result.SonstDokChecked = cbxSonstDok.Checked
result.SonstigesDokumentName = If(txtSonstigesDokumentFehlt.Text, "").Trim()
result.NichtLeserlichChecked = cbxNichtLeserlich.Checked
result.CustomerUploadEmail = If(txtCustomerUploadEmail.Text, "").Trim()
result.CustomerUploadLanguage = If(TryCast(cmbCustomerUploadLanguage.SelectedItem, String), If(cmbCustomerUploadLanguage.Text, "").Trim())
result.CustomerUploadEmailText = If(txtCustomerUploadEmailText.Text, "").Trim()
result.CustomerUploadValidityHours = CInt(nudCustomerUploadValidityHours.Value)
Return result
End Function
Private Sub ApplyStateToUi(state As DokumentanforderungState)
If state Is Nothing Then Return
_selectedAnhangsartIdByCodeId.Clear()
_documentCustomNameByCodeId.Clear()
_documentBaseTextByCodeId.Clear()
For Each kvp In state.SelectedAnhangsartIdByCodeId
_selectedAnhangsartIdByCodeId(kvp.Key) = kvp.Value
Next
For Each kvp In state.DocumentCustomNameByCodeId
_documentCustomNameByCodeId(kvp.Key) = kvp.Value
Next
For Each kvp In state.DocumentBaseTextByCodeId
_documentBaseTextByCodeId(kvp.Key) = kvp.Value
Next
For Each cb In _anforderungCheckboxes
Dim codeId As Integer = 0
cb.Checked = Integer.TryParse(If(cb.Tag, "").ToString(), codeId) AndAlso state.SelectedCodeIds.Contains(codeId)
Next
cbxSonstDok.Checked = state.SonstDokChecked
txtSonstigesDokumentFehlt.Text = If(state.SonstigesDokumentName, "")
cbxNichtLeserlich.Checked = state.NichtLeserlichChecked
txtCustomerUploadEmail.Text = If(state.CustomerUploadEmail, "")
txtCustomerUploadEmailText.Text = If(state.CustomerUploadEmailText, "Bitte laden Sie die angeforderten Dokumente über den Link hoch.")
nudCustomerUploadValidityHours.Value = Math.Max(nudCustomerUploadValidityHours.Minimum, Math.Min(nudCustomerUploadValidityHours.Maximum, state.CustomerUploadValidityHours))
Dim language = If(state.CustomerUploadLanguage, "").Trim().ToLowerInvariant()
Dim idx = cmbCustomerUploadLanguage.Items.IndexOf(language)
If idx >= 0 Then cmbCustomerUploadLanguage.SelectedIndex = idx
SyncTabs()
End Sub
Private Class CustomerPortalApiConfig
Public Property BaseUrl As String
Public Property Username As String
Public Property Password As String
End Class
Private Function GetCustomerPortalApiConfig() As CustomerPortalApiConfig
Dim baseUrl = If(System.Environment.GetEnvironmentVariable("AVISO_CUSTOMERPORTAL_API_BASEURL"), "").Trim()
If baseUrl = "" Then baseUrl = If(ConfigurationManager.AppSettings("CustomerPortalApiBaseUrl"), "").Trim()
If baseUrl = "" Then baseUrl = "https://login.server.verag.ag"
Dim username = If(System.Environment.GetEnvironmentVariable("AVISO_CUSTOMERPORTAL_API_USERNAME"), "").Trim()
If username = "" Then username = If(ConfigurationManager.AppSettings("CustomerPortalApiUsername"), "").Trim()
Dim password = If(System.Environment.GetEnvironmentVariable("AVISO_CUSTOMERPORTAL_API_PASSWORD"), "").Trim()
If password = "" Then password = If(ConfigurationManager.AppSettings("CustomerPortalApiPassword"), "").Trim()
If username = "" OrElse password = "" Then
MsgBox("CustomerPortalApiUsername/CustomerPortalApiPassword fehlt in App.config (oder ENV: AVISO_CUSTOMERPORTAL_API_USERNAME / AVISO_CUSTOMERPORTAL_API_PASSWORD).", vbExclamation)
Return Nothing
End If
Return New CustomerPortalApiConfig With {.BaseUrl = baseUrl, .Username = username, .Password = password}
End Function
Private Function TryGetCustomerPortalJwtToken(ByVal config As CustomerPortalApiConfig, ByRef jwtToken As String, ByRef errorCode As String) As Boolean
jwtToken = ""
errorCode = ""
If _customerPortalJwtToken <> "" Then
If _customerPortalJwtExpUtc = DateTime.MinValue OrElse DateTime.UtcNow < _customerPortalJwtExpUtc.AddMinutes(-1) Then
jwtToken = _customerPortalJwtToken
Return True
End If
End If
Dim url = config.BaseUrl.TrimEnd("/"c) & "/api/auth/login"
Dim payload As New Dictionary(Of String, Object) From {{"username", config.Username}, {"password", config.Password}}
Dim jsonBody = JsonConvert.SerializeObject(payload)
Try
ServicePointManager.SecurityProtocol = SecurityProtocolType.Tls12
Dim request = CType(WebRequest.Create(url), HttpWebRequest)
request.Method = "POST"
request.ContentType = "application/json"
request.Accept = "application/json"
request.Timeout = 15000
Using requestStream = request.GetRequestStream()
Using writer As New StreamWriter(requestStream, Encoding.UTF8)
writer.Write(jsonBody)
End Using
End Using
Using response = CType(request.GetResponse(), HttpWebResponse)
Using reader As New StreamReader(response.GetResponseStream(), Encoding.UTF8)
Dim respText = reader.ReadToEnd()
Dim jobj = JObject.Parse(respText)
Dim token = (If(jobj("token"), New JValue(""))).ToString().Trim()
If token = "" Then errorCode = "TOKEN_MISSING" : Return False
_customerPortalJwtToken = token
_customerPortalJwtExpUtc = ExtractJwtExpUtcOrMin(token)
jwtToken = token
Return True
End Using
End Using
Catch ex As WebException
errorCode = ReadWebExceptionMessage(ex)
Return False
Catch ex As Exception
errorCode = ex.Message
Return False
End Try
End Function
Private Function ExtractJwtExpUtcOrMin(ByVal jwt As String) As DateTime
Try
Dim parts = If(jwt, "").Split("."c)
If parts.Length < 2 Then Return DateTime.MinValue
Dim payloadJson = Encoding.UTF8.GetString(Base64UrlDecode(parts(1)))
Dim jobj = JObject.Parse(payloadJson)
Dim expToken = jobj("exp")
If expToken Is Nothing Then Return DateTime.MinValue
Dim expSeconds As Long
If Long.TryParse(expToken.ToString(), expSeconds) Then Return DateTimeOffset.FromUnixTimeSeconds(expSeconds).UtcDateTime
Catch
End Try
Return DateTime.MinValue
End Function
Private Function Base64UrlDecode(ByVal input As String) As Byte()
Dim s = If(input, "").Replace("-"c, "+"c).Replace("_"c, "/"c)
Select Case (s.Length Mod 4)
Case 2
s &= "=="
Case 3
s &= "="
End Select
Return Convert.FromBase64String(s)
End Function
Private Function BuildCustomerUploadRequirements(ByVal anhangsartenMap As Dictionary(Of String, Integer)) As List(Of Object)
Dim requirements As New List(Of Object)
Dim missing As New List(Of String)
For Each cb In _anforderungCheckboxes
If cb Is Nothing OrElse Not cb.Checked Then Continue For
Dim documentType = GetEffectiveDocumentName(cb)
If documentType = "" Then Continue For
Dim baseText = GetDocumentBaseText(cb)
Dim validationError = ""
Dim anhangsartId = GetEffectiveAnhangsartId(cb)
If anhangsartId <= 0 Then missing.Add(documentType) : Continue For
If Not ValidateDocumentSelectionPayload(documentType, baseText, anhangsartId, validationError) Then
MsgBox("Ungültige Eingabe für Dokument '" & documentType & "': " & validationError, vbInformation)
Return Nothing
End If
AddCustomerUploadRequirementByAnhangsartId(requirements, documentType, anhangsartId, BuildUploadCustomText(baseText))
Next
If cbxSonstDok.Checked Then
Dim custom = If(txtSonstigesDokumentFehlt.Text, "").Trim()
If custom = "" Then
MsgBox("Bitte den Dokumentnamen eintragen.", vbInformation)
txtSonstigesDokumentFehlt.Focus()
Return Nothing
End If
AddCustomerUploadRequirement(requirements, missing, anhangsartenMap, True, custom, {"SONSTIGES", "DOKUMENT"}, "Bitte " & custom & " hochladen.", True)
End If
If missing.Count > 0 Then
MsgBox("Anhangsarten nicht gefunden: " & String.Join(", ", missing), vbExclamation)
Return Nothing
End If
Return requirements
End Function
Private Sub AddCustomerUploadRequirementByAnhangsartId(ByVal requirements As List(Of Object), ByVal documentType As String, ByVal anhangsartId As Integer, ByVal customText As String)
If requirements Is Nothing OrElse anhangsartId <= 0 Then Exit Sub
requirements.Add(New Dictionary(Of String, Object) From {{"documentType", documentType}, {"anhangsartId", anhangsartId}, {"customText", customText}})
End Sub
Private Sub AddCustomerUploadRequirement(ByVal requirements As List(Of Object), ByVal missing As List(Of String), ByVal anhangsartenMap As Dictionary(Of String, Integer), ByVal isSelected As Boolean, ByVal documentType As String, ByVal anhangsartenCandidates As String(), ByVal customText As String, ByVal allowCustomFilename As Boolean)
If Not isSelected Then Exit Sub
Dim anhangsartId = ResolveAnhangsartId(anhangsartenCandidates, anhangsartenMap)
If anhangsartId <= 0 AndAlso allowCustomFilename AndAlso _customerPortalCustomFilenameAnhangsartId > 0 Then anhangsartId = _customerPortalCustomFilenameAnhangsartId
If anhangsartId <= 0 Then missing.Add(documentType) : Exit Sub
requirements.Add(New Dictionary(Of String, Object) From {{"documentType", documentType}, {"anhangsartId", anhangsartId}, {"customText", customText}})
End Sub
Private Function ResolveAnhangsartId(ByVal candidates As IEnumerable(Of String), ByVal anhangsartenMap As Dictionary(Of String, Integer)) As Integer
If candidates Is Nothing OrElse anhangsartenMap Is Nothing Then Return -1
For Each c In candidates
Dim key = If(c, "").Trim()
If key = "" Then Continue For
Dim id As Integer
If anhangsartenMap.TryGetValue(key.ToUpperInvariant(), id) Then Return id
Next
Return -1
End Function
Private Function TryGetCustomerPortalAnhangsartenMap(ByVal config As CustomerPortalApiConfig, ByVal jwtToken As String, ByRef anhangsartenMap As Dictionary(Of String, Integer), ByRef errorCode As String) As Boolean
anhangsartenMap = Nothing
errorCode = ""
If _customerPortalAnhangsartenMap IsNot Nothing AndAlso _customerPortalAnhangsartenFetchedUtc <> DateTime.MinValue Then
If DateTime.UtcNow < _customerPortalAnhangsartenFetchedUtc.AddMinutes(30) Then
anhangsartenMap = _customerPortalAnhangsartenMap
Return True
End If
End If
Dim url = config.BaseUrl.TrimEnd("/"c) & "/api/AvisoUpload/anhangsarten/all"
Dim request = CType(WebRequest.Create(url), HttpWebRequest)
request.Method = "GET"
request.Accept = "application/json"
request.Timeout = 15000
request.Headers(HttpRequestHeader.Authorization) = "Bearer " & jwtToken
Try
ServicePointManager.SecurityProtocol = SecurityProtocolType.Tls12
Using response = CType(request.GetResponse(), HttpWebResponse)
Using reader As New StreamReader(response.GetResponseStream(), Encoding.UTF8)
Dim respText = If(reader.ReadToEnd(), "").Trim()
Dim map As New Dictionary(Of String, Integer)(StringComparer.OrdinalIgnoreCase)
Dim customFilenameId As Integer = -1
If respText.StartsWith("[") Then
Dim arr = JArray.Parse(respText)
For Each t In arr
Dim id = 0
If t("id") IsNot Nothing AndAlso Integer.TryParse(t("id").ToString(), id) Then
Dim name = (If(t("name"), New JValue(""))).ToString().Trim()
Dim bez = (If(t("bezeichnung"), New JValue(""))).ToString().Trim()
If name <> "" Then map(name.ToUpperInvariant()) = id
If bez <> "" Then map(bez.ToUpperInvariant()) = id
If id = 24 Then customFilenameId = 24
End If
Next
ElseIf respText.StartsWith("{") Then
Dim jobj = JObject.Parse(respText)
errorCode = (If(jobj("message"), If(jobj("code"), New JValue("ANHANGSARTEN_LOAD_FAILED")))).ToString()
Return False
Else
errorCode = "ANHANGSARTEN_INVALID_RESPONSE"
Return False
End If
If map.Count = 0 Then errorCode = "ANHANGSARTEN_EMPTY" : Return False
_customerPortalCustomFilenameAnhangsartId = customFilenameId
_customerPortalAnhangsartenMap = map
_customerPortalAnhangsartenFetchedUtc = DateTime.UtcNow
anhangsartenMap = map
Return True
End Using
End Using
Catch ex As WebException
errorCode = ReadWebExceptionMessage(ex)
Return False
Catch ex As Exception
errorCode = ex.Message
Return False
End Try
End Function
Private Function TryCreateCustomerUploadLinkMultiWithoutEmail(ByVal config As CustomerPortalApiConfig, ByVal requirements As List(Of Object), ByVal validityHours As Integer, ByRef linkUrl As String, ByRef errorCode As String) As Boolean
linkUrl = ""
errorCode = ""
Dim url = config.BaseUrl.TrimEnd("/"c) & "/api/PublicCustomerDocuments/create-upload-link-multi"
Dim payload As New Dictionary(Of String, Object) From {{"avisoId", AvisoID}, {"validityHours", validityHours}, {"requirements", requirements}}
If SendungID > 0 Then payload("sendungsId") = SendungID
Dim jsonBody = JsonConvert.SerializeObject(payload)
Dim jwtToken = ""
Dim authErr = ""
If Not TryGetCustomerPortalJwtToken(config, jwtToken, authErr) Then errorCode = authErr : Return False
Return TryPostCustomerPortalJson(url, jwtToken, jsonBody, linkUrl, errorCode)
End Function
Private Function TryRequestCustomerUploadLinkMultiWithEmail(ByVal config As CustomerPortalApiConfig, ByVal requirements As List(Of Object), ByVal recipientEmail As String, ByVal emailText As String, ByVal language As String, ByVal validityHours As Integer, ByRef linkUrl As String, ByRef errorCode As String) As Boolean
linkUrl = ""
errorCode = ""
Dim url = config.BaseUrl.TrimEnd("/"c) & "/api/PublicCustomerDocuments/request-upload-link-multi"
If language Is Nothing OrElse language.Trim() = "" Then language = "de"
Dim payload As New Dictionary(Of String, Object) From {{"avisoId", AvisoID}, {"emailText", emailText}, {"language", language}, {"validityHours", validityHours}, {"requirements", requirements}}
If SendungID > 0 Then payload("sendungsId") = SendungID
payload("recipientEmail") = recipientEmail
Dim jsonBody = JsonConvert.SerializeObject(payload)
Dim jwtToken = ""
Dim authErr = ""
If Not TryGetCustomerPortalJwtToken(config, jwtToken, authErr) Then errorCode = authErr : Return False
Return TryPostCustomerPortalJson(url, jwtToken, jsonBody, linkUrl, errorCode)
End Function
Private Function TryPostCustomerPortalJson(ByVal url As String, ByVal jwtToken As String, ByVal jsonBody As String, ByRef linkUrl As String, ByRef errorCode As String) As Boolean
Dim request = CType(WebRequest.Create(url), HttpWebRequest)
request.Method = "POST"
request.ContentType = "application/json"
request.Accept = "application/json"
request.Timeout = 15000
request.Headers(HttpRequestHeader.Authorization) = "Bearer " & jwtToken
Using requestStream = request.GetRequestStream()
Using writer As New StreamWriter(requestStream, Encoding.UTF8)
writer.Write(jsonBody)
End Using
End Using
Using response = CType(request.GetResponse(), HttpWebResponse)
Using reader As New StreamReader(response.GetResponseStream(), Encoding.UTF8)
Dim respText = reader.ReadToEnd()
Dim jobj = JObject.Parse(respText)
Dim result = (If(jobj("result"), New JValue(""))).ToString()
If String.Equals(result, "pass", StringComparison.OrdinalIgnoreCase) Then
Dim link = (If(jobj.SelectToken("data.linkUrl"), New JValue(""))).ToString()
If link = "" Then link = (If(jobj.SelectToken("linkUrl"), New JValue(""))).ToString()
linkUrl = link
Return True
End If
errorCode = (If(jobj("message"), New JValue("UNKNOWN_ERROR"))).ToString()
Return False
End Using
End Using
End Function
Private Function ReadWebExceptionMessage(ByVal ex As WebException) As String
Dim body = ""
Try
If ex.Response IsNot Nothing Then
Using respStream = ex.Response.GetResponseStream()
If respStream IsNot Nothing Then
Using reader As New StreamReader(respStream, Encoding.UTF8)
body = reader.ReadToEnd()
End Using
End If
End Using
End If
Catch
End Try
If body <> "" Then
Try
Dim jobj = JObject.Parse(body)
Return (If(jobj("message"), New JValue(ex.Message))).ToString()
Catch
Return ex.Message
End Try
End If
Return ex.Message
End Function
Private Class AnhangsartOption
Public ReadOnly Id As Integer
Public ReadOnly Text As String
Public Sub New(id As Integer, text As String)
Me.Id = id
Me.Text = If(text, "").Trim()
End Sub
Public Overrides Function ToString() As String
Return Text
End Function
End Class
Private Class KontaktEmailRow
Public Property Rolle As String
Public Property Art As String
Public Property Firma As String
Public Property Email As String
End Class
Public Class DokumentanforderungState
Public Property SelectedCodeIds As New List(Of Integer)
Public Property SelectedAnhangsartIdByCodeId As New Dictionary(Of Integer, Integer)
Public Property DocumentCustomNameByCodeId As New Dictionary(Of Integer, String)
Public Property DocumentBaseTextByCodeId As New Dictionary(Of Integer, String)
Public Property SonstDokChecked As Boolean
Public Property SonstigesDokumentName As String
Public Property NichtLeserlichChecked As Boolean
Public Property CustomerUploadEmail As String
Public Property CustomerUploadLanguage As String = "de"
Public Property CustomerUploadEmailText As String = ""
Public Property CustomerUploadValidityHours As Integer = 168
End Class
End Class