234 lines
5.2 KiB
OpenEdge ABL
234 lines
5.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 = "StopSigns"
|
||
|
Attribute VB_GlobalNameSpace = False
|
||
|
Attribute VB_Creatable = False
|
||
|
Attribute VB_PredeclaredId = False
|
||
|
Attribute VB_Exposed = True
|
||
|
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
|
||
|
Attribute VB_Ext_KEY = "Top_Level" ,"No"
|
||
|
Option Explicit
|
||
|
|
||
|
Public Sub GetAllStopSignsRs( _
|
||
|
ByVal o_rs As ADODB.Recordset _
|
||
|
)
|
||
|
|
||
|
Dim strQuery As String
|
||
|
|
||
|
CheckDatabaseVersion
|
||
|
|
||
|
CloseRecordSet o_rs
|
||
|
|
||
|
strQuery = "" & _
|
||
|
"SELECT * " & _
|
||
|
"FROM StopSigns " & _
|
||
|
"ORDER BY StopSign;"
|
||
|
|
||
|
o_rs.Open strQuery, g_cnn, adOpenStatic, adLockReadOnly
|
||
|
|
||
|
End Sub
|
||
|
|
||
|
Public Sub GetAllStopSignsDict( _
|
||
|
ByVal o_dictStopSigns As Scripting.Dictionary _
|
||
|
)
|
||
|
Dim rs As ADODB.Recordset
|
||
|
Dim strQuery As String
|
||
|
|
||
|
CheckDatabaseVersion
|
||
|
|
||
|
Set rs = New ADODB.Recordset
|
||
|
|
||
|
strQuery = "" & _
|
||
|
"SELECT * " & _
|
||
|
"FROM StopSigns"
|
||
|
|
||
|
rs.Open strQuery, g_cnn, adOpenForwardOnly, adLockReadOnly
|
||
|
|
||
|
Do While (Not rs.EOF)
|
||
|
o_dictStopSigns.Add rs("SSID").Value, Array(rs("StopSign").Value, rs("Context").Value)
|
||
|
DoEvents
|
||
|
rs.MoveNext
|
||
|
Loop
|
||
|
|
||
|
End Sub
|
||
|
|
||
|
Public Function ContainsStopSign( _
|
||
|
ByVal i_str As String _
|
||
|
) As Boolean
|
||
|
|
||
|
Dim rs As ADODB.Recordset
|
||
|
Dim arrStr() As String
|
||
|
Dim strStopSign As String
|
||
|
Dim strLastChar As String
|
||
|
Dim strWord As String
|
||
|
Dim intIndex As Long
|
||
|
Dim intLength As Long
|
||
|
|
||
|
CheckDatabaseVersion
|
||
|
|
||
|
ContainsStopSign = False
|
||
|
|
||
|
Set rs = New ADODB.Recordset
|
||
|
|
||
|
GetAllStopSignsRs rs
|
||
|
|
||
|
If (rs.EOF) Then
|
||
|
Exit Function
|
||
|
End If
|
||
|
|
||
|
arrStr = Split(i_str)
|
||
|
|
||
|
Do While (Not rs.EOF)
|
||
|
strStopSign = rs("StopSign")
|
||
|
|
||
|
Select Case rs("Context")
|
||
|
Case CONTEXT_ANYWHERE_E
|
||
|
|
||
|
If (InStr(i_str, strStopSign) <> 0) Then
|
||
|
ContainsStopSign = True
|
||
|
Exit Function
|
||
|
End If
|
||
|
|
||
|
Case CONTEXT_AT_END_OF_WORD_E
|
||
|
|
||
|
' If a stop sign exists by itself, and not right after a word,
|
||
|
' then it doesn't qualify.
|
||
|
' So "abc." qualifies, but "abc ." and "a.bc" don't.
|
||
|
|
||
|
For intIndex = LBound(arrStr) To UBound(arrStr)
|
||
|
|
||
|
strWord = arrStr(intIndex)
|
||
|
intLength = Len(strWord)
|
||
|
strLastChar = Mid(strWord, intLength)
|
||
|
|
||
|
If ((strLastChar = strStopSign) And _
|
||
|
(intLength > 1)) Then
|
||
|
ContainsStopSign = True
|
||
|
Exit Function
|
||
|
End If
|
||
|
Next
|
||
|
|
||
|
Case Else
|
||
|
End Select
|
||
|
|
||
|
rs.MoveNext
|
||
|
Loop
|
||
|
|
||
|
End Function
|
||
|
|
||
|
Public Sub Create( _
|
||
|
ByVal i_strStopSign As String, _
|
||
|
ByVal i_intContext As Long _
|
||
|
)
|
||
|
|
||
|
Dim rsLock As ADODB.Recordset
|
||
|
Dim rs As ADODB.Recordset
|
||
|
Dim strQuery As String
|
||
|
|
||
|
CheckDatabaseVersion
|
||
|
LockTable LOCK_TABLE_STOP_SIGNS, rsLock
|
||
|
CheckAuthoringGroupAccess
|
||
|
|
||
|
' Do some validation to see if the StopSign is acceptable.
|
||
|
|
||
|
p_ValidateStopSign i_strStopSign, i_intContext
|
||
|
|
||
|
' Does an active StopSign exist?
|
||
|
|
||
|
Set rs = New ADODB.Recordset
|
||
|
|
||
|
p_GetStopSign i_strStopSign, rs
|
||
|
|
||
|
If (Not rs.EOF) Then
|
||
|
Err.Raise errAlreadyExists
|
||
|
Exit Sub
|
||
|
End If
|
||
|
|
||
|
rs.Close
|
||
|
|
||
|
' Create a new record in the database
|
||
|
|
||
|
strQuery = "" & _
|
||
|
"SELECT * " & _
|
||
|
"FROM StopSigns "
|
||
|
|
||
|
rs.Open strQuery, g_cnn, adOpenStatic, adLockPessimistic
|
||
|
|
||
|
If (rs.RecordCount > 0) Then
|
||
|
rs.MoveLast
|
||
|
End If
|
||
|
|
||
|
rs.AddNew
|
||
|
rs("StopSign") = i_strStopSign
|
||
|
rs("Context") = i_intContext
|
||
|
rs.Update
|
||
|
|
||
|
End Sub
|
||
|
|
||
|
Public Sub Delete( _
|
||
|
ByVal i_intSSID As Long _
|
||
|
)
|
||
|
|
||
|
Dim rsLock As ADODB.Recordset
|
||
|
Dim rs As ADODB.Recordset
|
||
|
Dim strQuery As String
|
||
|
Dim strStopSign As String
|
||
|
Dim intContext As Long
|
||
|
|
||
|
CheckDatabaseVersion
|
||
|
LockTable LOCK_TABLE_STOP_SIGNS, rsLock
|
||
|
CheckAuthoringGroupAccess
|
||
|
|
||
|
Set rs = New ADODB.Recordset
|
||
|
|
||
|
strQuery = "" & _
|
||
|
"DELETE * " & _
|
||
|
"FROM StopSigns " & _
|
||
|
"WHERE (SSID = " & i_intSSID & " );"
|
||
|
|
||
|
rs.Open strQuery, g_cnn, adOpenStatic, adLockPessimistic
|
||
|
|
||
|
End Sub
|
||
|
|
||
|
Private Sub p_GetStopSign( _
|
||
|
ByVal i_strStopSign As String, _
|
||
|
ByVal o_rs As ADODB.Recordset _
|
||
|
)
|
||
|
|
||
|
Dim strQuery As String
|
||
|
|
||
|
CloseRecordSet o_rs
|
||
|
|
||
|
strQuery = "" & _
|
||
|
"SELECT * " & _
|
||
|
"FROM StopSigns " & _
|
||
|
"WHERE (StopSign = """ & i_strStopSign & """)"
|
||
|
|
||
|
o_rs.Open strQuery, g_cnn, adOpenForwardOnly, adLockReadOnly
|
||
|
|
||
|
End Sub
|
||
|
|
||
|
Private Sub p_ValidateStopSign( _
|
||
|
ByVal i_strStopSign As String, _
|
||
|
ByVal i_intContext As Long _
|
||
|
)
|
||
|
|
||
|
If (Len(i_strStopSign) <> 1) Then
|
||
|
|
||
|
Err.Raise errTooLong
|
||
|
|
||
|
ElseIf (ContainsOperatorShortcut(i_strStopSign) And _
|
||
|
(i_intContext <> CONTEXT_AT_END_OF_WORD_E)) Then
|
||
|
|
||
|
Err.Raise errContainsOperatorShortcut
|
||
|
|
||
|
End If
|
||
|
|
||
|
End Sub
|