Imports System.ComponentModel.Composition
Imports BBasic
Imports BBHelper.Helper
Imports BBHelper
Imports System.Windows.Forms
Imports BBasic.DataClass
<Export(GetType(BBasic.IPlugin))>
Public Class MeinPlugin
    Implements BBasic.IPlugin

    '**********************************************
    '*** Hier muss nichts geaendert werden     ****
    '**********************************************
#Region "Daten des Plugins"
    '**********************************************
    '*** Hier muss nichts geaendert werden     ****
    '**********************************************
    '
    'Diese Funktion bezeichnet die Plugin-Funktion >> Plugin-Version
    Public Function PluginVersion() As String Implements BBasic.IPlugin.PluginVersion
        Dim v$, d$
        v$ = System.Reflection.Assembly.GetExecutingAssembly().GetName().Version.ToString()
        d$ = System.IO.File.GetLastWriteTime(System.Reflection.Assembly.GetExecutingAssembly().Location).ToShortDateString()
        Return ("VER/" + Me.PluginName + ":" + v$ + "." + d$)
    End Function
    '>>>>Funktion Plugin Version
    Public Function PluginVersionDate() As Date Implements BBasic.IPlugin.PluginVersionDate
        'Diese Funktion ist wichtig, weil Endkunden die Lizenz gegeben werden kann Updates bis .... zu installieren.
        Return (_PluginVersionDatum)
    End Function

#End Region
#Region "Programmteile zu Pluginverwaltung"
    '**********************************************
    '*** Hier muss nichts geaendert werden     ****
    '**********************************************
    '
    Dim WithEvents bbsys As BBasic.Class_bbsys
    Dim lizenzdaten As BBasic.Class_PluginLizenz
    'Diese Funktion wird von BBasic zum Initialisieren aufgerufen
    Public Function Start(ByRef b As BBasic.Class_bbsys) As Boolean Implements BBasic.IPlugin.Start
        bbsys = b
        '---------------------------------------------------------------------------       
        'Ist die Datenbank aktuell? ggf Abgleich mit Referenzdatenbank
        if _PluginReferenzDatenbank_Server <>"" Then
            CheckIfDbSyncIsNecessary()
        End If
        '---------------------------------------------------------------------------
        If Not (PluginTestLizenz()) Then
            'Das Programm soll ohne Lizenz nicht starten
            MsgBox("Plugin Lizenz nicht vorhanden:" + _PluginName)
            Return (False)
            Exit Function
        End If
        'Hier werden die vom Programmentwickler des Plugins
        'vorgesehenen Initialisierungen vorgenommen
        Call InitMenu()
        Return (True)
    End Function

    '>>>>Funktion LICENESE
    Public Function PluginVerifyLicenseHash(a As String) As Integer Implements BBasic.IPlugin.PluginVerifyLicenseHash
        'Diese Funktion ist wichtig, damit der Lizenzcode nicht von anderen Entwicklern kopiert werden kann
        Return (HashWert(a + _PluginVerifyCode))
    End Function
    'Diese Funktion implementiert die Hash-Function um Lizenzen zu sichern
    Function HashWert(a_str$) As Integer
        Dim nr_lng% = 0
        Dim i_lng% = 1
        Dim t_int%
        Dim laenge_lng% = 1000003
        For t_int% = 1 To Len(a_str$)
            nr_lng% = ((nr_lng% * 256) + Asc(Mid$(a_str$, t_int%, 1))) Mod laenge_lng%
        Next
        Return (nr_lng%)
    End Function
    'Diese Funktion implementiert die Plugin-Funktion >> Plugin-Name
    Public Function PluginName() As String Implements BBasic.IPlugin.PluginName
        Return (_PluginName)
    End Function
    'Diese Funktion implementiert die Lizenz des Nutzers R.Schnurr
    Public Function PluginAuthor() As String Implements BBasic.IPlugin.PluginAuthor
        Return (_PluginLizenz)
    End Function

    Public Function EndkundenLizenzEMail() As String Implements IPlugin.EndkundenLizenzEMail
        If IsNothing(lizenzdaten) Then
            PluginTestLizenz()
        End If
        If IsNothing(lizenzdaten) Then
            Return ("Keine Lizenz")
        Else
            Return (lizenzdaten.KundeEMail)
        End If
    End Function

    Function PluginTestLizenz() As Boolean
        'Lizenz Testen
        If _PluginName = "Muster" Then
            'Keine Lizenz nötig
            Return (True)
            Exit Function
        End If

        'Die Lizenzdaten sollen in der Config gespeichert werden
        Dim a$, b$, z%
        z% = 0
        Do
            z% = z% + 1
            'Teilstring lesen
            b$ = bbsys.Config_ConfigurationSQL("LIZ/" + Me.PluginName + "/" + Trim(str(z%)))
            If b$ <> "" Then 'Teilstring an bestehenden String anhängen
                a$ = a$ + b$
            End If
        Loop Until b$ = "" 'Solange Teilstrings lesen bis kein Ergebnis mehr zurückgegeben wird
        If a$ = "" Then 'Wenn kein Lizenzstring hinterlegt ist
            a$ = InputBox("Lizenz", Me.PluginName) 'Lizenz-String abfragen
            b$ = a$
            z% = 0
            While Len(b$) > 0
                z% = z% + 1 'In Teilstrings a 200 Byte aufsplitten und speichern
                bbsys.Config_ConfigurationSQLSet("LIZ/" + Me.PluginName + "/" + Trim(Str(z%)), Left(b$, 200))
                b$ = Trim(Mid$(b$, 201, 9999))
            End While
        End If

        lizenzdaten = bbsys.Liz_GiveData(a$)
        If lizenzdaten.KundeEMail = "" Then 'Ungültige Lizenz löschen
            bbsys.Config_ConfigurationSQLSet("LIZ/" + Me.PluginName + "/1", "")
            Return (False)
            Exit Function
        End If
        If lizenzdaten.PluginName <> _PluginName Then 'Ungültige Lizenz löschen
            bbsys.Config_ConfigurationSQLSet("LIZ/" + Me.PluginName + "/1", "")
            Return (False)
            Exit Function
        End If
        'Sinnvoll: Lizenz anzeigen
        bbsys.Mainform.GenMenu("prog/lizenz", "prog/lizenz/" + Me.PluginName, "Lizenz " + Me.PluginName, lizenzdaten.KundeEMail + " " + lizenzdaten.User1)
        Return True
    End Function
