Option Compare Database
Option Explicit

'/**
' * Name der Sequenz-Tabelle
' */
Private Const C_SEQ_TABLE As String = "ADDON_SEQUENZ"
Private Const C_SEQ_TABLE_HIDDEN As Boolean = True

'/**
' * Anweisungen was bei einem create() gemacht werden soll, wenn die Sequenz bereits existiert
'*/
Public Enum seqCreateOnExistOptions
    seqCreateOnExist0           'Mach nix und gib eine 0 zurück
    seqCreateOnExistLastVal     'Mach nix und gib die aktuelle Nummer zurück
    seqCreateOnExistNextVal     'Mach nix und gib setze den Squenz um eins hoch
    seqCreateOnExistReset       'Resete die Sequenz. gibt 1 zurück
    seqCreateOnExistError       'Raise einen Error
End Enum

'/**
' * Anweisung wie sich die entsprechende Funktion verhalten soll, wenn die Sequenz noch nicht exisitert
Public Enum seqNotExistsOptions
    seqNotExistCreate           'erstelle die Sequqnz und gib 1 zurück
    seqNotExist0                'Mach nix und gib eine 0 zurück
    seqNotExistError            'Raise einen Error
End Enum

'/**
' * Private Variablen
' */
Private seqName                 As String
Private cachefilterString       As String

'/**
' * Construktuer
' * @param  String      Name der Sequenz
' */
Public Sub initMe(ByVal iSeqName As String)
    seqName = iSeqName
End Sub

'/**
' * gibt die aktuelle Nummer zurück
' * @param  seqNotExistsOptions     Anweisung, was bei Nichtexistenz der Sequenz geschehen soll
' * @return Aktueller Wert. Aktuelle Nummer oder 0, je nach iOption
' */
Public Property Get lastVal(Optional ByVal iOption As seqNotExistsOptions = seqNotExist0) As Long
    If Me.sequenceExists Then
        lastVal = DMax("last_nr", C_SEQ_TABLE, filterString())
    Else
        lastVal = getSeqNotExists(iOption)
    End If
End Property

'/**
' * prüft, ob die Sequenz existiert
' * @return Boolean
' */
Public Property Get sequenceExists() As Boolean
    sequenceExists = Not (DCount("seq_name", C_SEQ_TABLE, filterString()) = 0)
End Property

'/**
' * Erstellt die Sequenz
' * @param  seqCreateOnExistOptions     Angabe was gemacht werden soll, falls die Sequenz bereits exisitert
' * @return eine 1 oder je nach iOption die Aktuelle Sequenznummer oder 0
' */
Public Function create(Optional ByVal iOption As seqCreateOnExistOptions = seqCreateOnExist0) As Long
    Dim rs As DAO.Recordset
    
    If Me.sequenceExists Then
        Select Case iOption
            Case seqCreateOnExist0:         create = 0
            Case seqCreateOnExistLastVal:   create = Me.lastVal
            Case seqCreateOnExistNextVal:   create = calcVal(seqNotExist0)
            Case seqCreateOnExistError:     Call Err.Raise(vbObjectError, "Sequence.create", "Sequenze [" & seqName & "] allredy exists")
            Case seqCreateOnExistReset:     create = Me.reset
        End Select
    Else
        'Tabelle über DAO öffnen, dmit ich den Record für mich alleine hab
        Set rs = CurrentDb.OpenRecordset(C_SEQ_TABLE)
        Call rs.AddNew
        rs!seq_name = seqName
        rs!last_nr = 1
        rs!last_timestamp = Now()
        Call rs.Update
        Call rs.Close
        Set rs = Nothing
        create = 1
    End If
   
End Function

'/**
' * setzt die Sequenz eins weiter
' * @param  seqNotExistsOptions     Anweisung, was bei Nichtexistenz der Sequenz geschehen soll
' * @return Aktueller Wert. Sequenz-Nr oder 0, je nach iOption
' */
Public Function nextVal(Optional ByVal iOption As seqNotExistsOptions = seqNotExistCreate) As Long
    nextVal = calcVal(iOption)
