ccheckpoint.cls

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

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "CCheckPoint"
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
Option Compare Text

Private mActions As CActions
Private mDataPts As CDataItems
Private mvarname As String
Private mvarIndex As Integer
Private mUniqueID As String

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

Public Sub ClearLinks()
    Dim di As CDataItem
    
    For Each di In mDataPts
        di.ClearLinks
    Next

End Sub

Public Sub SetActions(Actions As CActions)
    If Actions Is Nothing Then Exit Sub
    Set mActions = Nothing
    Set mActions = Actions
End Sub

Public Sub SetDataItems(DataItems As CDataItems)
    If DataItems Is Nothing Then Exit Sub
    Set mDataPts = Nothing
    Set mDataPts = DataItems
End Sub

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

    Dim newObj As CCheckPoint
    Set newObj = New CCheckPoint
    
    newObj.name = Me.name
    newObj.SetActions mActions.Copy
    newObj.SetDataItems mDataPts.Copy

    Set Copy = newObj
    Set newObj = Nothing
    Exit Function

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

End Function
Public Function AddDataPoint(Optional DefaultName As Boolean = False) As CDataItem
    
    On Error GoTo eHandler
    Dim di As CDataItem

    ' Add a new dataitem to our collection.
    Set di = mDataPts.Add()
    
    ' Create a default name for the dataitem if requested.
    If DefaultName Then
    
        Dim name As String
        Dim index As Integer
        Dim temp As CDataItem
        
        ' Find an unused name for the new dataitem.
        name = "New DataItem"
        index = 0
        Do
            index = index + 1
            Set temp = Nothing
            Set temp = GetDataPointByName(name + CStr(index))
        Loop While Not temp Is Nothing
        
        di.name = name + CStr(index)
        di.index = mDataPts.Count
    End If
    
    Set AddDataPoint = di
    Set di = Nothing
    
    Exit Function
    
eHandler:
    LogError "CCheckPoint", "AddDataItem", Error(Err)
End Function

Public Function GetDataPoint(DataPointKey As Variant) As CDataItem
    On Error Resume Next
    Set GetDataPoint = Nothing
    Set GetDataPoint = mDataPts.item(DataPointKey)
End Function

Public Function GetDataPointByName(dpName As String) As CDataItem
    Dim dp As CDataItem
    For Each dp In mDataPts
        If dp.name = dpName Then
            Set GetDataPointByName = dp
            Exit Function
        End If
    Next dp
End Function

Public Function GetDataPoints() As CDataItems
    On Error Resume Next
    Set GetDataPoints = mDataPts
End Function

Public Function ChangeDataPointName(oldName As String, newName As String) As Boolean

    '*****************************************************
    ' Change the name of a checkpoint, and all associates.
    '*****************************************************

    ChangeDataPointName = False
    Dim dp As CDataItem
    
    '*********************************
    ' Get the datapoint to be changed.
    '*********************************
    
    Set dp = GetDataPointByName(oldName)
    
    If dp Is Nothing Then
        MsgBox "Cannot find datapoint '" & oldName & "'", vbCritical, "Error"
    Else

        GImport.GetOutputLinksManager.ChangedDataItemName dp.name, newName

        ' Change the name.
        dp.name = newName
    
    End If
    
    Set dp = Nothing
    ChangeDataPointName = True

End Function

Public Function GetAction(ActionKey As Variant) As Object
    Set GetAction = mActions.item(ActionKey)
End Function

Public Function GetActions() As CActions
    Set GetActions = mActions
End Function

Public Function AddAction(act As Object) As Object
    Set AddAction = mActions.AddObject(act)
End Function

Public Property Let index(ByVal vData As Integer)
    mvarIndex = vData
End Property

Public Property Get index() As Integer
    index = mvarIndex
End Property

Public Property Let name(ByVal vData As String)
    mvarname = vData
End Property


Public Property Get name() As String
Attribute name.VB_UserMemId = 0
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.Name
    name = mvarname
End Property

Public Function Verify() As Boolean
End Function

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 "NAME"
                mvarname = value
            Case "INDEX"
                mvarIndex = value
            Case "BEGIN DATAPOINT"
                AddDataPoint().Load arc
            Case "BEGIN ACTION"
                Dim act As Object
                Set act = mActions.AddNew(GInputID.CommandTypeFromName(CStr(value)))
                If act Is Nothing Then
                    arc.AddError
                Else
                    act.Load arc
                    Set act = Nothing
                End If
            Case Else
            
                '*****************************************
                ' This line contains an unrecognized item.
                '*****************************************
                
                arc.AddError
                
        End Select
    Loop While True
    
    Load = True
done:
    Exit Function
    
eHandler:
    LogError "CCheckPoint", "Load", Error(Err)
    
End Function
Public Function Save(arc As CArchive) As Boolean
    
    On Error GoTo eHandler
    
    Save = False

    arc.SaveItem aibegincheckpoint, mvarname
    arc.SaveItem aiVALUE, "NAME", mvarname
    arc.SaveItem aiVALUE, "INDEX", mvarIndex
    
    '****************************
    ' Save the Action structures.
    '****************************
    
    If mActions.Count > 0 Then
        arc.SaveItem aiCOMMENT, "Begin Actions for CheckPoint " + mvarname
    
        Dim act As Object
        For Each act In mActions
            act.Save arc
        Next act
    End If
    
    '*******************************
    ' Save the Datapoint structures.
    '*******************************
        
    If mDataPts.Count > 0 Then
        arc.SaveItem aiCOMMENT, "Begin DataItems for CheckPoint " + mvarname
        
        Dim dp As CDataItem
        For Each dp In mDataPts
            If dp.Save(arc) = False Then
                GoTo terminate
            End If
            arc.SaveItem aiBLANKLINE
        Next
    End If
    arc.SaveItem aiENDITEM, mvarname

terminate:
    Save = True
    Exit Function
    
eHandler:
    LogError "CCheckPoint", "Save", Error(Err)
    
End Function

Public Function Import(ByRef line As String) As Boolean

    On Error GoTo eHandler
    
    Import = False
    
    Dim act As Object
    
    For Each act In mActions
        
        If act.CmdType = eCmdTypes.cmdExecute Then
            ProcessChildren line
        Else
            If act.Execute("") = False Then Exit Function
        End If
    
        ' If the import was cancelled, git out.
        If GCancelImport Then Exit Function
    
    Next act

    Import = True
    Exit Function
    
eHandler:
    LogError "CCheckPoint", "Import", Error(Err)
    
End Function
Public Sub ProcessChildren(ByRef line As String)
    On Error GoTo eHandler
    
    Dim dp As CDataItem
    
    For Each dp In mDataPts
        If GCancelImport Then Exit Sub
        dp.Import line
    Next

    Exit Sub
    
eHandler:
  LogError "CCheckPoint", "ProcessChildren", Error(Err)
End Sub
Private Sub Class_Initialize()
    Set mDataPts = New CDataItems
    Set mActions = New CActions
    mUniqueID = GetUniqueID
End Sub

Private Sub Class_Terminate()
    Set mDataPts = Nothing
    Set mActions = Nothing
End Sub