#End Region
#Region "Programm zum SQL Datenabgleich mit Referenzdatenbank"
    '**********************************************
    '*** Hier muss nichts geaendert werden     ****
    '**********************************************
    '
    '>Zur Kopie in andere Plugnis
    Function CheckIfDbSyncIsNecessary() As Boolean
        ' Test auf Übereinstimmung der aktuellen BBasic Programm-Version / Benutzer ist Entwickler
        ' mit der in Tab config abgelegten Versionsnummer (wird dort nach erfolgter Syncronisation gespeichert)
        ' Return: false - Syncr. nicht nötig / true - Sync. notend whileig (Versionsnummern verschieden)
        ' TSchnurr 30.9.14
        Dim strVersion_BB As String = PluginVersion()
        Dim strVersion_SQL As String = bbsys.Config_ConfigurationSQL ("VER/" + Me.PluginName)
        If strVersion_BB = strVersion_SQL Or bbsys.IsDeveloper() Then
            Return False
        Else
            Dim x As New BBasic.SQLRemoteSync
            x.sqlsync(bbsys, _PluginReferenzDatenbank_Server, _PluginReferenzDatenbank_User, _PluginReferenzDatenbank_Password, _PluginReferenzDatenbank_Port, _PluginReferenzDatenbank_Database)
            bbsys.Config_ConfigurationSQLSet("VER/" + Me.PluginName, PluginVersion())
            Return True
        End If
    End Function
#End Region
    '**********************************************
    '*** Ab hier geht es los... Ihr Part!!!    ****
    '**********************************************
#Region "Lizenzdaten des Entwicklers"   
    'TODO Lizenzdaten die Sie von uns erhalten
    Dim _PluginVerifyCode As String = "ABXV1UEQ89"
    Dim _PluginName As String = "Muster"
    Dim _PluginEntwicklerName As String = "Oliver Fendt"
    Dim _PluginLizenz As String = "lgCAAMRgu5c08s8BjgBFbnR3aWNrbGVyTmFtZT1PbGl2ZXIgRmVuZHQjRU1haWw9b2xpdmVyQG9saXZlci1mZW5kdC5kZSNQbHVnaW5OYW1lPU11c3RlciNVUkw9aHR0cDovL3d3dy5iYmFzaWMuZGUjVmVyc2lvbj0wI0NWPTAjUmFuZG9tPUFCWFYxVUVRODkjPHNlcmlhbD49AQcpBsBhSaGGPZu9CPHgW6aBgIrCJzrquqBx1+aRT504IrZbnmUmj6+LSRKNKZoYoOsZE2T9Qs4CTeZn/3ar9OL0HP5rZ0EYvjAhMjRfk4Dk2mJRyZbL9UQCqRaQZZlIE9/Hzb00EVNGFHPPmS5dGhEANe+E+xyxkmuxpaYzFhN/Ukjky/Dd0spTA31jNsAFjB42hXdy5z3cuwW5xkJeUOkiQG3un9aCfrmGs6i3+9/nvXzc3FKcHwZzosT+wTzZzFlMf4HEW832VFQIYinIKVG5+2RJcCbuqEBFtDiC47msY2B1FyPVZrlQwe+db3iVVQuDACQwat7wXjWglVyTXMF3"
    Dim _PluginReferenzDatenbank_Server As String = "refdb.bbasic.de" 'Leer wenn kein Abgleich erfolgen soll
    Dim _PluginReferenzDatenbank_User As String = "referenz"
    Dim _PluginReferenzDatenbank_Password As String = "datenbank"
    Dim _PluginReferenzDatenbank_Port As String = "6612"
    Dim _PluginReferenzDatenbank_Database As String = "schnurrplugin"
    Dim _PluginVersionDatum As New Date(2022, 9, 13)

    'Diese Funktion implementiert die Plugin-Info-Funktion
    Public Function PluginInfo() As String Implements BBasic.IPlugin.PluginInfo
        Return ("Dies ist ein Testplugin.")
    End Function
