ccmdcheckvalue.cls

Data monkey是一个强大的是数据传输和转换应用程序。使用DataMonkey用户可以把复杂的文本文件格式

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "CCmdCheckValue"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Option Explicit
Private mGetValue As New CCmdGetValue
Private mIf As New CCmdIf
Private mIndex As Integer 'local copy
Private mUniqueID As String

Public Function Copy() As CCmdCheckValue
    On Error GoTo eHandler
    Set Copy = Nothing

    Dim cmd As CCmdCheckValue
    Set cmd = New CCmdCheckValue
    
    cmd.Delimited = Me.Delimited
    cmd.CompareTo = Me.CompareTo
    cmd.Delimiter = Me.Delimiter
    cmd.Length = Me.Length
    cmd.Position = Me.Position
    cmd.Operator = Me.Operator
    cmd.CaseSensitive = Me.CaseSensitive

    Set Copy = cmd
    Set cmd = Nothing
    Exit Function

eHandler:
    LogError "CCmdCheckValue", "Copy", Error(Err), False

End Function

Public Function GetID() As String
    GetID = mUniqueID
End Function

Public Function EditProperties(NameForCaption As String, Optional ByRef Import As CImport = Nothing) As Integer
    
    ' Set default values.
    If Not Import Is Nothing Then
        Me.Delimited = Import.Delimited
        Me.Delimiter = Import.Delimiter
    End If
    
    frmCMDCheckValueProperties.Initialize Me, NameForCaption

    frmCMDCheckValueProperties.Show vbModal
    EditProperties = GFormReturnValue
End Function

Public Function GetSpecificDescription() As String
    Dim x As String
    
    x = "If the value "
    If mGetValue.Delimited Then
        x = x & "at position " + Trim(str(mGetValue.Position))
    Else
        x = x & "FROM " & Trim(str(mGetValue.Position))
        x = x & " TO " & Trim(str(mGetValue.Position & mGetValue.Length))
    End If
    
    x = x & IIf(mIf.Operator = "=", " equals ", " is not ")
    x = x & mIf.RHS

    GetSpecificDescription = x
End Function
Public Property Let Index(ByVal vData As Integer)
    mIndex = vData
End Property

Public Property Get Index() As Integer
    Index = mIndex
End Property

Public Property Let CaseSensitive(ByVal vData As Integer)
    mIf.CaseSensitive = vData
End Property

Public Property Get CaseSensitive() As Integer
    CaseSensitive = mIf.CaseSensitive
End Property

Public Function CmdType() As Integer
    CmdType = eCmdTypes.cmdCheckValue
End Function

Public Function GetApplications() As eApplications
    GetApplications = GInputID.CMDGetApplications(CmdType())
End Function

Public Property Let Delimiter(ByVal vData As String)
    mGetValue.Delimiter = vData
End Property

Public Property Get Delimiter() As String
    Delimiter = mGetValue.Delimiter
End Property

Public Property Let Delimited(ByVal vData As Boolean)
    mGetValue.Delimited = vData
End Property
Public Property Get Delimited() As Boolean
    Delimited = mGetValue.Delimited
End Property

Public Property Get Operator() As String
    Operator = mIf.Operator
End Property
Public Property Let Operator(op As String)
    mIf.Operator = op
End Property

Public Property Let Length(ByVal vData As Integer)
    mGetValue.Length = vData
End Property

Public Property Get Length() As Integer
    Length = mGetValue.Length
End Property

Public Property Let Position(ByVal vData As Integer)
    mGetValue.Position = vData
End Property

Public Property Get Position() As Integer
    Position = mGetValue.Position
End Property

Public Property Let CompareTo(ByVal vData As String)
    mIf.RHS = vData
    mIf.RHSType = eCmdValueTypes.cvtConstant
End Property

Public Property Get CompareTo() As String
    CompareTo = mIf.RHS
End Property

Public Function Load(arc As CArchive) As Boolean

    On Error GoTo eHandler
    
    Load = False
    Dim item As String, value As Variant, retVal As Integer
    
    '***************************************
    ' Get the next line from the input file.
    '***************************************
    
    Do
        retVal = arc.GetNextItem(item, value)

        ' Error, log it, then exit with error.
        If retVal = ArcRetType.cERROR Then
            arc.AddError
            GoTo done
            
        ' We are done with this object, leave.
        ElseIf retVal = ArcRetType.cENDITEM Then
            Exit Do
        End If
        
        Select Case item
            Case "INDEX"
                mIndex = value
            Case "BEGIN ACTION"
                Dim ct As eCmdTypes
                ct = GInputID.CommandTypeFromName(CStr(value))
                If ct = eCmdTypes.cmdif Then
                    mIf.Load arc
                ElseIf ct = eCmdTypes.cmdGetValue Then
                    mGetValue.Load arc
                End If
            Case Else
                ' This line contains an unrecognized item.
                arc.AddError
        End Select
    Loop While True
    
    If mIf Is Nothing Or mGetValue Is Nothing Then
        LogError "CCmdCheckValue", "Load", "Missing subcommand"
    Else
        Load = True
    End If
    
done:
    Exit Function
    
eHandler:
    LogError "CCmdCheckValue", "Load", Error(Err)
    Exit Function

End Function

Public Function Save(arc As CArchive) As Boolean
    
    On Error GoTo eHandler
    
    Save = False

    arc.SaveItem aiBEGINACTION, GInputID.GetName(CmdType())
    arc.SaveItem aiVALUE, "INDEX", mIndex

    mGetValue.Save arc
    mIf.Save arc
    arc.SaveItem aiENDITEM, GInputID.GetName(CmdType())
    
    Save = True
    Exit Function
    
eHandler:
    LogError "CCmdCheckValue", "Save", Error(Err)
    Exit Function
    
End Function

Public Function Execute(Optional ByRef value As Variant, Optional CnvType As Integer = -1) As Boolean
    Execute = False
    
    Dim Val As String
    
    If mGetValue.Execute(Val) = False Then
        Exit Function
    End If
    
    If mIf.Execute(Val) = False Then
        Exit Function
    End If
    
    Execute = True
End Function

Private Sub Class_Initialize()
    mGetValue.Index = 1
    mIf.Index = 2
    mIf.Operator = "="
    mUniqueID = GetUniqueID
End Sub