cinputfield.cls

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

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CInputField"
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"
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
' DataMonkey Data Conversion Application. Written by Theodore L. Ward
' Copyright (C) 2002 AstroComma Incorporated.
'
' This program is free software; you can redistribute it and/or
' modify it under the terms of the GNU General Public License
' as published by the Free Software Foundation; either version 2
' of the License, or (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
' GNU General Public License for more details.
'
' You should have received a copy of the GNU General Public License
' along with this program; if not, write to the Free Software
' Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
' The author may be contacted at:
' [e-mail] or [e-mail]

Option Explicit
Option Compare Text

Private mActions As CActions

Private mvarname As String 'local copy
Private mvarIndex As Integer 'local copy
Private mvarvalue As Variant 'local copy
Private mUniqueID As String
Private mStorageLinks As COutputLinks

Public Sub ClearLinks()
    While mStorageLinks.Count > 0
        mStorageLinks.Remove 1
    Wend
End Sub

Public Function Copy() As CInputField
    On Error GoTo eHandler
    Set Copy = Nothing
    Dim i As Integer

    Dim newObj As CInputField
    Set newObj = New CInputField

    newObj.name = Me.name
    newObj.value = Me.value
    newObj.SetActions mActions.Copy
    
    For i = 1 To mStorageLinks.Count
        newObj.AddStorageLink mStorageLinks(i)
    Next i
    
    Set Copy = newObj
    Set newObj = Nothing
    Exit Function

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

End Function

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

Public Function GetStorageLinks() As COutputLinks
    Set GetStorageLinks = mStorageLinks
End Function

Public Sub AddStorageLink(ol As COutputLink)
    If mStorageLinks(ol.GetID) Is Nothing Then
        mStorageLinks.AddObject ol
    End If
End Sub

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

Public Property Let value(vData As Variant)
    mvarvalue = vData
End Property

Public Property Set value(ByVal vData As Object)
    Set mvarvalue = vData
End Property

Public Property Get value() As Variant
Attribute value.VB_UserMemId = 0
    If IsObject(mvarvalue) Then
        Set value = mvarvalue
    Else
        value = mvarvalue
    End If
End Property

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 Function CreateAction(CmdType As eCmdTypes) As Object
    Set CreateAction = mActions.AddNew(CmdType)
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 Function Save(arc As CArchive) As Boolean

    On Error GoTo eHandler
    
    Save = False
        
    arc.SaveItem aiBEGINDATAPOINT, 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 DataPoint " + mvarname
        
        Dim act As Object
        For Each act In mActions
            act.Save arc
        Next act
    End If
    
    arc.SaveItem aiENDITEM, mvarname
    
    Save = True
    Exit Function
    
eHandler:
    LogError "CInputField", "Save", Error(Err)
    Exit Function
    
End Function

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 ArcRetType
    
    '***************************************
    ' 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 = cENDITEM Then
            Exit Do
        End If
            
        Select Case item
            Case "Name"
                mvarname = value
            Case "Index"
                mvarIndex = value
            Case "Value"
            
            Case "BEGIN ACTION"
                CreateAction(GCmdHelper.CommandTypeFromName(CStr(value))).Load arc

            Case Else
                ' This line contains an unrecognized item.
                arc.AddError
                
        End Select
    
    Loop While True

    Load = True
    
done:
    Exit Function
    
eHandler:
    LogError "CInputField", "Load", Error(Err)

End Function

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

Public Property Get name() As String
    name = mvarname
End Property

Public Function Import(ByRef line As String) As Boolean
    
    On Error GoTo eHandler
   
    Import = False
    
    Dim act As Object
    
    ' Execute all the actions for this dataitem.
    For Each act In mActions
        If act.Execute(mvarvalue) = False Then Exit Function
        
        ' If the import was cancelled, git out.
        If GCancelImport Then Exit Function
        
    Next act
    
    ' Store this value to the output object.
    Dim ol As COutputLink
    Dim i As Integer
    
    Import = True   ' So far so good.
    
    ' Store the dataitem for each link we have.
    For Each ol In mStorageLinks
        i = GImport.GetSchemaObject.StoreValue(ol, value)
        If i = False Then Import = False
    Next ol
    
    Exit Function
    
eHandler:
    LogError "CInputRecord", "Import", Error(Err)
    
End Function

Private Sub Class_Initialize()
    mUniqueID = GetUniqueID
    Set mActions = New CActions
    Set mStorageLinks = New COutputLinks
End Sub

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