#End Region
#Region "Variablen für das Plugin"
    'Dim WithEvents xxx As meine ErweiterungsDLL
#End Region
#Region "Einbindung in das bestehende Programm"
    'TODO Das Programm
    '*****************
    'Einbindung in das Menu-System
    Sub InitMenu()
        Dim x As system.Windows.Forms.ToolstripMenuItem
        x = bbsys.Mainform.GenMenu("", "abo", "Aboverwaltung", "")
        x = bbsys.Mainform.GenMenu("abo", "abo/sel", "Abos Selektieren", "")
        x = bbsys.Mainform.GenMenu("abo", "abo/buchen", "Abos buchen", "")
        'So ändert man Menu-Einträge
        x.ForeColor = Drawing.Color.Blue
        x = bbsys.Mainform.GenMenu("abo", "abo/liste", "Abos auflisten", "")
    End Sub
    Private Sub bbsys_BBSysMenuClick(ByRef a As String, ByRef x As Form) Handles bbsys.MenuClick
        'Diese Funktion ist wichtig,
        'sie wird aufgerufen wenn ein Menu-Eintrag angeclickt wird.
        Select Case a$
            Case "abo/liste"
                Call aboliste
            Case "abo/sel"
                Call aboselect()
            Case "abo/buchen"
                Call abobuchen
            Case Else
        End Select
    End Sub
    '*****************
    'Ende: Einbindung in das Menu-System
    '*****************
    'Einbindung in bestehende Formulare: Name herausfinden über MSGBOX oder DEBUG
    Private Sub bbsys_BBSysTextbildStartEingabe(tb As Class_Textbild, maxzeilen As Integer, ByRef formid As String) Handles bbsys.TextbildStartEingabe
        'Um unbekannte Funktionen herauszufinden
        'bbsys.XMsgBox(formid)
        Select Case formid
            Case "KDNEU"
                tb.fdef(11, "Abo")
            Case Else
        End Select
    End Sub

    Private Sub bbsys_BBSysStammdatenWeiter(tb As EingabeBild, id As Integer, funk As String, ftaste As Integer) Handles bbsys.StammdatenWeiter
        Select Case funk
            Case "KD"
                'Funtionstasten sind 11-22 =F1-F12 31-42=Shift-F1...
                If ftaste = 21 Then
                    Call abos(id)
                End If
            Case Else
        End Select
    End Sub
    '*****************
#End Region
#Region "Die eigenen Funktionen"

    Sub abos(PointerToKunde%)
        Dim rs As New BBRecordset
        Dim rs2 As New BBRecordset
        Dim kunde As New BBasic.DataClass.Customer(bbsys)
        kunde.Load(PointerToKunde)
