coutputtargetfield.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 = "COutputTargetField"
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 mIndex As Integer
Private mUniqueID As String
Private mUniqueIndexed As Boolean
Private mParent As COutputTargetTable
Private mValue As New COutputFieldProxy
Private mContainsValue As Boolean
Private mIgnoreMe As Boolean

' This is set by a COutputLink object and contains the names
' of all the tables and fields (including the name of this target)
' needed by the OutputObject to get the piece of data this schema
' object represents where it is going.
Private mStorageLinkString As String

Public Function Copy() As COutputTargetField

    On Error GoTo eHandler
    Set Copy = Nothing

    Dim newObj As COutputTargetField
    Set newObj = New COutputTargetField

    newObj.ContainsValue = Me.ContainsValue
    newObj.dbType = Me.dbType
    newObj.name = Me.name
    newObj.StorageLinkString = Me.StorageLinkString
    newObj.UniqueIndexed = Me.UniqueIndexed
    newObj.value = Me.value
    newObj.IgnoreMe = Me.IgnoreMe
    Set newObj.parent = Me.parent
    
    Set Copy = newObj
    Set newObj = Nothing
    Exit Function

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

End Function

Public Property Let UniqueIndexed(newVal As Boolean)
    mUniqueIndexed = newVal
End Property
Public Property Get UniqueIndexed() As Boolean
    UniqueIndexed = mUniqueIndexed
End Property

Public Property Let ContainsValue(newVal As Boolean)
    mContainsValue = newVal
End Property
Public Property Get ContainsValue() As Boolean
    ContainsValue = mContainsValue
End Property

Public Property Set parent(ByRef newVal As COutputTargetTable)
    Set mParent = newVal
End Property
Public Property Get parent() As COutputTargetTable
    Set parent = mParent
End Property

Public Property Let StorageLinkString(str As String)
    mStorageLinkString = str
End Property
Public Property Get StorageLinkString() As String
    StorageLinkString = mStorageLinkString
End Property

Public Property Let value(value As Variant)
    
    ' If this field isn't active, then don't do anything.
    If mIgnoreMe Then Exit Property

    ' Store the value until it is flushed.
    mValue.value = value
    ContainsValue = True
End Property
Public Property Get value() As Variant
    
    ' If this field isn't active, then don't do anything.
    If mIgnoreMe Then Exit Property

    If Not ContainsValue Then
        Set value = Empty
    Else
        value = mValue.value
    End If
End Property

Public Property Get IgnoreMe() As Boolean
    IgnoreMe = mIgnoreMe
End Property

Public Property Let IgnoreMe(newVal As Boolean)
    mIgnoreMe = newVal
End Property

Public Function Flush(hTable As Integer) As Boolean
    Flush = True
    
    ' If this field isn't active, then don't do anything.
    If mIgnoreMe Then Exit Function

    If ContainsValue Then
        ContainsValue = False

        If mValue.dbType <> ADODB.adEmpty Then
            If Not GDataConverter.Execute(hTable, mValue.name, mValue.value, mValue.dbType) Then
                Exit Function
            End If
        End If
        
        ' If a unique indexed ID field in this record was found to contain
        ' a duplicate, the record may be set to ignore data values until
        ' another non-duplicate ID field is found.
        Dim i As Integer
        i = GImport.GetOutputObject.StoreValue(hTable, mValue)

        If i = 3265 Then
            ' Table not found in database! Don't keep trying over & over.
            IgnoreMe = True
            Flush = False
        Else
            Flush = True
        End If
        
    End If
End Function

Public Function GetDBTypeDescription() As String
    GetDBTypeDescription = GOutputID.GetDBTypeDescription(mValue.dbType)
End Function
Public Function GetDBTypeName() As String
    GetDBTypeName = GOutputID.GetDBTypeName(mValue.dbType)
End Function
Public Property Get dbType() As Integer
    dbType = mValue.dbType
End Property
Public Property Let dbType(newType As Integer)
    mValue.dbType = newType
End Property

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

Public Property Get name() As String
    name = mValue.name
End Property
Public Property Let name(vName As String)
    mValue.name = vName
End Property

Public Property Get index() As Integer
    index = mIndex
End Property
Public Property Let index(vIndex As Integer)
    mIndex = vIndex
End Property

Public Function Load(ByRef 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"
                mValue.name = value
            Case "INDEX"
                mIndex = value
            Case "TYPE"
                mValue.dbType = value
            Case "UNIQUEINDEXED"
                UniqueIndexed = value
            Case Else
                ' This line contains an unrecognized item.
                arc.AddError
                
        End Select
    Loop While True
    
    Load = True
done:
    Exit Function
    
eHandler:
    LogError "COutputTarget", "Load", Error(Err)
End Function

Public Function Save(ByRef arc As CArchive) As Boolean

    On Error GoTo eHandler
    
    Save = False
        
    arc.SaveItem aiBEGINTARGETFIELD
    arc.SaveItem aiVALUE, "NAME", mValue.name
    arc.SaveItem aiVALUE, "TYPE", mValue.dbType
    arc.SaveItem aiVALUE, "UNIQUEINDEXED", UniqueIndexed
    arc.SaveItem aiVALUE, "INDEX", mIndex
    arc.SaveItem aiENDITEM
    
    Save = True
    Exit Function
    
eHandler:
    LogError "COuptutTarget", "Save", Error(Err)
    Exit Function
    
End Function

Private Sub Class_Initialize()
    mUniqueID = GetUniqueID
    dbType = ADODB.adEmpty
    UniqueIndexed = False
    Set mParent = Nothing
    mContainsValue = False
    mIgnoreMe = False
End Sub