coutputschema.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 = "COutputSchema"
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 = "Member0" ,"COutputDefinitions"
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]

'@Class COutputSchema | This class encapsulates the physical
' output structure and stores relevant information.

Option Explicit

'@mdata mType | Describes the type of physical output device.
Private mType As otOutputSourceType
Private mTables As New COutputTargetTables
Private mName As String
Private mUniqueID As String
Private mIgnoreUniqueIndexDuplicates As Boolean
Private mLoadedFromFile As String
Private mIgnoreBlanks As Boolean

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

Public Property Let IgnoreBlanks(newVal As Boolean)
    mIgnoreBlanks = newVal
End Property
Public Property Get IgnoreBlanks() As Boolean
    IgnoreBlanks = mIgnoreBlanks
End Property

Public Property Let IgnoreUniqueIndexDuplicates(newVal As Boolean)
    mIgnoreUniqueIndexDuplicates = newVal
End Property
Public Property Get IgnoreUniqueIndexDuplicates() As Boolean
    IgnoreUniqueIndexDuplicates = mIgnoreUniqueIndexDuplicates
End Property

Public Property Let SchemaType(newType As otOutputSourceType)
    mType = newType
End Property
Public Property Get SchemaType() As otOutputSourceType
    SchemaType = mType
End Property

Public Function GetOutputTables() As COutputTargetTables
    Set GetOutputTables = mTables
End Function

Public Function StoreValue(lnk As COutputLink, value As Variant) As Boolean
    On Error GoTo eHandler
    StoreValue = True
    
    Dim ot As COutputTargetTable
    Set ot = mTables.ItemByName(lnk.LinkToTable)
    If ot Is Nothing Then
        LogError "COutputSchema", "StoreValue", "An attempt was made to store a value to the table '" & lnk.LinkToTable & "' However, this table does not exist in the schema '" & GImport.GetSchemaObject.name & "'"
    Else
        If mIgnoreBlanks Then
            If Len(Trim(value)) < 1 Then Exit Function
        End If
        
        StoreValue = ot.StoreValue(lnk.LinkToField, value)
    End If
    Exit Function
eHandler:
    LogError "COutputSchema", "StoreValue", Error(Err)
End Function

Public Function Edit() As String
    
    Edit = ""
    
    ' Give the edit form a reference to this object
    ' so it knows what schema it is updating.
    osInitialize Me
    
    ' Start the form and edit this schema.
    frmEditOutputSchema.Show vbModal
    
    ' If cancel wasn't pressed on the dialog, ask to save
    ' the schema file.
    If GFormReturnValue = vbOK Then
        Dim arc As New CArchive
        arc.InitialBrowseDirectory = GOutputSourceDirectory
        If arc.BrowseFileSave("Save Output Schema", mLoadedFromFile, _
                "Schema Files (*.sch)|*.sch|All Files (*.*)|*.*") Then
            
            ' If we have a valid filename, save to it.
            If Me.Save(arc) Then
                Edit = arc.fileName
            End If
            mLoadedFromFile = arc.fileName
        End If
    End If
End Function

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

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

Public Function Save(arc As CArchive) As Boolean

    On Error GoTo eHandler
    
    Save = False
        
    arc.SaveItem aiBEGINOUTPUTSCHEMA
    arc.SaveItem aiVALUE, "NAME", name
    arc.SaveItem aiVALUE, "TYPE", SchemaType
    arc.SaveItem aiVALUE, "IGNOREUNIQUEINDEXDUPLICATES", IgnoreUniqueIndexDuplicates
    arc.SaveItem aiVALUE, "IGNOREBLANKS", IgnoreBlanks
    mTables.Save arc
    arc.SaveItem aiENDITEM, mName
    
    Save = True
    Exit Function
    
eHandler:
    LogError "COutputSchema", "Save", Error(Err)
 '    Exit Function
    
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 and process 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"
                name = value
            Case "TYPE"
                SchemaType = value
            Case "IGNOREUNIQUEINDEXDUPLICATES"
                IgnoreUniqueIndexDuplicates = value
            Case "IGNOREBLANKS"
                IgnoreBlanks = value
            Case "BEGIN TARGETTABLE"
                mTables.Add().Load arc
            Case "BEGIN OUTPUTSCHEMA"
                ' Do nothing, this happens when the schema is
                ' being loaded standalone, the begin item hasn't
                ' already been read in by another object.
            Case Else
                ' This line contains an unrecognized item.
                arc.AddError
                
        End Select
    Loop While True
    
    mLoadedFromFile = arc.fileName

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

Private Sub Class_Initialize()
    mUniqueID = GetUniqueID
    mIgnoreBlanks = True
    mType = otNONE
End Sub

Public Function PrepareOutput() As Boolean
    PrepareOutput = mTables.PrepareOutput
End Function
Public Sub CleanUp()
    mTables.CleanUp
End Sub