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 frmAddSendungsvermerkShort Dim AvisoDAL As New cAvisoDAL Dim ADMIN As New cADMIN Dim myAviso As New cAviso Dim VermerkeDAL As New cVermerkeDAL Dim aktChanged As Boolean = False 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 = 0 Private _isLoadingDocumentEditor As Boolean = False Private pnlDocumentEditor As Panel Private lblDocumentEditorTitle As Label Private lblDocumentEditorName As Label Private txtDocumentEditorName As TextBox Private lblDocumentEditorAnhangsart As Label Private cmbDocumentEditorAnhangsart As ComboBox Private lblDocumentEditorInfo As Label Private txtDocumentEditorInfo As TextBox Private lblDocumentEditorStatus As Label Private Const DefaultDocumentBaseText As String = "Bitte das Dokument hochladen." Private Const BereichDokumentMain As Integer = 1 Private Const BereichAngefordert As Integer = 2 Dim Neuanlage As Boolean = False Dim hStatus As Integer Public SendungID As Integer = -1 Public AvisoID As Integer = -1 Dim txtSendung As New TextBox Public Sub New() InitializeComponent() Icon = cMeineFunktionenAVISO.GetProgrammIcon End Sub Public Sub New(AvisoID, SendungID) InitializeComponent() Me.AvisoID = AvisoID Me.SendungID = SendungID Icon = cMeineFunktionenAVISO.GetProgrammIcon End Sub Private Sub frmEintragVermerk_KeyDown(sender As Object, e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyDown 'Escape händisch abfangen und auf Abbruch-Taste legen If e.KeyCode = Keys.Escape Then ' btnAbbruch.PerformClick() Me.Close() End If If e.KeyCode = Keys.Return Then btnOK.PerformClick() End If End Sub Dim listentoCheckChange As Boolean = True Sub selectionChanged(sender As Object, e As EventArgs) If listentoCheckChange Then listentoCheckChange = False For Each c In Me.Controls If c.GetType.Name.ToString = "RadioButton" Then ' DirectCast(c, RadioButton).Checked = False End If Next ' DirectCast(sender, RadioButton).Checked = True listentoCheckChange = True End If End Sub Private Sub frmEintragVermerk_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load VERAG_PROG_ALLGEMEIN.cAllgemein._TRANSLATE(Me) 'cboDokumente.Items.Clear() ' cboDokumente.Items.Add(New MyListItem("nachgefordert", CStr(0))) 'cboDokumente.Items.Add(New MyListItem("erhalten", CStr(1))) 'cboDokumente.SelectedIndex = 0 Me.CenterToParent() If My.Computer.Screen.WorkingArea.Height < Me.Height Then Me.Height = My.Computer.Screen.WorkingArea.Height End If If cmbCustomerUploadLanguage IsNot Nothing Then 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 End If For Each c In Me.Controls If c.GetType.Name.ToString = "RadioButton" Then AddHandler DirectCast(c, RadioButton).CheckedChanged, AddressOf selectionChanged End If Next myAviso = AvisoDAL.LesenAviso(AvisoID, "") If SendungID > 0 Then txtSendung.Text = ADMIN.getValueTxtBySql(" SELECT convert(varchar(2),[tblSnd_PosUnterNr]) +' - ' +isnull([tblSnd_Empfaenger],'') FROM tblSendungen WHERE [tblSnd_SendungID]=" & SendungID & "", "AVISO") Else txtSendung.Text = "KOMPLETT" End If SetupDynamicAnforderungCheckboxes() hStatus = myAviso.Status If hStatus = cGlobal.Status_Vorbereitet Or hStatus = cGlobal.Status_Vorgeschrieben Or hStatus = cGlobal.Status_Erfasst Then optSendungInVorbereitung.Visible = True If hStatus = cGlobal.Status_Vorgeschrieben Then optSendungInVorbereitung.Visible = False End If Else optSendungInVorbereitung.Visible = False End If 'bereits vorhandene Vermerke laden 'txtInfo.Text = VermerkeDAL.Vermerke_einlesen(myAviso.AvisoID) Me.Text = "AKT " & myAviso.LKW_Nr & "" ' optKeineAuswahl.Checked = True ' optDokumente.Focus() If VERAG_PROG_ALLGEMEIN.cBerechtignunen.CHECK_BERECHTIGUNG_bool("WARENORT", "AVISO") Then For Each c As Control In Me.Controls Dim enabledTmp = False If c Is btnCLose Then enabledTmp = True If c Is optFremd_SendungAvisiert Then enabledTmp = True If c Is optFremd_ATB Then enabledTmp = True If c Is optATAangefordert Then enabledTmp = True If c Is txtDetail Then enabledTmp = True If c Is btnOK Then enabledTmp = True c.Enabled = enabledTmp Next End If End Sub Private Sub SetupDynamicAnforderungCheckboxes() _anforderungCheckboxes.Clear() _anhangsartIdByCheckbox.Clear() _backendBezeichnungByCodeId.Clear() _selectedAnhangsartIdByCodeId.Clear() _documentCustomNameByCodeId.Clear() _documentBaseTextByCodeId.Clear() _bereichByCodeId.Clear() _selectedDocumentCodeId = 0 If flpDocumentTabs IsNot Nothing Then flpDocumentTabs.Controls.Clear() End If 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 End If EnsureAnhangsartenOptionsLoaded() Dim docsLeft = Label1.Left + 3 Dim docsTop = Label1.Bottom + 6 Dim docsWidth = PictureBox1.Width - (docsLeft * 2) Dim docsMainHeight = Math.Max(10, cbxSonstDok.Top - docsTop - 6) Dim docsMainPanel = CreateAnforderungFlowPanel("flpDokumenteFehlenMain", docsLeft, docsTop, docsWidth, docsMainHeight, Color.WhiteSmoke) docsMainPanel.FlowDirection = FlowDirection.LeftToRight docsMainPanel.WrapContents = True Dim docsExtraFound = pnlSendungsVermker.Controls.Find("flpDokumenteFehlenExtra", True) If docsExtraFound IsNot Nothing AndAlso docsExtraFound.Length > 0 Then Dim docsExtraPanel = TryCast(docsExtraFound(0), FlowLayoutPanel) If docsExtraPanel IsNot Nothing Then docsExtraPanel.Visible = False docsExtraPanel.Controls.Clear() End If End If PositionDocumentEditorAndUpload() Dim lblSonstigeVermerke As Label = TryCast(pnlSendungsVermker.Controls.Find("lblSonstigeVermerke", True).FirstOrDefault(), Label) If lblSonstigeVermerke Is Nothing Then lblSonstigeVermerke = New Label() lblSonstigeVermerke.Name = "lblSonstigeVermerke" lblSonstigeVermerke.Text = "Sonstige Vermerke:" lblSonstigeVermerke.Font = New Font("Microsoft Sans Serif", 10.0!, FontStyle.Bold) lblSonstigeVermerke.AutoSize = True lblSonstigeVermerke.BackColor = Color.White pnlSendungsVermker.Controls.Add(lblSonstigeVermerke) End If lblSonstigeVermerke.Left = docsLeft lblSonstigeVermerke.Top = PictureBox1.Bottom + 8 lblSonstigeVermerke.BringToFront() Dim anforderungLeft = docsLeft Dim anforderungTop = lblSonstigeVermerke.Bottom + 6 Dim anforderungWidth = pnlSendungsVermker.Width - (anforderungLeft * 2) Dim anforderungHeight = 198 Dim anforderungPanel = CreateAnforderungFlowPanel("flpAngefordert", anforderungLeft, anforderungTop, anforderungWidth, anforderungHeight, Color.White) 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 Dim cb As New CheckBox() cb.Text = frontendBezeichnung cb.Tag = id cb.Margin = New Padding(0, 0, 8, 2) AddHandler cb.CheckedChanged, AddressOf DynamicAnforderungCheckboxChanged If bezeichnung.ToLowerInvariant().Contains("nicht leserlich") Then Continue For End If Dim anhangsartId As Integer = 0 Try If Not IsDBNull(row("AvisoAnhangsartId")) Then anhangsartId = CInt(row("AvisoAnhangsartId")) End If Catch End Try _anhangsartIdByCheckbox(cb) = anhangsartId If Not _documentCustomNameByCodeId.ContainsKey(id) Then _documentCustomNameByCodeId(id) = GetAnhangsartDisplayTextById(anhangsartId) End If Dim bereich As Integer = BereichAngefordert Try If Not IsDBNull(row("AnforderungBereich")) Then bereich = CInt(row("AnforderungBereich")) End If Catch End Try _bereichByCodeId(id) = bereich If bereich = BereichDokumentMain Then cb.BackColor = Color.WhiteSmoke cb.UseVisualStyleBackColor = False ConfigureAnforderungCheckbox(cb, docsMainPanel) docsMainPanel.Controls.Add(cb) Else ConfigureAnforderungCheckbox(cb, anforderungPanel) anforderungPanel.Controls.Add(cb) End If _anforderungCheckboxes.Add(cb) Next ArrangeSections(docsMainPanel, anforderungPanel) cbxSonstDok.BringToFront() txtSonstigesDokumentFehlt.BringToFront() cbxNichtLeserlich.BringToFront() lblErrDokument.BringToFront() End Sub Private Function CreateAnforderungFlowPanel(name As String, left As Integer, top As Integer, width As Integer, height As Integer, backColor As Color) As FlowLayoutPanel Dim found = pnlSendungsVermker.Controls.Find(name, True) If found IsNot Nothing AndAlso found.Length > 0 Then Dim existing = TryCast(found(0), FlowLayoutPanel) If existing IsNot Nothing Then existing.Left = left existing.Top = top existing.Width = width existing.Height = height existing.BackColor = backColor existing.FlowDirection = FlowDirection.TopDown existing.WrapContents = True existing.AutoScroll = True existing.Controls.Clear() existing.BringToFront() Return existing End If End If Dim flp As New FlowLayoutPanel() flp.Name = name flp.Left = left flp.Top = top flp.Width = width flp.Height = height flp.FlowDirection = FlowDirection.TopDown flp.WrapContents = True flp.AutoScroll = True flp.BackColor = backColor flp.Padding = New Padding(0) flp.Margin = New Padding(0) pnlSendungsVermker.Controls.Add(flp) flp.BringToFront() Return flp End Function Private Sub ConfigureAnforderungCheckbox(cb As CheckBox, container As Control) If cb Is Nothing OrElse container Is Nothing Then Return cb.AutoSize = False cb.Height = 20 Dim cols As Integer = 2 Dim colGap As Integer = 14 Dim minCbWidth As Integer = 120 If String.Equals(container.Name, "flpDokumenteFehlenMain", StringComparison.OrdinalIgnoreCase) Then cols = 3 colGap = 8 minCbWidth = 150 End If Dim usableWidth = Math.Max(120, container.Width - 12) Dim cbWidth = CInt(Math.Floor((usableWidth - ((cols - 1) * colGap)) / cols)) cb.Width = Math.Max(minCbWidth, cbWidth) End Sub Private Sub PositionDocumentEditorAndUpload() EnsureDocumentEditorControls() Dim topSectionBottom = Math.Max(cbxSonstDok.Bottom, lblErrDokument.Bottom) pnlDocumentEditor.Left = 8 pnlDocumentEditor.Top = topSectionBottom + 12 pnlDocumentEditor.Width = pnlSendungsVermker.Width - 16 pnlDocumentEditor.Height = 152 pnlDocumentEditor.BackColor = Color.WhiteSmoke pnlDocumentEditor.BringToFront() Label5.Top = pnlDocumentEditor.Bottom + 8 Label5.BackColor = Color.WhiteSmoke Label5.BringToFront() Label20.Left = Label5.Right + 10 Label20.Top = Label5.Top + 2 Label20.BackColor = Color.WhiteSmoke Label20.AutoSize = True Label20.ForeColor = Color.FromArgb(0, 102, 153) Label20.Text = "Bitte zuerst Dokument(e) oben auswählen." Label20.BringToFront() lblCustomerUploadLanguage.Top = Label5.Bottom + 10 lblCustomerUploadLanguage.BackColor = Color.WhiteSmoke lblCustomerUploadLanguage.BringToFront() cmbCustomerUploadLanguage.Top = lblCustomerUploadLanguage.Top - 3 cmbCustomerUploadLanguage.BringToFront() lblCustomerUploadValidityHours.Top = lblCustomerUploadLanguage.Top lblCustomerUploadValidityHours.BackColor = Color.WhiteSmoke lblCustomerUploadValidityHours.BringToFront() nudCustomerUploadValidityHours.Top = lblCustomerUploadLanguage.Top - 2 nudCustomerUploadValidityHours.BringToFront() btnCustomerUploadLink.Top = lblCustomerUploadLanguage.Top - 4 btnCustomerUploadLink.BringToFront() lblCustomerUploadEmail.Top = lblCustomerUploadLanguage.Top + 26 lblCustomerUploadEmail.BackColor = Color.WhiteSmoke lblCustomerUploadEmail.BringToFront() txtCustomerUploadEmail.Top = lblCustomerUploadEmail.Top - 3 txtCustomerUploadEmail.BringToFront() btnCustomerUploadEmail.Top = txtCustomerUploadEmail.Top - 2 btnCustomerUploadEmail.BringToFront() lblCustomerUploadEmailText.Top = lblCustomerUploadEmail.Top + 22 lblCustomerUploadEmailText.BackColor = Color.WhiteSmoke lblCustomerUploadEmailText.BringToFront() txtCustomerUploadEmailText.Top = lblCustomerUploadEmailText.Top - 3 txtCustomerUploadEmailText.BringToFront() pnlCustomerUploadSeparator.Visible = False PictureBox1.Height = txtCustomerUploadEmailText.Bottom + 12 End Sub Private Sub ArrangeSections(docsMainPanel As FlowLayoutPanel, anforderungPanel As FlowLayoutPanel) If docsMainPanel Is Nothing OrElse anforderungPanel Is Nothing Then Return Label13.Top = anforderungPanel.Bottom + 14 PictureBox4.Top = Label13.Top - 10 optSpeditionWeitergeleitet.Top = Label13.Bottom + 10 txtSpedition.Top = optSpeditionWeitergeleitet.Top - 2 Label2.Top = optSpeditionWeitergeleitet.Top - 18 Label3.Top = optSpeditionWeitergeleitet.Top + 1 lblErrSpedition.Top = Label2.Top optFreierText.Top = optSpeditionWeitergeleitet.Bottom + 9 txtFreierText.Top = optFreierText.Top - 2 Label17.Top = txtFreierText.Bottom + 4 Label9.Top = Label17.Top lblErrGrund.Top = Label17.Top Label4.Top = Label17.Bottom + 14 optFremd_SendungAvisiert.Top = Label4.Bottom + 7 optFremd_ATB.Top = optFremd_SendungAvisiert.Bottom + 6 optATAangefordert.Top = optFremd_ATB.Top PictureBox4.Height = (optFremd_ATB.Bottom + 12) - PictureBox4.Top lblZustzlFreitext.Top = PictureBox4.Bottom + 8 txtDetail.Top = lblZustzlFreitext.Bottom + 4 btnOK.Top = txtDetail.Top lblErr240Zeichen.Top = txtDetail.Top - 16 Dim contentBottom = Math.Max(btnOK.Bottom, txtDetail.Bottom) + 12 pnlSendungsVermker.Height = contentBottom pnlMain.Height = contentBottom Me.ClientSize = New Size(Me.ClientSize.Width, contentBottom) End Sub Private flpDocumentTabs As FlowLayoutPanel Private Sub EnsureDocumentEditorControls() If pnlDocumentEditor IsNot Nothing Then Return pnlDocumentEditor = New Panel() pnlDocumentEditor.BackColor = Color.WhiteSmoke pnlDocumentEditor.BorderStyle = BorderStyle.FixedSingle pnlSendungsVermker.Controls.Add(pnlDocumentEditor) flpDocumentTabs = New FlowLayoutPanel() flpDocumentTabs.Location = New Point(0, 0) flpDocumentTabs.Width = pnlDocumentEditor.Width flpDocumentTabs.Height = 50 flpDocumentTabs.BackColor = Color.FromArgb(220, 220, 220) flpDocumentTabs.WrapContents = False flpDocumentTabs.AutoScroll = True flpDocumentTabs.Anchor = AnchorStyles.Top Or AnchorStyles.Left Or AnchorStyles.Right pnlDocumentEditor.Controls.Add(flpDocumentTabs) lblDocumentEditorTitle = New Label() lblDocumentEditorTitle.AutoSize = True lblDocumentEditorTitle.Font = New Font("Microsoft Sans Serif", 8.25!, FontStyle.Bold, GraphicsUnit.Point, CType(0, Byte)) lblDocumentEditorTitle.Location = New Point(8, 58) lblDocumentEditorTitle.Text = "Dokumentdetails" pnlDocumentEditor.Controls.Add(lblDocumentEditorTitle) lblDocumentEditorName = New Label() lblDocumentEditorName.AutoSize = True lblDocumentEditorName.Location = New Point(8, 80) lblDocumentEditorName.Text = "Dokumentname:" pnlDocumentEditor.Controls.Add(lblDocumentEditorName) txtDocumentEditorName = New TextBox() txtDocumentEditorName.BackColor = Color.White txtDocumentEditorName.Location = New Point(110, 77) txtDocumentEditorName.MaxLength = 120 txtDocumentEditorName.Size = New Size(128, 20) AddHandler txtDocumentEditorName.TextChanged, AddressOf DocumentEditorInputChanged pnlDocumentEditor.Controls.Add(txtDocumentEditorName) lblDocumentEditorAnhangsart = New Label() lblDocumentEditorAnhangsart.AutoSize = True lblDocumentEditorAnhangsart.Location = New Point(248, 80) lblDocumentEditorAnhangsart.Text = "Anhangsart:" pnlDocumentEditor.Controls.Add(lblDocumentEditorAnhangsart) cmbDocumentEditorAnhangsart = New ComboBox() cmbDocumentEditorAnhangsart.BackColor = Color.White cmbDocumentEditorAnhangsart.DropDownStyle = ComboBoxStyle.DropDownList cmbDocumentEditorAnhangsart.Location = New Point(320, 77) cmbDocumentEditorAnhangsart.Size = New Size(124, 21) EnsureAnhangsartenOptionsLoaded() For Each o In _anhangsartenOptions cmbDocumentEditorAnhangsart.Items.Add(o) Next AddHandler cmbDocumentEditorAnhangsart.SelectedIndexChanged, AddressOf DocumentEditorAnhangsartChanged pnlDocumentEditor.Controls.Add(cmbDocumentEditorAnhangsart) lblDocumentEditorInfo = New Label() lblDocumentEditorInfo.AutoSize = True lblDocumentEditorInfo.Location = New Point(8, 104) lblDocumentEditorInfo.Text = "Dokument Info:" pnlDocumentEditor.Controls.Add(lblDocumentEditorInfo) txtDocumentEditorInfo = New TextBox() txtDocumentEditorInfo.BackColor = Color.White txtDocumentEditorInfo.Location = New Point(110, 101) txtDocumentEditorInfo.MaxLength = 500 txtDocumentEditorInfo.Size = New Size(334, 20) txtDocumentEditorInfo.Text = DefaultDocumentBaseText AddHandler txtDocumentEditorInfo.TextChanged, AddressOf DocumentEditorInputChanged pnlDocumentEditor.Controls.Add(txtDocumentEditorInfo) lblDocumentEditorStatus = New Label() lblDocumentEditorStatus.AutoSize = True lblDocumentEditorStatus.ForeColor = Color.FromArgb(0, 102, 153) lblDocumentEditorStatus.Location = New Point(8, 128) lblDocumentEditorStatus.Text = "Wählen Sie ein Dokument, um Name und Dokument Info anzupassen." pnlDocumentEditor.Controls.Add(lblDocumentEditorStatus) End Sub Private Sub DocumentEditorInputChanged(sender As Object, e As EventArgs) If _isLoadingDocumentEditor Then Return If _selectedDocumentCodeId <= 0 Then Return _documentCustomNameByCodeId(_selectedDocumentCodeId) = If(txtDocumentEditorName.Text, "").Trim() _documentBaseTextByCodeId(_selectedDocumentCodeId) = If(txtDocumentEditorInfo.Text, "").Trim() If flpDocumentTabs IsNot Nothing Then Dim tab = TryCast(flpDocumentTabs.Controls("tab_" & _selectedDocumentCodeId), Panel) If tab IsNot Nothing Then Dim lblText = TryCast(tab.Controls("lblText"), Label) Dim lblClose = TryCast(tab.Controls("lblClose"), Label) If lblText IsNot Nothing AndAlso lblClose IsNot Nothing Then 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 If End If End If End Sub Private Sub DocumentEditorAnhangsartChanged(sender As Object, e As EventArgs) If _isLoadingDocumentEditor Then Return If _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() End If If text = "" Then text = "#" & id.ToString() _anhangsartenOptions.Add(New AnhangsartOption(id, text)) Next End Sub Private Sub SelectAnhangsartInEditor(anhangsartId As Integer) If cmbDocumentEditorAnhangsart Is Nothing Then Return 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 Is Nothing Then Continue For If 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() End If 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 = "" If cmbDocumentEditorAnhangsart IsNot Nothing Then cmbDocumentEditorAnhangsart.SelectedIndex = -1 End If _isLoadingDocumentEditor = False If lblDocumentEditorStatus IsNot Nothing Then lblDocumentEditorStatus.Text = "Wählen Sie ein Dokument, um Name und Dokument Info anzupassen." End If 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 IsNot Nothing Then 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 End If lblDocumentEditorStatus.ForeColor = Color.FromArgb(0, 102, 153) lblDocumentEditorStatus.Text = "Ausgewählt: " & If(targetCb.Text, "").Trim() End If 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() If flpDocumentTabs Is Nothing Then Return 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 If _bereichByCodeId.ContainsKey(codeId) AndAlso _bereichByCodeId(codeId) = BereichDokumentMain Then requiredCodeIds.Add(codeId) End If End If End If Next Dim i As Integer = 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) Then text = _documentCustomNameByCodeId(codeId) End If If text = "" Then For Each cb In _anforderungCheckboxes If cb.Tag IsNot Nothing AndAlso cb.Tag.ToString() = codeId.ToString() Then text = cb.Text Exit For End If Next End If 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) Dim lblText = TryCast(existingTab.Controls("lblText"), Label) If lblText IsNot Nothing Then lblText.Font = New Font("Microsoft Sans Serif", 8.25!, FontStyle.Bold) Else existingTab.BackColor = Color.LightGray existingTab.BorderStyle = BorderStyle.None existingTab.Height = 25 existingTab.Margin = New Padding(2, 5, 2, 0) Dim lblText = TryCast(existingTab.Controls("lblText"), Label) If lblText IsNot Nothing Then lblText.Font = New Font("Microsoft Sans Serif", 8.25!, FontStyle.Regular) 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 IsNot Nothing AndAlso ctrl.Tag IsNot Nothing Then Dim codeId As Integer = 0 If Integer.TryParse(ctrl.Tag.ToString(), codeId) Then SelectDocument(codeId) End If End If End Sub Private Sub TabClose_Click(sender As Object, e As EventArgs) Dim ctrl = TryCast(sender, Control) If ctrl IsNot Nothing AndAlso ctrl.Tag IsNot Nothing Then Dim codeId As Integer = 0 If Integer.TryParse(ctrl.Tag.ToString(), codeId) Then 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 If End If End Sub Private Sub LoadDocumentEditorForCheckbox(cb As CheckBox) EnsureDocumentEditorControls() Dim codeId As Integer = 0 If Not TryGetCheckboxCodeId(cb, codeId) Then _selectedDocumentCodeId = 0 Return End If _selectedDocumentCodeId = codeId Dim anhangsartId = GetEffectiveAnhangsartId(cb) 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 End If lblDocumentEditorStatus.ForeColor = Color.FromArgb(0, 102, 153) lblDocumentEditorStatus.Text = "Ausgewählt: " & If(cb.Text, "").Trim() End Sub Private Function GetEffectiveDocumentName(cb As CheckBox) As String If cb Is Nothing Then Return "" Dim codeId As Integer = 0 If TryGetCheckboxCodeId(cb, codeId) Then If _documentCustomNameByCodeId.ContainsKey(codeId) Then Dim customName = If(_documentCustomNameByCodeId(codeId), "").Trim() Return customName End If End If Return "" End Function Private Function GetDocumentBaseText(cb As CheckBox) As String If cb Is Nothing Then Return "" Dim codeId As Integer = 0 If TryGetCheckboxCodeId(cb, codeId) Then Return GetDocumentBaseTextByCodeId(codeId) End If 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 If cb Is Nothing Then Return 0 Dim codeId As Integer = 0 If TryGetCheckboxCodeId(cb, codeId) Then If _selectedAnhangsartIdByCodeId.ContainsKey(codeId) Then Dim selectedId = _selectedAnhangsartIdByCodeId(codeId) If selectedId > 0 Then Return selectedId End If End If Dim defaultId As Integer = 0 If _anhangsartIdByCheckbox.TryGetValue(cb, defaultId) Then Return defaultId End If 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 End If documentName = If(documentName, "").Trim() If documentName = "" Then validationError = "DOKUMENTNAME_FEHLT" Return False End If If documentName.Length > 120 Then validationError = "DOKUMENTNAME_ZU_LANG" Return False End If If If(baseText, "").Trim().Length > 500 Then validationError = "BASETEXT_ZU_LANG" Return False End If Return True End Function Private Sub DynamicAnforderungCheckboxChanged(sender As Object, e As EventArgs) Dim cb = TryCast(sender, CheckBox) If cb Is Nothing Then Return Dim bereich As Integer = 0 Dim codeId As Integer = 0 If cb.Tag IsNot Nothing Then If Integer.TryParse(cb.Tag.ToString(), codeId) Then If _bereichByCodeId.ContainsKey(codeId) Then bereich = _bereichByCodeId(codeId) Else bereich = BereichAngefordert End If End If End If If bereich = BereichAngefordert Then Return End If If cb.Checked Then SelectDocument(codeId) Else SyncTabs() End If End Sub ' Private Sub btnAbbruch_Click(sender As System.Object, e As System.EventArgs) Handles btnAbbruch.Click ' Me.Close() ' End Sub Private Sub txtFeld_GotFocus(sender As Object, e As System.EventArgs) Handles txtFreierText.GotFocus, txtSpedition.GotFocus CType(sender, TextBox).SelectAll() End Sub Private Sub btnOK_Click(sender As System.Object, e As System.EventArgs) Handles btnOK.Click If insertVermerke() Then 'Jetzt wird Fenster geschlossen frmHauptfenster.avisoAktualisierenAktiveIdBehalten(myAviso.AvisoID) Me.Close() End If End Sub Function insertVermerke() As Boolean If txtDetail.Text <> "" Then If txtDetail.Text.Length > 240 Then showErr(lblErr240Zeichen) txtDetail.Focus() Return False End If End If 'Plausibilität prüfen If optFreierText.Checked Then If txtFreierText.Text.Trim = "" Then showErr(lblErrGrund) txtFreierText.Focus() Return False End If insertSendungsVermerk(SendungID, myAviso.AvisoID, txtFreierText.Text.Trim & " - offen", 101) End If For Each cb In _anforderungCheckboxes If cb Is Nothing OrElse Not cb.Checked Then Continue For Dim codeId As Integer Try codeId = CInt(cb.Tag) Catch Continue For End Try Dim text = "" If _backendBezeichnungByCodeId.ContainsKey(codeId) Then text = If(_backendBezeichnungByCodeId(codeId), "").Trim() End If If text = "" Then text = cb.Text.Trim() Dim sendText = txtSendung.Text.Trim() If text <> "" AndAlso sendText <> "" AndAlso InStr(text, "sendung", CompareMethod.Text) = 0 Then text &= " bei Sendung '" & sendText & "'" End If If text <> "" Then insertSendungsVermerk(SendungID, myAviso.AvisoID, text, codeId) Next If optFremd_ATB.Checked Then insertSendungsVermerk(SendungID, myAviso.AvisoID, "ATB von Fremdeinsteller erhalten bei Sendung '" & txtSendung.Text.Trim & "' ", 72) If optFremd_SendungAvisiert.Checked Then insertSendungsVermerk(SendungID, myAviso.AvisoID, "Sendung '" & txtSendung.Text.Trim & "' an Fremdeinsteller avisiert", 73) ' If optSndUmmelden.Checked Then insertSendungsVermerk(SendungID, myAviso.AvisoID, "Sendung '" & txtSendung.Text.Trim & "' umgemeldet", 94) If cbxSonstDok.Checked Then If txtSonstigesDokumentFehlt.Text.Trim = "" Then showErr(lblErrDokument) : txtSonstigesDokumentFehlt.Focus() : Return False End If insertSendungsVermerk(SendungID, myAviso.AvisoID, "Dokument '" & txtSonstigesDokumentFehlt.Text.Trim & "' fehlt - angefordert.", 25) End If If cbxNichtLeserlich.Checked Then insertSendungsVermerk(SendungID, myAviso.AvisoID, "Dokument(e) nachgefordert, da nicht leserlich.", 42) If optSpeditionWeitergeleitet.Checked = True Then If txtSpedition.Text.Trim = "" Then showErr(lblErrSpedition) txtSpedition.Focus() Return False End If insertSendungsVermerk(SendungID, myAviso.AvisoID, "Fahrer muss die Sendung bei '" & txtSpedition.Text.Trim & "' abfertigen - weitergeleitet", 28) End If If optSendungInVorbereitung.Checked = True Then insertSendungsVermerk(SendungID, myAviso.AvisoID, "Sendung '" & txtSendung.Text.Trim & "' in Vorbereitung.", 31) VermerkeDAL.UpdateSendungVorbereitet(AvisoID, SendungID, VERAG_PROG_ALLGEMEIN.cGlobal.AktiverMitarbeiter.MitarbeiterID, True) End If ' If optSendungVorbereitet.Checked = True Then 'insertSendungsVermerk(SendungID,myAviso.AvisoID, "Sendung '" & txtSendung.Text.Trim & "' Vorbereitung abgeschlossen.", 32) ' VermerkeDAL.UpdateSendungVorbereitet(AvisoID, SendungID, VERAG_PROG_ALLGEMEIN.cglobal.AktiverMitarbeiter.MitarbeiterID, False) 'End If If optATAangefordert.Checked = True Then insertSendungsVermerk(SendungID, myAviso.AvisoID, "ATA/ATC-Nr. bei Sendung " & txtSendung.Text.Trim & " - angefordert", 33) ' ElseIf optATAerhalten.Checked = True Then ' If txtSendung.Text.Trim = "" Then 'showErr(lblErrSendungProbleme) ' txtSendung.Focus() ' Return False ' End If 'insertSendungsVermerk(SendungID,myAviso.AvisoID,"ATA-Nr. bei Sendung " & txtSendung.Text.Trim & " erhalten", 34) End If 'If cbxDispoliste.Checked = True Then insertSendungsVermerk(SendungID, myAviso.AvisoID, "Dispoliste bei " & txtSendung.Text.Trim & " angefordert", 57) 'If optFach.Checked = True Then ' If txtFach.Text.Trim = "" Then ' showErr(lblErrFach) ' txtFach.Focus() ' Return False ' End If ' insertSendungsVermerk(SendungID,myAviso.AvisoID, "Akt liegt im Fach '" & txtFach.Text.Trim & "'", 35) 'End If If txtDetail.Text <> "" Then If txtDetail.Text.Length <= 80 Then insertSendungsVermerk(SendungID, myAviso.AvisoID, txtDetail.Text, 46) ElseIf txtDetail.Text.Length <= 160 Then insertSendungsVermerk(SendungID, myAviso.AvisoID, txtDetail.Text.Substring(0, 80), 46) insertSendungsVermerk(SendungID, myAviso.AvisoID, txtDetail.Text.Substring(80, 80), 46) ElseIf txtDetail.Text.Length <= 240 Then insertSendungsVermerk(SendungID, myAviso.AvisoID, txtDetail.Text.Substring(0, 80), 46) insertSendungsVermerk(SendungID, myAviso.AvisoID, txtDetail.Text.Substring(80, 80), 46) insertSendungsVermerk(SendungID, myAviso.AvisoID, txtDetail.Text.Substring(160, 80), 46) End If End If Return True End Function Sub insertVermerk(Text As String, VermerkCodeId As Integer, Optional Beschreibung As String = "") 'Daten zuweisen und speichern Dim myVermerk As New cVermerk myVermerk.VermerkID = 0 myVermerk.AvisoID = myAviso.AvisoID myVermerk.Datum = Now myVermerk.Mitarbeiter = cGlobal.AktiverMitarbeiter.Mitarbeiter myVermerk.MitarbeiterId = cGlobal.AktiverMitarbeiter.MitarbeiterID myVermerk.Hinweis_Vermerk = Text myVermerk.VermerkCodeId = VermerkCodeId myVermerk.VermerkArt = "A" VermerkeDAL.SpeichernVermerk(myVermerk) If myVermerk.VermerkCodeId = 18 Then VermerkeDAL.UpdateLKW(myVermerk.AvisoID, False) frmHauptfenster.avisoAktualisierenAktiveIdBehalten(myVermerk.AvisoID) End If End Sub Sub showErr(l As Label) lblErrDokument.Visible = False ' lblErrFach.Visible = False lblErrGrund.Visible = False ' lblErrSendungProbleme.Visible = False ' lblErrSendungSpedition.Visible = False 'lblErrSendungVorbereitung.Visible = False lblErrSpedition.Visible = False l.Visible = True End Sub Private Sub txtFreierText_TextChanged(sender As Object, e As EventArgs) Handles txtFreierText.TextChanged If txtFreierText.Text <> "" Then optFreierText.Checked = True End If End Sub ' Private Sub cboDokumente_SelectedIndexChanged(sender As Object, e As EventArgs) ' cboDokumente.SelectedIndex = CInt(Not cboDokumente.SelectedIndex = 0) + 1 ' cbxAuftrag.Focus() ' optDokumente.Checked = True 'End Sub Private Sub cbxAuftrag_CheckedChanged(sender As Object, e As EventArgs) Handles cbxSonstDok.CheckedChanged, cbxNichtLeserlich.CheckedChanged ' optDokumente.Checked = True End Sub Private Sub SonstChanged(sender As Object, e As EventArgs) Handles txtSonstigesDokumentFehlt.TextChanged ' optDokumente.Checked = True cbxSonstDok.Checked = (sender.text <> "") End Sub Private Sub txtSendungSpedition_TextChanged(sender As Object, e As EventArgs) Handles txtSendungSpedition.TextChanged, txtSpedition.TextChanged optSpeditionWeitergeleitet.Checked = True End Sub ' Private Sub txtFach_TextChanged(sender As Object, e As EventArgs) ' optFach.Checked = True ' End Sub Private Sub txtDetail_TextChanged(sender As Object, e As EventArgs) Handles txtDetail.TextChanged If txtDetail.Text.Length = 240 Then showErr(lblErr240Zeichen) End If End Sub Private Sub frmAddSendungsvermerk_Shown(sender As Object, e As EventArgs) Handles Me.Shown Dim p = Cursor.Position If (p.X + Me.Width) > My.Computer.Screen.WorkingArea.Width Then p.X = My.Computer.Screen.WorkingArea.Width - Me.Width If (p.Y + Me.Height) > My.Computer.Screen.WorkingArea.Height Then p.Y = My.Computer.Screen.WorkingArea.Height - Me.Height Me.Location = p '.Me.PointToClient(System.Cursor.Position) txtSendung.SelectionLength = 0 txtFreierText.Focus() End Sub Private Sub Button1_Click(sender As Object, e As EventArgs) Handles btnCLose.Click Me.Close() End Sub Private Sub Button2_Click(sender As Object, e As EventArgs) If insertVermerke() Then VERAG_PROG_ALLGEMEIN.cAvisoBenachrichtigungen.INSERT_BENACHRICHTIGUNG(myAviso.AvisoID, SendungID, 1, "T", 13, , 1) insertSendungsVermerk(SendungID, myAviso.AvisoID, "In die Neukunden-Abteilung gegeben.", 46) frmHauptfenster.avisoAktualisierenAktiveIdBehalten(myAviso.AvisoID) Me.Close() End If End Sub 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 End If 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 End If 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 End If Dim validityHours = CInt(nudCustomerUploadValidityHours.Value) Dim language = "" If cmbCustomerUploadLanguage IsNot Nothing Then language = If(TryCast(cmbCustomerUploadLanguage.SelectedItem, String), "") If language = "" Then language = If(cmbCustomerUploadLanguage.Text, "").Trim() End If language = language.ToLowerInvariant() If language <> "de" AndAlso language <> "en" AndAlso language <> "tr" AndAlso language <> "sr" AndAlso language <> "bg" Then language = "de" End If 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 End If 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) End If MsgBox("E-Mail wurde ausgelöst.", vbInformation) Finally Cursor = Cursors.Default End Try End Sub Private Class CustomerPortalApiConfig Public Property BaseUrl As String Public Property Username As String Public Property Password As String End Class 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 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 Then jwtToken = _customerPortalJwtToken Return True End If If 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 End If _customerPortalJwtToken = token _customerPortalJwtExpUtc = ExtractJwtExpUtcOrMin(token) jwtToken = token Return True End Using End Using Catch ex As WebException 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) errorCode = (If(jobj("message"), New JValue(ex.Message))).ToString() Catch errorCode = ex.Message End Try Else errorCode = ex.Message End If 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 If jwt Is Nothing Then Return DateTime.MinValue Dim parts = 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 End If 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 End If 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 Then Exit Sub If anhangsartId <= 0 Then Exit Sub Dim req As New Dictionary(Of String, Object) From { {"documentType", documentType}, {"anhangsartId", anhangsartId}, {"customText", customText} } requirements.Add(req) 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 End If If anhangsartId <= 0 Then missing.Add(documentType) Exit Sub End If Dim req As New Dictionary(Of String, Object) From { {"documentType", documentType}, {"anhangsartId", anhangsartId}, {"customText", customText} } requirements.Add(req) 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 End If 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 = reader.ReadToEnd() If respText Is Nothing Then respText = "" respText = respText.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 End If _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 End If Try ServicePointManager.SecurityProtocol = SecurityProtocolType.Tls12 Return TryPostCustomerPortalJson(url, jwtToken, jsonBody, linkUrl, errorCode) Catch ex As WebException errorCode = ReadWebExceptionMessage(ex) Return False Catch ex As Exception errorCode = ex.Message Return False End Try 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 End If Try ServicePointManager.SecurityProtocol = SecurityProtocolType.Tls12 Return TryPostCustomerPortalJson(url, jwtToken, jsonBody, linkUrl, errorCode) Catch ex As WebException errorCode = ReadWebExceptionMessage(ex) Return False Catch ex As Exception errorCode = ex.Message Return False End Try 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 End Class