aborestartaufbau:
        Dim tb2 As New BBasic.EingabeBild(bbsys)
        tb2.fdef(1, "Anlegen")
        tb2.edef("Kunde", kunde.Adress.Name, Class_bbsys.TextbildLaengen.TBL_Normal, "KUNDE", Class_bbsys.TextbildFlags.TBF_SperreKannAufgehobenWerden, 0)
        tb2.eedef("Abos", "SELECT abos.ID,artikel.name,abos.lmod,abos.startdatum,abos.enddatum from " + bbsys.MySqlMandant + ".artikel, " + bbsys.MySqlMandant + ".abos where abos.pointertokunde=" + Str(PointerToKunde) + " AND abos.pointertoartikel=artikel.id order by lmod desc", Class_bbsys.TextbildLaengen.TBL_SQLTabelle, "ABOS", 5, 2, 25, 45, Class_bbsys.TextbildFlags.TBF_Normal, 0)
        tb2.Eingabe("ABOX1")
        While tb2.ReturnCode < 0
            tb2.Wartebischen()
            If tb2.A_Event = Class_bbsys.TextbildEvent.A_Click Then
                Dim z% = tb2.A_Row
                Dim sp% = tb2.A_Col
                Dim m_id% = Val(tb2.TextbildTabelleGetWert(tb2.A_TabID, z%, 1))
                Dim pointerToAbo% = Val(tb2.TextbildTabelleGetWert(tb2.A_TabID, z%, 0))
                Dim merkm$ = tb2.TextbildTabelleGetWert(tb2.A_TabID, z%, 2)
                Dim todo% = bbsys.PopUpMenu("Abo/ändern/Abo löschen/")
                Select Case todo%
                    Case 1
                        Dim tb3 As New BBasic.EingabeBild(bbsys)
                        bbsys.SqlSelect(rs, "SELECT * from " + bbsys.MySqlMandant + ".abos where id=" + str(pointerToAbo%))
                        Dim artikel As New DataClass.Merchandise(bbsys)
                        artikel.Load(rs.GetInteger("Pointertoartikel"))
                        tb3.edef("Artikel", artikel.Name, Class_bbsys.TextbildLaengen.TBL_Lang, "ART", Class_bbsys.TextbildFlags.TBF_SperreKannAufgehobenWerden, 0)
                        tb3.edef("Von Datum", rs.GetBBDate("Startdatum").DatumStr, Class_bbsys.TextbildLaengen.TBL_Datum, "START")
                        tb3.edef("Bis Datum", rs.GetBBDate("Enddatum").DatumStr, Class_bbsys.TextbildLaengen.TBL_Datum, "END")
                        tb3.edef("Bemerkung", rs.GetString("bemerkung"), Class_bbsys.TextbildLaengen.TBL_Normal, "BEMERKUNG")
                        tb3.Eingabe("ABONEU")
                        While tb3.ReturnCode < 0
                            tb3.Wartebischen()
                        End While
                        If tb3.ReturnCode > 0 Then
                            tb3.Entfernen()
                            GoTo aborestartaufbau
                        End If
                        Dim vondatum As New BBDate
                        Dim bisdatum As New BBDate
                        vondatum.DatumStr = tb3.Text("START")
                        bisdatum.DatumStr = tb3.Text("END")
                        Dim sqlx$ = "UPDATE " + bbsys.MySqlMandant + ".abos LMOD=now(), pointertouser=" + Str(bbsys.AktiveUser_InterneUserNummer) + ", Enddatum=" + bisdatum.QSQLDT + ", Startdatum=" + vondatum.QSQLDT + " ,bemerkung=" + SQL.QSQLString(tb3.Text("BEMERKUNG")) + " where id=" + Str(pointerToAbo%)
                        bbsys.SQLExecuteW(sqlx$)
                        tb3.Entfernen()
                        GoTo aborestartaufbau
                    Case 2
                        If bbsys.WarteJaNein("ABO wirklich löschen", "NJ") = "J" Then
                            Dim sqlx$ = "DELETE from " + bbsys.MySqlMandant + ".abos where id=" + str(pointerToAbo%)
                            bbsys.SQLExecuteW(sqlx$)
                        End If
                        GoTo aborestartaufbau
                    Case Else
                End Select
            End If
        End While
        If tb2.ReturnCode = 11 Then 'F1=Neu anlegen
            Dim tb3 As New BBasic.EingabeBild(bbsys)
            Dim vondatum As New BBDate
            Dim bisdatum As New BBDate
            vondatum.SetToday()
            bisdatum.SetEndless()
            tb3.edef("Artikel", "", Class_bbsys.TextbildLaengen.TBL_Lang, "ARTIKEL")
            tb3.edef("Von Datum", vondatum.DatumStr, Class_bbsys.TextbildLaengen.TBL_Datum, "START")
            tb3.edef("Bis Datum", bisdatum.DatumStr, Class_bbsys.TextbildLaengen.TBL_Datum, "END")
            tb3.edef("Bemerkung", "", Class_bbsys.TextbildLaengen.TBL_Normal, "BEMERKUNG")
            tb3.Eingabe("ABONEU")
            While tb3.ReturnCode < 0
                tb3.Wartebischen()
            End While
            If tb3.ReturnCode > 0 Then
                tb3.Entfernen()
                GoTo aborestartaufbau
            End If
            Dim bbasic As New XBBMain(bbsys, "ABO Neu ist mein titel")
            Dim artid%, wgid%
            artid% = bbasic.ArtikelSuchen(tb3.Text("ARTIKEL"))
            vondatum.DatumStr = tb3.Text("START")
            bisdatum.DatumStr = tb3.Text("END")
            If artid% > 0 Then
                Dim sqlx$ = "INSERT INTO " + bbsys.MySqlMandant + ".abos set LMOD=now(), abgerechnetbis=now(), pointertouser=" +
                    Str(bbsys.AktiveUser_InterneUserNummer) + ", mandant=" + Str(bbsys.Setting.AktuellerMandant) +
                    ", Enddatum=" + bisdatum.QSQLDT + ", Startdatum=" + vondatum.QSQLDT + " , pointertokunde=" + Str(PointerToKunde%) + ", Pointertoartikel=" + Str(artid) + " ,bemerkung=" + SQL.QSQLString(tb3.Text("BEMERKUNG"))
                bbsys.SQLExecuteW(sqlx$)
            End If
            GoTo aborestartaufbau
        End If
        tb2.Entfernen()


    End Sub

    Sub aboselect()
        Dim rs As New BBRecordset

        Dim bbasic As New XBBMain(bbsys, "ABOSELECT")
        Dim aboid%
        aboid = bbasic.ArtikelSuchen(bbsys.InputBox("Artikel", "BBasic"))
        If Not (bbsys.Rechte_TestUserRecht ("ABOS/SELECT/" + ConvertToString(aboid) + "/")) Then Exit Sub
        Dim sqlx$ = "SELECT * from " + bbsys.MySqlMandant + ".abos where PointerToArtikel =" + str(aboid)
        bbsys.SqlSelect(rs, sqlx$)
        Dim pbar As New BBasic.Prozessbar(bbsys, "Suche Abos", 100)
        pbar.Abbrechen_Visible()
        Dim kunde As New DataClass.Customer(bbsys)

        Dim li2 As New BBasic.Liste2(bbsys, Class_bbsys.LI2Typ.Li2Typkunden, "Aboliste")
        li2.GenMenu("", "merkm", "Merkmal", "")
        li2.GenMenu("merkm", "merkm/select/", "Diese Kunden selectieren", "")
        li2.GenMenu("merkm", "merkm/deselect/", "Diese Kunden deselectieren", "")
        li2.GenMenu("merkm", "merkm/set/", "Diese Kunden Neues Merkmal setzen", "")
        li2.GenMenu("merkm", "merkm/kill/", "Merkmal entfernen", "")
        li2.GenMenu("merkm", "merkm/list/", "Liste mit Designer", "")
        li2.Show
        While Not (rs.EOF) And Not (pbar.Abgebrochen)
            pbar.ok()
            kunde.Load(rs.GetInteger("PointerToKunde"))
            li2.Add(kunde.Id.ToString + vbTab + kunde.Konto.AccountingUniqueID + vbTab + kunde.Adress.Name + vbTab + kunde.Adress.Ort)
            rs.MoveNext()
        End While
        rs.CloseRecordset()
        pbar.Entfernen()
    End Sub

    Sub aboliste()
        Dim rs As New BBRecordset
        If Not (bbsys.Rechte_TestUserRecht("ABOS/LIST/")) Then Exit Sub
        Dim druck As Drucker
        druck = bbsys.DruckInitUndStart("Liste der Abos", "", 0, Class_bbsys.DruckerFlag.Druck_Normaleausgabe, Class_bbsys.ListAusgabe.ListAusgabe_AnwenderFragen)
        druck.SetSchrift("SmallFont", 7)
        druck.ZeileDrucken("unabhängig von der möglichen Buchungsperiode")
        druck.ZeileDrucken("")
        druck.TabelleStart("<1900|<3200|>1000|>1800|>2500", "Abo|Kunde|Abo-Preis|Periode|Bemerk")
        Dim Artikel As New DataClass.Merchandise(bbsys)
        Dim kunde As New DataClass.Customer(bbsys)
        Dim sqlx$ = "SELECT * from " + bbsys.MySqlMandant + ".abos order by pointertoartikel, pointertokunde"
        Dim ianr% = 0
        Dim anzabos% = 0
        bbsys.SqlSelect(rs, sqlx$)
        While Not (rs.EOF)
            If ianr <> rs.GetInteger("Pointertoartikel") Then
                If anzabos% > 0 Then
                    druck.TabelleBunt("" + "|Summe Abos" + str(anzabos) + "|" + "" + "|" + Artikel.Name + "|", Drucker.TabellenFarbe.TABF_Normal)
                End If
                ianr% = rs.GetInteger("Pointertoartikel")
                Artikel.Load(ianr)
                anzabos = 0
                druck.TabelleBunt(Artikel.Name + "|" + "" + "|" + "" + "|" + "" + "|", Drucker.TabellenFarbe.TABF_Grau)
            End If
            kunde.Load(rs.GetInteger("Pointertokunde"))
            anzabos = anzabos + 1
            'abo_Preis# = Local.FormatierteZahl(rs.Fields("Preis"))
            druck.TabelleBunt("" + "|" + kunde.Konto.AccountingUniqueID + " " + kunde.Adress.Name + "|" + FormatierteZahl(rs.GetDouble("Preis")) + "|" + rs.GetString("abgerechnetbis") + "|" + rs.GetString("bemerkung"), Drucker.TabellenFarbe.TABF_Normal)
            rs.MoveNext()
        End While
        If anzabos > 0 Then
            druck.TabelleBunt("" + "|Summe Abos" + str(anzabos) + "|" + "" + "|" + Artikel.Name + "|", Drucker.TabellenFarbe.TABF_Grau)
        End If
        rs.CloseRecordset()
        druck.Endprint()
    End Sub

    Public Sub abobuchen()
        '-------------------------
        Dim rs As New BBRecordset
        Dim artikel As New DataClass.Merchandise(bbsys)
        Dim kunde As New DataClass.Customer(bbsys)
        Dim bbasic As New XBBMain(bbsys, "ABO Buchen")
        Dim tb As New BBasic.EingabeBild(bbsys)
        Dim periodendatum As New BBDate
        tb.edef("Artikel", "", Class_bbsys.TextbildLaengen.TBL_Artikel, "ARTIKEL")
        tb.edef("Für Datum", periodendatum.DatumStr, Class_bbsys.TextbildLaengen.TBL_Datum, "DATUM")
        '        tb.xedef("Zeitraum/Monatlich/Vierteljahr/Halbjahr/Jährlich/", "1", Class_bbsys.TextbildLaengen.TBL_Integer, 3, Class_bbsys.TextbildFlags.TBF_ListBox, 0)
        tb.Eingabe(2, "ABOBuchen")
        While tb.ReturnCode < 0
            tb.Wartebischen()
        End While
        If tb.ReturnCode > 0 Then
            tb.Entfernen()
            Exit Sub
        End If
        Dim aboid%
        aboid% = tb.TXTInteger("ARTIKEL")
        If aboid = 0 Then
            tb.Entfernen()
            Exit Sub
        End If
        Dim today As New BBDate
        today.SetToday()
        periodendatum.DatumStr = tb.Text("DATUM")
        artikel.Load(aboid)
        Dim rebem$ = "Folge_ABO-Buchung"
        Dim bem2$ = "ABO: " + periodendatum.YYYYMMDD + " " + artikel.Name
        Dim sqlx$ = "SELECT * from " + bbsys.MySqlMandant + ".abos where PointerToArtikel =" + str(aboid) + " and "
        sqlx$ = sqlx$ + "Enddatum >" + periodendatum.QSQLDT + " and startdatum <= " + periodendatum.QSQLDT + " and abgerechnetbis < " + today.QSQLDT
        bbsys.SqlSelect(rs, sqlx$)

        Dim anz As Integer = 0
        While Not (rs.EOF)
            anz = anz + 1
            '------------------------
            Dim abo_preis# = rs.GetDouble("Preis")
            Dim mandant% = rs.GetInteger("Mandant")
            Dim KDInterneNr% = rs.GetInteger("Pointertokunde")
            kunde.Load(KDInterneNr)
            Dim trid% 'Transaktionsid damit das Programm die korrekte Reihenfolge überprüfen kann
            bbsys.TransAktionStarten("ABO:" + kunde.Adress.Name, trid%)
            artikel.Load(aboid)                                         'Abo-Artikel laden

            Dim _ketteninfo As KettenInfo = bbasic.Fakt_REPOS_StarteKette("ABO")
            'Hier werden Artikel für die Rechnung geschrieben ... eine Zeile pro Artikel
            bbasic.Fakt_REPOS_EinzelneKettenZeileSchreiben(_ketteninfo, aboid, 1, abo_preis#, "", 0, Space$(1), 0#, 0, 0&)
            'Alle Zeilen fertig
            bbasic.Fakt_REPOS_KetteAbschliessen(_ketteninfo)
            Dim ausgre As DataClass.CustomerBills = bbasic.Fakt_AusgangsrechnungAnlegen(False, "ABO:" + kunde.Adress.Name + " " + artikel.Name, kunde.Id, _ketteninfo.Startwert, 0, today, "Musterplugin Rechnung", bem2$, 0)
            Dim InterneNr% = ausgre.Id
            '--------------------------------------
            'TODO?? Soll Lagerbuchung durchgeführt werden?
            Dim lagerok_int%
            bbasic.Art_LagerBestandVeraendernOderTesten(aboid, 1, abo_preis, XBBMain.BestandveraenderungsFlag.BESTANDVFLagerAbbuchen, lagerok_int%, "ABO " + ausgre.ExtNummer + " " + kunde.Adress.Name, 0, kunde.Konto.AccountingUniqueID)
            '------------------------------------------------bis hier------------------------------
            'TODO?? Soll Rechnung gedruckt werden?  (Wenn Kommunikationsflag Fibu wird automatisch per Mail verschickt)
            bbasic.Fakt_RechnungDrucken_Sub_Designer(ausgre.Id, "ABORECHNUNG", 1, 0, 0, Class_bbsys.ListAusgabe.ListAusgabe_Drucker, True, True)
            Dim bemerkung$
            '---------------------------------------
            'SEPA - Lastschrift anlegen
            '---------------------------------------
            If kunde.Adress.PaymentMode > 0 Then 'Darf ich beim Kunden LASTSCHRIFT machen?
                Dim bank As New DataClass.Banken(bbsys)
                If bank.TryLoadBank(kunde.Adress.Id) Then 'Ist eine Bank beim Kunden hinterlegt
                    Dim last As New DataClass.Direct_Debit(bbsys) 'SEPA Lastschrift
                    Dim lastid% = last.Create_SEPA(kunde.Adress.Name, kunde.Konto.AccountingUniqueID + "ABO",
                                                   kunde.Adress.Banking_Sepa_MandateID, kunde.Adress.Banking_Sepa_MandateDate,
                                                        "ABO " + artikel.Name + " " + periodendatum.YYYYMM,
                                                        bank.IBAN, bank.BIC,
                                                        genAbsolute(ausgre.Open_Value), 0, kunde.Konto.AccountingUniqueID, "Last " + periodendatum.YYYYMM,
                                                        kunde.Adress.EMail, 0)
                    bemerkung$ = "Lastschrift " + lastid.ToString
                Else
                    bemerkung$ = "Keine Lastschrift"
                End If
            Else
                bemerkung$ = "Keine Lastschrift"
                '  Kunde zahlt selbst
            End If
            sqlx$ = "UPDATE " + bbsys.MySqlMandant + ".abos SET abgerechnetbis=" + periodendatum.QSQLDT + ", bemerkung=" + SQL.QSQLString(bemerkung) + " where ID=" + rs.GetInteger("ID")
            bbsys.SQLExecuteW(sqlx$)
            bbsys.TransAktionBeenden("ABO:" + kunde.Adress.Name, trid%, False)
            '--------------------------------------------------------------------------------------------
            rs.MoveNext()
        End While
        rs.CloseRecordset()
        bbsys.MsgBox("heutige Abobuchungen automatisch verarbeitet")

    End Sub
    Private Sub bbsys_BBSysListe2Menu(id As Liste2, menu As String) Handles bbsys.Liste2_Menu
        Select Case menu
            Case "merkm/select/"
                Dim t%
                Dim fibukonto As New BBasic.DataClass.FinacialAccount(bbsys)
                For t = 1 To id.Grid.Rows
                    fibukonto.Load_By_AccountUniqueID(id.Grid.TextMatrix(t - 1, 1))
                    Dim kunde As New DataClass.Customer(bbsys)
                    kunde.Load_By_AccountID(fibukonto.Id)
                    If Not (kunde.IsSelected) Then
                        kunde.IsSelected = True
                        kunde.Save()
                    End If
                Next
            Case "merkm/deselect/"
                Dim t%
                Dim fibukonto As New BBasic.DataClass.FinacialAccount(bbsys)
                For t = 1 To id.Grid.Rows
                    fibukonto.Load_By_AccountUniqueID(id.Grid.TextMatrix(t - 1, 1))
                    Dim kunde As New DataClass.Customer(bbsys)
                    kunde.Load_By_AccountID(fibukonto.Id)
                    If (kunde.IsSelected) Then
                        kunde.IsSelected = False
                        kunde.Save()
                    End If
                Next
            Case "merkm/list/"
                Dim textbild As New Class_Textbild(bbsys, "Kunde Selectieren")
                Call textbild.eedef("Welche Kunden/Selektierte/Alle/Testausdruck 10 St./", "1", Class_bbsys.TextbildLaengen.TBL_Zahl2stelling, 1, 5, 2, 5, 25, Class_bbsys.TextbildFlags.TBF_ListBox, 0)
                Call textbild.eedefx(Meldung.Meldungstext.DesignerAktivieren, "0", Class_bbsys.TextbildLaengen.TBL_Zahl2stelling, 2, 6, 2, 6, 25, Class_bbsys.TextbildFlags.TBF_ListBox, 0)
                Call textbild.eedef("Information/Nicht speichern/Speichern/", "1", Class_bbsys.TextbildLaengen.TBL_Zahl2stelling, 3, 7, 2, 7, 25, Class_bbsys.TextbildFlags.TBF_ListBox, 0)
                Call textbild.eedef("Art/Liste/Ettiketten (Briefe)/Kartei/", "1", Class_bbsys.TextbildLaengen.TBL_Zahl2stelling, 4, 8, 2, 8, 25, Class_bbsys.TextbildFlags.TBF_ListBox, 0)
                Call textbild.eedef("Ab laufender Nr", "1", Class_bbsys.TextbildLaengen.TBL_Integer, 5, 9, 2, 9, 25, 0, 0)
                textbild.Eingabe(5, "KDLISTMM")
                While textbild.ReturnCode < 0
                    textbild.Wartebischen
                End While
                Dim Flag% = textbild.TXTInteger(1)
                Dim xNr% = textbild.TXTInteger(2) + 1
                Dim ispeich_int% = textbild.TXTInteger(3)
                Dim druck_art% = textbild.TXTInteger(4)
                Dim xstart% = textbild.TXTInteger(5)
                Dim fibukonto As New BBasic.DataClass.FinacialAccount(bbsys)
                Dim kunde As New DataClass.Customer(bbsys)
                fibukonto.Load_By_AccountUniqueID(id.Grid.TextMatrix(1, 1))
                kunde.Load_By_AccountID(fibukonto.Id)
                Dim anz% = id.Grid.Rows
                Dim designer As New ListLabel
                druck_art = Class_bbsys.ListTypen.ListTyp_Liste

                Dim Datei$ = designer.init(druck_art, "KD", "Selektionsliste", bbsys.Setting.Path_BBasicData + "\listen\Kunden\", bbsys)

                designer.Definiere_KundenStandard(kunde.Id, druck_art)
                designer.DefSortOrder(1, "Name")
                designer.DefSortOrder(2, "Ort")
                designer.DefSortOrder(3, "Bemerkung1")
                designer.DefSortOrder(4, "Bemerkung2")
                designer.DefSortOrder(5, "Kundennummer")
                designer.DefSortOrder(6, "Suchbegriff")
                designer.DefSortOrder(7, "FiBu Kontoname")
                designer.DefSortOrder(8, "Umsatz")
                designer.DefSortOrder(9, "USTID")
                designer.DefSortOrder(10, "Statistik")

                If xNr% = 2 Then
                    designer.Neueliste(Datei)
                End If
                Dim fehlerkode% = designer.StartListe("Selektionsliste", Datei, Class_bbsys.ListAusgabe.ListAusgabe_AnwenderFragen, Class_bbsys.ListStartliste.ListStart_DateiAuswahl, "", "", 0, 0, "", "")
                If fehlerkode% < 0 Then
                    Exit Sub
                End If
                Dim a$ = designer.GetSortOrder
                Dim sort% = Val(a$)
                Dim pb As New Prozessbar(bbsys, "Liste verarbeiten", anz)
                Dim tempd As New BBasic.TempListe
                Dim itc As InternTempClass
                Dim n% = 0
                For t = 1 To anz
                    pb.SetAktuell(t)
                    fibukonto.Load_By_AccountUniqueID(id.Grid.TextMatrix(t - 1, 1))
                    kunde.Load_By_AccountID(fibukonto.Id)
                    n = n + 1
                    itc = New InternTempClass
                    itc.Text = kunde.sortfeld(sort)
                    itc.Pointer = kunde.Id
                    tempd.add(itc)
                Next
                textbild.Entfernen()
                tempd.Sort()
                For t = 1 To tempd.Count
                    pb.SetAktuell(t)
                    Dim nr_lng% = tempd.Sorted(t%)
                    designer.Definiere_KundenStandard(nr_lng, druck_art)
                    designer.drucken()
                Next
                pb.Entfernen()
                designer.PrintEnd()
                designer.Ende()
            Case "merkm/set/"
                Dim fibukonto As New BBasic.DataClass.FinacialAccount(bbsys)
                Dim kunde As New DataClass.Customer(bbsys)
                Dim merk% = bbsys.Merkmal_Suchen("Merkmal für Selektion")
                If merk% <> 0 Then
                    Dim xa$ = InputBox("Kurztext", "Merkmal", "")
                    Dim t%
                    Dim anz% = id.Grid.Rows
                    For t = 1 To anz
                        fibukonto.Load_By_AccountUniqueID(id.Grid.TextMatrix(t - 1, 1))
                        bbsys.Merkmal_AnlegenSub(FiBuKonto, merk, xa$)
                    Next
                End If
            Case "merkm/kill/"
                Dim fibukonto As New BBasic.DataClass.FinacialAccount(bbsys)
                Dim kunde As New DataClass.Customer(bbsys)
                Dim merk% = bbsys.Merkmal_Suchen("Merkmal zum Löschen")
                If merk% <> 0 Then
                    Dim t%
                    Dim anz% = id.Grid.Rows
                    For t = 1 To anz
                        fibukonto.Load_By_AccountUniqueID(id.Grid.TextMatrix(t - 1, 1))
                        Dim sqlx$ = "DELETE from " + bbsys.MySqlMandant + ".Merkmale where PointerToFibukonto = " + str$(fibukonto.Id) + " and Merkmal=" + str(merk)
                        bbsys.SQLExecuteW(sqlx$)
                    Next
                End If
            Case Else
        End Select
    End Sub
    Private Sub bbsys_BBSysKundenInfoDruck(druck As Drucker, kd As Customer) Handles bbsys.KundenInfoDruck
        Dim rs As New BBRecordset
        Dim sqlx$= "SELECT abos.ID,artikel.name,abos.lmod,abos.startdatum,abos.enddatum from " + bbsys.MySqlMandant + ".artikel, " + bbsys.MySqlMandant + ".abos where abos.pointertokunde=" + str(kd.id) + " AND abos.pointertoartikel=artikel.id order by lmod desc"
        bbsys.SqlSelect(rs,sqlx$)
        If rs.NOF Then
            druck.ZeileDrucken("")
            druck.SetSchrift("Arial",16)
            druck.ZeileDrucken("Abos Mustermakro")
            druck.SetSchrift("SmallFont",10)
            druck.TabelleStart("<1000|2000|1000","ID|Artikel|Enddatum")
            Dim a$
            While rs.NOF
                a$=ConvertToString(rs.GetInteger("id"))+"|"+rs.GetString("name")+"|"+rs.GetBBDate ("enddatum").DatumStr
                druck.TabelleBunt(a$,Drucker.TabellenFarbe.TABF_Normal )
                rs.MoveNext
            End While
            rs.CloseRecordset
        End If
    End Sub

#End Region
End Class