ccmdgetfieldvalue.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 = "CCmdGetFieldValue"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"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

Private mIndex As Integer
Private mUniqueID As String
Private mFieldName As String
Private mRecordName As String
Private mOverwriteExisting As Boolean 'local copy

Public Property Let overwriteExistingValue(ByVal vData As Boolean)
    mOverwriteExisting = vData
End Property

Public Property Get overwriteExistingValue() As Boolean
    overwriteExistingValue = mOverwriteExisting
End Property

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

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

    Dim newObj As CCmdGetFieldValue
    Set newObj = New CCmdGetFieldValue

    newObj.fieldName = Me.fieldName
    newObj.RecordName = Me.RecordName
    newObj.overwriteExistingValue = Me.overwriteExistingValue
    
    Set Copy = newObj
    Set newObj = Nothing
    Exit Function

eHandler:
    LogError "CCmdGetFieldValue", "Copy", Error(Err), False
End Function

Public Function GetSpecificDescription() As String
    Dim x As String
    If overwriteExistingValue Then
        x = "Set value to the value in " + RecordName + "->" + fieldName
    Else
        x = "Append the value from " + RecordName + "->" + fieldName
    End If
    
    GetSpecificDescription = x

End Function

Public Function EditProperties(NameForCaption As String, Optional ByRef Import As CImport = Nothing) As Integer
    Dim tImport As CImport
    Set tImport = Import
    If tImport Is Nothing Then Set tImport = GImport
    
    With frmCmdGetFieldValueProperties
        .Initialize NameForCaption, tImport

        ' Display current values.
        .RecordName = RecordName
        .fieldName = fieldName
        .Overwrite = overwriteExistingValue

        ' Center the form.
        .left = Screen.Width / 2 - .Width / 2
        .top = Screen.Height / 2 - .Height / 2
    
        .Show vbModal
    
        ' On success set new values.
        If GFormReturnValue = vbOK Then
            RecordName = .RecordName
            fieldName = .fieldName
            overwriteExistingValue = .Overwrite
        End If
    End With
    
    ' Unload the form.
    Unload frmCmdGetFieldValueProperties
    
    EditProperties = GFormReturnValue
End Function

Public Property Let fieldName(newVal As String)
    mFieldName = newVal
End Property
Public Property Get fieldName() As String
    fieldName = mFieldName
End Property

Public Property Let RecordName(newVal As String)
    mRecordName = newVal
End Property
Public Property Get RecordName() As String
    RecordName = mRecordName
End Property

Public Function GetApplications() As eCmdApplications
    GetApplications = GCmdHelper.CMDGetApplications(CmdType())
End Function

Public Function CmdType() As Integer
    CmdType = eCmdTypes.cmdGetFieldValue
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 Function Execute(ByRef value As Variant, Optional CnvType As Integer = -1) As Boolean

    On Error GoTo eHandler
    
    Dim rec As CInputRecord
    Dim fld As CInputField

    Execute = False ' Default to failure.
    
    ' Get the field and record.
    Set rec = GImport.GetCheckPointByName(RecordName)
    If rec Is Nothing Then Exit Function
    
    Set fld = rec.GetDataPointByName(fieldName)
    If fld Is Nothing Then Exit Function
    
    If Me.overwriteExistingValue Then
        ' Set the return value.
        value = fld.value
    Else
        value = CStr(value) & CStr(fld.value)
    End If
    
    Execute = True
    Exit Function
    
eHandler:
    LogError "CCmdGetFieldValue", "Execute", Error(Err)
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 retVal
            Case ArcRetType.cVALUE
            
                ' Restore our internal settings.
                Select Case item
                    Case "INDEX"
                        mIndex = value
                    Case "FIELDNAME"
                        fieldName = value
                    Case "RECORDNAME"
                        RecordName = value
                    Case "OVERWRITE"
                        overwriteExistingValue = value
                    Case Else
                        arc.AddError    ' Unrecognized item.
                End Select
        End Select
    Loop While True
    
    Load = True
    
done:
    Exit Function
    
eHandler:
    LogError "CCmdGetFieldValue", "Load", Error(Err)
End Function

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

    arc.SaveItem aiBEGINACTION, GCmdHelper.GetName(CmdType())
    arc.SaveItem aiVALUE, "INDEX", mIndex
    arc.SaveItem aiVALUE, "RECORDNAME", RecordName
    arc.SaveItem aiVALUE, "FIELDNAME", fieldName
    arc.SaveItem aiVALUE, "OVERWRITE", overwriteExistingValue
    arc.SaveItem aiENDITEM, GCmdHelper.GetName(CmdType())

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

Private Sub Class_Initialize()
    mUniqueID = GetUniqueID
End Sub