139 lines
4.5 KiB
OpenEdge ABL
139 lines
4.5 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 = "CBestellcode"
|
|
Attribute VB_GlobalNameSpace = False
|
|
Attribute VB_Creatable = True
|
|
Attribute VB_PredeclaredId = False
|
|
Attribute VB_Exposed = False
|
|
Private m_dicWerte As scripting.Dictionary
|
|
Private m_sBestellcode As String
|
|
Private m_lBestellgruppe As Long
|
|
|
|
|
|
|
|
Public Function load(sBestellcode As String, lBestellgruppe As Long) As Boolean
|
|
On Error Resume Next
|
|
|
|
Dim sSQL As String
|
|
Dim rs As New CRecordset
|
|
Dim Wert As String
|
|
Dim Name As String
|
|
Dim pos As Integer
|
|
|
|
pos = InStr(1, sBestellcode, "-")
|
|
If pos > 0 Then
|
|
sBestellcode = Mid(sBestellcode, pos + 1)
|
|
End If
|
|
|
|
m_sBestellcode = sBestellcode
|
|
m_lBestellgruppe = lBestellgruppe
|
|
|
|
sSQL = "select * from Bestellcode_Merkmalswerte where Merkmalsgruppe=" & lBestellgruppe & " order by Stelle, Merkmalsname"
|
|
Set rs = New CRecordset
|
|
Debug.Print sSQL
|
|
rs.openRS sSQL
|
|
Set m_dicWerte = New Dictionary
|
|
|
|
' lade alle passenden Werte zur Gruppe
|
|
Do While Not rs.EOF
|
|
Stelle = rs.getIntValue("Stelle")
|
|
Laenge = Len(rs.getStringValue("Charcode"))
|
|
|
|
InputCharcode = Mid(sBestellcode, Stelle, Laenge)
|
|
If InputCharcode = rs.getStringValue("Charcode") Then
|
|
' Charcode passt zum Bestellcode
|
|
Name = rs.getStringValue("Merkmalsname")
|
|
|
|
If Not rs.isFieldNull("Merkmalswert") Then
|
|
Wert = rs.getStringValue("Merkmalswert")
|
|
Debug.Print Stelle & "(" & InputCharcode & "): " & Name & "=" & Wert
|
|
|
|
If Not m_dicWerte.Exists(Name) Then
|
|
' Schlüssel noch nicht vorhanden, dann hinzufügen
|
|
m_dicWerte.Add Name, Wert
|
|
Else
|
|
' Bestellcodewert schon in Auflistung vorhanden
|
|
If m_dicWerte(Name) = Wert Then
|
|
' Bestellcodewert mit gleichem Wert vorhanden: Ignorieren
|
|
Debug.Print Name & "=" & m_dicWerte(Name)
|
|
Else
|
|
LogIntoDB "Bestellcodewerte nicht eindeutig: " & Name & "=" & m_dicWerte(Name) & " <> " & Wert & " Bestellcode: " & sBestellcode, "Bestellcode_Merkmalswerte"
|
|
End If
|
|
End If
|
|
|
|
load = True
|
|
End If
|
|
End If
|
|
rs.MoveNext
|
|
Loop
|
|
End Function
|
|
|
|
'Public Function Load_alt(sBestellcode As String, strProdukt As String) As Boolean
|
|
' Dim sSQL As String
|
|
' Dim rs As New CRecordset
|
|
'
|
|
' Dim Stelle As Integer
|
|
' Dim naechsteStelle As Integer
|
|
'
|
|
' Dim Schluessel As String
|
|
' Dim InputCharcode As String
|
|
' Dim Wert As String
|
|
' Dim WertNumerisch As Variant
|
|
' Dim Laenge As Integer
|
|
'
|
|
' Debug.Print "Produkt '" & strProdukt & "' Bestellcode: " & sBestellcode
|
|
'
|
|
' Set rs = New CRecordset
|
|
' Call rs.openRS("select * from Bestellcodewerte where {fn LCASE(Produkt)}= '" & Replace(LCase(Trim(strProdukt)), "'", "''") & "'", True)
|
|
' Set m_dicWerte = New Dictionary
|
|
'
|
|
' Do While Not rs.EOF
|
|
' Load_alt = True
|
|
' Stelle = rs.getIntValue("Stelle")
|
|
' Laenge = Len(rs.getStringValue("Charcode"))
|
|
'
|
|
' InputCharcode = Mid(sBestellcode, Stelle, Laenge)
|
|
'
|
|
' If InputCharcode = rs.getStringValue("Charcode") Then
|
|
' Schluessel = rs.getStringValue("Schluessel")
|
|
' m_dicWerte.Add rs.getStringValue("Schluessel"), rs.getStringValue("Wert")
|
|
' If Not rs.isFieldNull("Wertnumerisch") Then
|
|
' m_dicWerte.Add rs.getStringValue("Schluessel") & "_numerisch", rs.getStringValue("Wertnumerisch")
|
|
' End If
|
|
' Debug.Print Stelle & "(" & Laenge & ") " & Schluessel & ":" & InputCharcode & " = " & m_dicWerte(Schluessel)
|
|
' End If
|
|
' rs.MoveNext
|
|
' Loop
|
|
' Set rs = Nothing
|
|
'End Function
|
|
|
|
Public Function GetWert(Key As String) As Variant
|
|
GetWert = Empty
|
|
If m_dicWerte.Exists(Key) Then
|
|
GetWert = m_dicWerte.Item(Key)
|
|
End If
|
|
End Function
|
|
|
|
Public Function GetKeys() As Variant
|
|
GetKeys = m_dicWerte.Keys
|
|
End Function
|
|
|
|
Private Sub Class_Initialize()
|
|
Set m_dicWerte = New Dictionary
|
|
End Sub
|
|
|
|
Public Function GetBestellcode() As String
|
|
GetBestellcode = m_sBestellcode
|
|
End Function
|
|
|
|
Public Function GetMerkmalgruppe() As Long
|
|
GetMerkmalgruppe = m_lBestellgruppe
|
|
End Function
|
|
|