VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Sequence"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'-------------------------------------------------------------------------------
'File         : Sequence.cls
'               Copyright mpl by ERB software
'               All rights reserved
'Environment  : VBA 2007 +
'Version      : 1.1.0
'Name         : Sequence
'Author       : Stefan Erb (ERS)
'History      : 13.11.2013 - ERS - CreationOption Explicit
'               24.06.2014 - ERS - StandartProperty toNext hinzugefügt
'-------------------------------------------------------------------------------
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 seqCreateOptions
    seqCreateOnExistEmpty       'Mach nix und gib eine Empty 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 die StartNz 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
    seqNotExistEmpty            'Mach nix und gib eine Empty zurück
    seqNotExistError            'Raise einen Error
End Enum

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

'/**
' * Standartausgabe als Long
' * @example    Dim nextId as Long: nextId = mySeq
' * @return Long
' */
Public Property Get toNext() As Long
Attribute toNext.VB_UserMemId = 0
    'Attribute Value.VB_UserMemId = 0

    toNext = nextVal
End Property

'/**
' * Construktuer
' * @param  String      Name der Sequenz
' */
Public Sub initialize(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 = seqNotExistEmpty) 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

Public Property Get startValue()
    startValue = cacheStartValue
End Property
Public Property Let startValue(ByVal iStartValue)
    cacheStartValue = iStartValue
    CurrentDb.execute "UPDATE [" & C_SEQ_TABLE & "] SET [START_NR] = " & iStartValue & " WHERE [SEQ_NAME] = '" & seqName & "'"
End Property


'/**
' * Erstellt die Sequenz
' * @param  seqCreateOptions     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 iStartValue As Long = 1, _
        Optional ByVal iOption As seqCreateOptions = seqCreateOnExistEmpty _
) As Long
    cacheStartValue = iStartValue
    If Me.sequenceExists Then
        Select Case iOption
            Case seqCreateOnExistEmpty:     create = Empty
            Case seqCreateOnExistLastVal:   create = Me.lastVal
            Case seqCreateOnExistNextVal:   create = calcVal(seqNotExistEmpty)
            Case seqCreateOnExistError:     Call Err.Raise(vbObjectError, "Sequence.create", "Sequenze [" & seqName & "] allredy exists")
            Case seqCreateOnExistReset:     create = Me.reset
        End Select
    Else
        'Tabelle über DAO öffnen, damit ich den Record für mich alleine hab
        Dim rs As DAO.Recordset: Set rs = CurrentDb.OpenRecordset(C_SEQ_TABLE)
        rs.AddNew
        rs!seq_name = seqName:  rs!last_nr = cacheStartValue: rs!last_timestamp = Now(): rs!start_nr = cacheStartValue
        rs.update: rs.Close: Set rs = Nothing
        create = cacheStartValue
    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, Optional ByVal iStartNr As Variant = Null) As Long
    nextVal = calcVal(iOption, iStartNr)
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, cacheStartValue)
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 seqNotExistEmpty:  getSeqNotExists = Empty
        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 Variant = Null)
    If Me.sequenceExists Then
        Dim rs As DAO.Recordset: Set rs = CurrentDb.OpenRecordset(C_SEQ_TABLE)
        rs.index = "IDX_SEQ_NAME"
        Call rs.Seek("=", seqName)
        calcVal = IIf(IsNull(iNr), rs!last_nr + 1, iNr)
        Call rs.Edit
        rs!last_nr = calcVal
        rs!last_timestamp = Now()
        rs.update: 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, START_NR LONG 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