End Function

'/**
' * setzt die Sequenz auf 1 zurück
' * @param  seqNotExistsOptions     Anweisung, was bei Nichtexistenz der Sequenz geschehen soll
' * @return Aktueller Wert. 1 oder 0, je nach iOption
' */
Public Function reset(Optional ByVal iOption As seqNotExistsOptions = seqNotExistCreate) As Long
    reset = calcVal(iOption, 1)
End Function

'/**
' * Löscht die Sequenz
' */
Public Sub delete()
    Call CurrentDb.execute("DELETE * FROM [" & C_SEQ_TABLE & "] WHERE " & filterString())
End Sub



'/**
' * Den SQL-Filter für den Tabellenzugriff
' * @return String      SQL-Filter
' */
Private Function filterString() As String
    If Nz(cachefilterString) = vbNullString Then cachefilterString = "[seq_name] = '" & seqName & "'"
    filterString = cachefilterString
End Function

'/**
' * Handlet den Fall, dass die Sequenz noch nicht exisitert
' * @param  seqNotExistsOptions      Anleitung was gemacht werden soll
' * @return Long
' */
Private Function getSeqNotExists(ByVal iOption As seqNotExistsOptions) As Long
    Select Case iOption
        Case seqNotExistCreate: getSeqNotExists = Me.create
        Case seqNotExist0:      getSeqNotExists = 0
        Case seqNotExistError:  Call Err.Raise(vbObjectError, "Sequence", "Sequenze [" & seqName & "] not exists")
    End Select
End Function

'/**
' * setzt die neue Nummer
' * @param  Long    Es kann eine Nummer vorgegeben werden. Dann wird die Sequenz auf diese Nummer gesetzt
' * @return Long    Aktuelle neue Nummer
' */
Private Function calcVal(ByVal iOption As seqNotExistsOptions, Optional ByVal iNr As Long = 0)
    Dim rs      As DAO.Recordset
    If Me.sequenceExists Then
        Set rs = CurrentDb.OpenRecordset(C_SEQ_TABLE)
        rs.index = "IDX_SEQ_NAME"
        Call rs.Seek("=", seqName)
        calcVal = IIf(iNr = 0, rs!last_nr + 1, iNr)
        Call rs.Edit
        rs!last_nr = calcVal
        rs!last_timestamp = Now()
        Call rs.Update
        Call rs.Close
        Set rs = Nothing
    Else
        calcVal = getSeqNotExists(iOption)
    End If
End Function

'/**
' * Erstellt die Sequenztabelle falls diese noch nicht exisitert
' */
Private Sub createSequenceTable()
    'Prüfen ob die Tabelle existiert
    If DCount("*", "MSysObjects", "[name] = '" & C_SEQ_TABLE & "'") = 0 Then
        'Tabelle erstellen
        Call CurrentDb.execute("CREATE TABLE " & C_SEQ_TABLE & "(SEQ_NAME CHAR(255) NOT NULL, LAST_NR LONG NOT NULL, LAST_TIMESTAMP DATETIME)")
        'Unique Index 'IDX_SEQ_NAME' erstellen
        Call CurrentDb.execute("CREATE UNIQUE INDEX IDX_SEQ_NAME ON " & C_SEQ_TABLE & " (SEQ_NAME) WITH  PRIMARY")
    End If
    'Tabelle in der Objektübersicht auf Hidden stellen
    Call Application.SetHiddenAttribute(acTable, C_SEQ_TABLE, C_SEQ_TABLE_HIDDEN)
End Sub

'/**
' * Initializeire die Klasse. Prüfen ob die zugrundeliegende Tabelle existiert
' */
Private Sub Class_Initialize()
    Call createSequenceTable
End Sub
