205 lines
6.2 KiB
OpenEdge ABL
205 lines
6.2 KiB
OpenEdge ABL
VERSION 1.0 CLASS
|
|
BEGIN
|
|
MultiUse = -1 'True
|
|
Persistable = 0 'NotPersistable
|
|
DataBindingBehavior = 0 'vbNone
|
|
DataSourceBehavior = 0 'vbNone
|
|
MTSTransactionMode = 0 'NotAnMTSObject
|
|
END
|
|
Attribute VB_Name = "CNummernband"
|
|
Attribute VB_GlobalNameSpace = False
|
|
Attribute VB_Creatable = True
|
|
Attribute VB_PredeclaredId = False
|
|
Attribute VB_Exposed = False
|
|
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
|
|
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
|
|
'==============================================================================
|
|
'
|
|
' File : Nummernband.cls
|
|
' Date : 12.02.1999
|
|
' Version: 1.00
|
|
' Author : Andreas Schmidt, lindner&partner
|
|
'
|
|
'==============================================================================
|
|
'
|
|
' Nummernband
|
|
'
|
|
'==============================================================================
|
|
'
|
|
' History:
|
|
'
|
|
' Date : 12.02.1999
|
|
' Version: 1.00
|
|
' Author : Andreas Schmidt, lindner&partner
|
|
'
|
|
' Erste Version.
|
|
'
|
|
'==============================================================================
|
|
|
|
Option Explicit
|
|
|
|
' Private Member
|
|
' --------------
|
|
Private m_lNummernbandID As Long
|
|
Private m_AnzahlInProzent As Byte
|
|
|
|
'------------------------------------------------------------------------------
|
|
' Öffentliche Funktionalität
|
|
'------------------------------------------------------------------------------
|
|
|
|
' @return Interne ID des Nummernbands
|
|
'
|
|
Public Function getID() As Long
|
|
getID = m_lNummernbandID
|
|
End Function
|
|
|
|
'Todo
|
|
Public Function loadForTestzaehler() As Boolean
|
|
Exit Function
|
|
loadForTestzaehlerOK:
|
|
loadForTestzaehler = True
|
|
Exit Function
|
|
loadForTestzaehlerFehler:
|
|
loadForTestzaehler = False
|
|
End Function
|
|
|
|
|
|
' @return Letzte verwendete Nr. des Nummernbandes oder -1, wenn
|
|
' der Nummerbanddatensatz nicht gefunden wurde
|
|
'
|
|
' Diese Methode manipuliert keine Member und sollte es auch in
|
|
' Zukunft *nicht* tun!
|
|
'
|
|
Public Function getLetzteNr() As Long
|
|
Dim sSQL As String
|
|
Dim rs As New CRecordset
|
|
|
|
sSQL = "SELECT "
|
|
sSQL = sSQL & "letzteNr "
|
|
sSQL = sSQL & "FROM Nummernband "
|
|
sSQL = sSQL & "WHERE "
|
|
sSQL = sSQL & "Nummernband.NummernbandID = " & m_lNummernbandID
|
|
|
|
If rs.openRS(sSQL, True) Then
|
|
If rs.RecordCount = 0 Then
|
|
getLetzteNr = -1
|
|
Else
|
|
getLetzteNr = rs.getLongValue("letzteNr")
|
|
End If
|
|
End If
|
|
|
|
End Function
|
|
|
|
' Letzte Nr. neu zuweisen. Wird sofort gespeichert.
|
|
'
|
|
' @return true = Satz wurde erfolgreich aktualisiert
|
|
' false = Satz hatte bereits diese oder eine höhere letzte Nr.
|
|
' Aktualisierung wurde nicht durchgeführt.
|
|
'
|
|
Public Function setLetzteNr(lNr As Long) As Boolean
|
|
Dim sSQL As String
|
|
Dim SQL As New CSQL
|
|
|
|
sSQL = "UPDATE "
|
|
sSQL = sSQL & "Nummernband "
|
|
sSQL = sSQL & "SET "
|
|
sSQL = sSQL & "letzteNr = " & lNr & " "
|
|
sSQL = sSQL & "WHERE "
|
|
sSQL = sSQL & "Nummernband.NummernbandID = " & getID()
|
|
sSQL = sSQL & ";"
|
|
|
|
Dim lLetzteNr As Long
|
|
lLetzteNr = getLetzteNr()
|
|
|
|
' -1 zeigt an, daß die letzte Nr. nicht ermittelt werden konnte
|
|
If lLetzteNr > -1 Then
|
|
If lLetzteNr < lNr Then setLetzteNr = SQL.executeSQL(sSQL)
|
|
End If
|
|
|
|
End Function
|
|
|
|
|
|
Public Function getTestSeriennummer()
|
|
Dim sSQL As String
|
|
Dim SQL As New CSQL
|
|
Dim rs As New CRecordset
|
|
|
|
sSQL = "SELECT * from Nummernband WHERE NummernbandID=99"
|
|
|
|
'Todo : Fehlerbehandlung: keine 99, mehrfacheintrage,
|
|
' Warnung bei Nummernband erschöpft letzteNr + 1000 >= bisSeriennummer
|
|
|
|
If rs.openRS(sSQL, True) Then
|
|
If rs.RecordCount > 0 Then
|
|
getTestSeriennummer = rs.getLongValue("letzteNr")
|
|
End If
|
|
End If
|
|
End Function
|
|
|
|
|
|
'------------------------------------------------------------------------------
|
|
' Private Funktionalität
|
|
'------------------------------------------------------------------------------
|
|
|
|
' @see loadForKunde
|
|
'
|
|
' Nummernband für einen Kunden und Produkttyp suchen
|
|
'
|
|
' 1. Zuerst überprüfen, ob es zu der übergebenen Kombination von Kunden-Nr. und
|
|
' Typ ein Datensatz in der Tabelle "KundeTypNummernband" existiert.
|
|
' 2. Falls nicht, prüfen, ob zu dem Kunden ein Datensatz mit dem Typ "*"
|
|
' vorhanden ist.
|
|
' 3. Falls nicht, ist nach der Kunden-Nr. '0' und dem vorgegebenen Typ zu
|
|
' suchen.
|
|
' 4. Falls auch das zu keinem Treffer führt, ist nach der Kunden-Nr. '0' und
|
|
' dem Typ "*" zu suchen. Das sollte *immer* zu einem Treffer führen.
|
|
'
|
|
Public Function loadForKundeTyp(lKunde As Long, sTyp As String, sTypzusatz As String) As Boolean
|
|
If internLoadForKundeTyp(lKunde, sTyp, sTypzusatz) Then GoTo loadForKundeTypExitOK
|
|
If internLoadForKundeTyp(lKunde, "*", sTypzusatz) Then GoTo loadForKundeTypExitOK
|
|
If internLoadForKundeTyp(lKunde, "*", "*") Then GoTo loadForKundeTypExitOK
|
|
If internLoadForKundeTyp(lKunde, "*", "") Then GoTo loadForKundeTypExitOK
|
|
If internLoadForKundeTyp(0, sTyp, sTypzusatz) Then GoTo loadForKundeTypExitOK
|
|
If internLoadForKundeTyp(0, "*", "") Then GoTo loadForKundeTypExitOK
|
|
Exit Function
|
|
|
|
loadForKundeTypExitOK:
|
|
loadForKundeTyp = True
|
|
Exit Function
|
|
|
|
End Function
|
|
|
|
|
|
' @see loadForKunde
|
|
'
|
|
Private Function internLoadForKundeTyp(lKunde As Long, sTyp As String, sTypzusatz As String) As Boolean
|
|
Dim sSQL As String
|
|
Dim rs As New CRecordset
|
|
|
|
sSQL = "SELECT "
|
|
sSQL = sSQL & "KundeTypNummernband.NummernbandID, KundeTypNummernband.AnzahlInProzent " ' 1
|
|
sSQL = sSQL & "FROM "
|
|
sSQL = sSQL & "KundeTypNummernband, Nummernband "
|
|
sSQL = sSQL & "WHERE "
|
|
sSQL = sSQL & "KundeTypNummernband.KundenNr = " & lKunde & " AND "
|
|
sSQL = sSQL & "KundeTypNummernband.Typ = " & rs.stringToSQLString(sTyp, True) & " AND "
|
|
If sTypzusatz <> "" Then
|
|
sSQL = sSQL & "KundeTypNummernband.Typzusatz = " & rs.stringToSQLString(sTypzusatz, True) & " AND "
|
|
End If
|
|
sSQL = sSQL & "Nummernband.NummernbandID = KundeTypNummernband.NummernbandID "
|
|
sSQL = sSQL & ";"
|
|
|
|
If rs.openRS(sSQL, True) Then
|
|
If rs.RecordCount > 0 Then
|
|
m_lNummernbandID = rs.getLongValue("NummernbandID")
|
|
m_AnzahlInProzent = rs.getByteValue("AnzahlInProzent")
|
|
internLoadForKundeTyp = True
|
|
End If
|
|
End If
|
|
|
|
End Function
|
|
|
|
Public Function getAnzahlInProzent() As Byte
|
|
getAnzahlInProzent = m_AnzahlInProzent
|
|
End Function
|