ccmdgetvalue.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 = "CCmdGetValue"
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

Private mPosition As Integer
Private mLength As Integer
Private mDelimiter As String
Private mDelimited As Boolean
Private mIndex As Integer
Private mUniqueID As String
Private mTrimSpaces As Boolean
Private mAppend As Boolean

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

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

    Dim newObj As CCmdGetValue
    Set newObj = New CCmdGetValue

    newObj.Delimited = Me.Delimited
    newObj.Delimiter = Me.Delimiter
    newObj.Length = Me.Length
    newObj.Position = Me.Position
    newObj.TrimSpaces = Me.TrimSpaces
    newObj.Append = Me.Append
    
    Set Copy = newObj
    Set newObj = Nothing
    Exit Function

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

End Function

Public Function EditProperties(NameForCaption As String, Optional ByRef Import As CImport = Nothing) As Integer
    
    If Not Import Is Nothing Then
        ' Set defaults.
        Me.Delimited = Import.Delimited
        Me.Delimiter = Import.Delimiter
    End If
    
    frmCMDGetValueProperties.Initialize Me, NameForCaption
    frmCMDGetValueProperties.Show vbModal
    EditProperties = GFormReturnValue
End Function
Public Function GetSpecificDescription() As String
    Dim x As String
    
    If mAppend Then
        x = "Append "
    Else
        x = "Get "
    End If
    
    If mDelimited Then
        x = x & "the value at position " + str(mPosition)
    Else
        x = x & str(mLength) + " characters beginning at " + str(mPosition)
    End If

    GetSpecificDescription = x

End Function

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

Public Property Let Append(ByVal vData As Boolean)
    mAppend = vData
End Property
Public Property Get Append() As Boolean
    Append = mAppend
End Property

Public Property Let TrimSpaces(ByVal vData As Boolean)
    mTrimSpaces = vData
End Property
Public Property Get TrimSpaces() As Boolean
    TrimSpaces = mTrimSpaces
End Property

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

Public Property Get Length() As Integer
    Length = mLength
End Property

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

Public Property Get Position() As Integer
    Position = mPosition
End Property

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

Public Property Get Delimiter() As String
    Delimiter = mDelimiter
End Property

Public Property Let Delimited(ByVal vData As Boolean)
    mDelimited = vData
End Property

Public Property Get Delimited() As Boolean
    Delimited = mDelimited
End Property

Public Function CmdType() As Integer
    CmdType = eCmdTypes.cmdGetValue
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 ShiftPosition(ShiftRight As Boolean, ShiftAmt As Long)
    
    If ShiftRight = True Then
        Position = Position + ShiftAmt
        If Not Delimited Then
            Length = Length + ShiftAmt
        End If
    Else
        Position = Position - ShiftAmt
        If Not Delimited Then
            Length = Length - ShiftAmt
        End If
    End If
    
End Function

Public Function Execute(ByRef value As Variant, Optional CnvType As Integer = -1) As Boolean
    Execute = False
    Dim newVal As Variant
    On Error GoTo eHandler
    
    
    If mDelimited Then
        newVal = GImport.GetInputObject.GetDelimitedValue(mPosition, mDelimiter)
    Else
        newVal = GImport.GetInputObject.GetValue(mPosition, mLength)
    End If
    
    If mTrimSpaces Then
        newVal = Trim(newVal)
    End If
    
    If mAppend Then
        value = value + newVal
    Else
        value = newVal
    End If

    Execute = True
done:
    Exit Function
    
eHandler:
    LogError "CCmdGetValue", "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 item
            Case "INDEX"
                mIndex = value
            Case "POSITION"
                mPosition = value
            Case "LENGTH"
                mLength = value
            Case "DELIMITED"
                mDelimited = value
            Case "DELIMITER"
                mDelimiter = value
            Case "APPEND"
                Append = value

            Case Else
            
                '*****************************************
                ' This line contains an unrecognized item.
                '*****************************************
                
                arc.AddError
                
        End Select
    Loop While True
    
    Load = True
done:
    Exit Function
    
eHandler:
    LogError "CCmdGetValue", "Load", Error(Err)
    Exit Function

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, "DELIMITED", mDelimited
    arc.SaveItem aiVALUE, "APPEND", Append
    
    If mDelimited Then
        arc.SaveItem aiVALUE, "DELIMITER", mDelimiter
    End If
    
    arc.SaveItem aiVALUE, "POSITION", mPosition
    If Not mDelimited Then
    
        '***************************************************************
        ' If not delimited, we need to know how many characters to read.
        '***************************************************************
        
        arc.SaveItem aiVALUE, "LENGTH", mLength
    End If
        
    arc.SaveItem aiENDITEM, GCmdHelper.GetName(CmdType())
    
    Save = True
    Exit Function
    
eHandler:
    LogError "CCmdGetValue", "Save", Error(Err)
    Exit Function
    
End Function

Private Sub Class_Initialize()
    mDelimited = GImport.Delimited
    mDelimiter = GImport.Delimiter
    mUniqueID = GetUniqueID
    mTrimSpaces = True
    mAppend = False
End Sub