coutputlinks.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 = "COutputLinks"
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 = "Collection" ,"COutputLink"
Attribute VB_Ext_KEY = "Member0" ,"COutputLink"
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 mOutputSourceLocation As String
Private mOutputSource As String
Private mName As String
Private mVerifyOutput As Boolean
Private mCol As Collection
Private mUniqueID As String
Private mType As otOutputSourceType

Private mOutputProperties

Public Property Let OutputTo(vData As otOutputSourceType)
    mType = vData
End Property

Public Property Get OutputTo() As otOutputSourceType
    OutputTo = mType
End Property

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

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

    Dim newObj As COutputLinks
    Set newObj = New COutputLinks
    Dim obj As COutputLink
    
    ' Copy all the objects.
    For Each obj In mCol
        newObj.AddObject obj.Copy
    Next obj
    
    newObj.name = Me.name
    newObj.OutputSourceName = Me.OutputSourceName
    newObj.SchemaFileLastKnownLocation = Me.SchemaFileLastKnownLocation
    newObj.VerifyOutput = Me.VerifyOutput
    
    Set Copy = newObj
    Set newObj = Nothing
    Exit Function

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

End Function

Public Function DisableLinksToTable(TableName As String) As Integer
    
    ' Disable all the links to the given table.
    Dim ol As COutputLink
    Dim Count As Integer
    Count = 0
    
    For Each ol In mCol
        If ol.LinkToTable = TableName Then
            ' Disable this link.
            ol.IgnoreMe = True
            Count = Count + 1
        End If
    Next

    DisableLinksToTable = Count
End Function

Public Function DisableLinksFromTable(TableName As String) As Integer
    
    ' Disable all the links to the given table.
    Dim ol As COutputLink
    Dim Count As Integer
    Count = 0
    
    For Each ol In mCol
        If ol.LinkFromTable = TableName Then
            ' Disable this link.
            ol.IgnoreMe = True
            Count = Count + 1
        End If
    Next

    DisableLinksFromTable = Count
End Function

Public Function LinkUp(ByRef CPs As CInputRecords, ByRef sch As COutputSchema) As Boolean

    On Error GoTo eHandler
    LinkUp = False
    Dim pos As Integer
    Dim ol As COutputLink
    Dim di As CInputField
    Dim cp As CInputRecord
    
    ' Clear out any previous links.
    GImport.GetCheckPoints.ClearLinks
    
    ' Reset all the links initially. Don't do this in the loop below,
    ' because if a link gets disabled within the loop, we want it to
    ' stay disabled. And we don't neccessarily disable them in order.
    For Each ol In mCol
        ol.IgnoreMe = False
    Next ol
    
    '**************************************************************
    ' In this big ol' loop, find the CInputField we are linking from.
    ' and the COutputTarget we are linking to, then give the
    ' CInputField a reference to the COutputTarget item.
    '**************************************************************
    
    For Each ol In mCol
        
        ' If link has been disabled, skip it.
        If ol.IgnoreMe Then GoTo LoopBottom
        
        ' Get a reference to the LinkFrom DataItem.
        Set cp = CPs.ItemByName(ol.LinkFromTable)

        If Not cp Is Nothing Then
            Set di = cp.GetDataPointByName(ol.LinkFromField)
            If di Is Nothing Then
                LogError "COutputLinks", "LinkUp", "There is a link from an Input Field named '" + ol.LinkFromField + "' specified, but the input field is not defined for the line '" & cp.name & "'. This link will be ignored."
                
                ' Disable this link.
                ol.IgnoreMe = True
                GoTo LoopBottom
            End If
        Else
            LogError "COutputLinks", "LinkUp", "There are one or more links from an Input Line named '" + ol.LinkFromTable + "' specified, but the Line is not defined. All links from this table will be ignored."
            ' Diable all the links from this nonexistant table.
            DisableLinksFromTable ol.LinkFromTable
            GoTo LoopBottom
        End If
        
        Dim ot As COutputTargetTable
        Dim of As COutputTargetField

        ' Make sure the output targets exist as well.
        Set ot = sch.GetOutputTables.ItemByName(ol.LinkToTable)
        If ot Is Nothing Then
            LogError "COutputLinks", "LinkUp", "There are one or more links to an Output Table named '" + ol.LinkToTable + "' specified, but the table is not defined in the Schema '" & sch.name & "'. All links to this table will be ignored."
            
            ' Delete all the links to the nonexistant table.
            DisableLinksToTable ol.LinkToTable
            
            GoTo LoopBottom
        Else
            Set of = ot.GetFields.ItemByName(ol.LinkToField)
            If of Is Nothing Then
                LogError "COutputLinks", "LinkUp", "There is a link to an Output Field named '" + ol.LinkToField + "' specified, but the field does not exist in the output table '" & ol.LinkToTable & "' in the Schema '" & sch.name & "'. This link will be ignored.", True

                ' Disable this link.
                ol.IgnoreMe = True
                GoTo LoopBottom
            End If
        End If

        '**************
        ' Set the link.
        '**************
        
        di.AddStorageLink ol
                
LoopBottom:
        Set di = Nothing
        Set cp = Nothing
    Next ol
    
    LinkUp = True
    Exit Function
eHandler:
    LogError "COutputLinks", "LinkUp", Error(Err)
    
End Function

Public Property Get OutputSourceName() As String
    OutputSourceName = mOutputSource
End Property
Public Property Let OutputSourceName(newName As String)
    mOutputSource = newName
End Property

Public Property Get SchemaFileLastKnownLocation() As String
    SchemaFileLastKnownLocation = mOutputSourceLocation
End Property
Public Property Let SchemaFileLastKnownLocation(newName As String)
    Dim i As Integer
    i = Len(GOutputSourceDirectory)

' TLW -- THIS NEEDS TESTED/REFINED!!!!
    ' If the schema file is in our standard schema directory
    If left$(newName, i) = GOutputSourceDirectory Then
        i = Len(GOutputSourceDirectory) - i
        mOutputSourceLocation = right$(newName, i)
    Else
        mOutputSourceLocation = newName
    End If
    
End Property
Public Function LocateSchemaFile() As String

    On Error GoTo eHandler
    LocateSchemaFile = ""
    
    ' Get the name of the file the user wants to import.
    With fMainForm.dlgCommonDialog
        .fileName = mOutputSourceLocation
        .Filter = "Schema Files(*.sch)|*.sch|All Files (*.*)|*.*"
        .DialogTitle = "Locate Schema File for " + mName
        On Error Resume Next
        .ShowOpen
        
        If Err = 32755 Then ' Dialog cancelled.
            Exit Function
        End If
        
        On Error GoTo eHandler
        mOutputSourceLocation = Trim(.fileName)
        GetNameFromFile mOutputSourceLocation, mOutputSource
        LocateSchemaFile = mOutputSourceLocation
    End With
    Exit Function
eHandler:
    LogError "COutputLinks", "LocateSchemaFile", Error(Err), False
End Function

Public Function Edit() As Integer
    frmOutputProperties.Initialize Me
    frmOutputProperties.Show vbModal
    Edit = GFormReturnValue
End Function

Public Property Get name() As String
    name = mName
End Property
Public Property Let name(newName As String)
    mName = newName
End Property
Public Property Get VerifyOutput() As Boolean
    VerifyOutput = mVerifyOutput
End Property
Public Property Let VerifyOutput(ver As Boolean)
    mVerifyOutput = ver
End Property

Public Function GetLinkTo(Optional Table As String = "", _
                    Optional Field As String = "") As COutputLink
    
    On Error GoTo eHandler
    
    Set GetLinkTo = Nothing

    ' If we have no links, its easy.
    If mCol.Count > 0 Then
        Dim ol As COutputLink
        For Each ol In mCol
        
            If (Table = "" And ol.LinkToField = Field) Or _
               (Field = "" And ol.LinkToTable = Table) Or _
               (ol.LinkToTable = Table And ol.LinkToField = Field) Then
                Set GetLinkTo = ol
                Exit Function
            End If
        Next ol
    End If
    Exit Function
    
eHandler:
    LogError "COutputLinks", "GetLinkTo", Error(Err)
End Function

Public Function GetLinkFrom(Optional Table As String = "", _
                        Optional Field As String = "") As COutputLink
        
    Set GetLinkFrom = Nothing
    
    ' If we have no links, its easy.
    If mCol.Count > 0 Then
        Dim ol As COutputLink
        Dim LinkFrom As String

        For Each ol In mCol
            If (Table = "" And ol.LinkFromField = Field) Or _
               (Field = "" And ol.LinkFromTable = Table) Or _
               (ol.LinkFromTable = Table And ol.LinkFromField = Field) Then
                Set GetLinkFrom = ol
                Exit Function
            End If
        Next ol
    End If
End Function

Public Function AddObject(newItem As COutputLink) As COutputLink

    Set AddObject = Nothing
    newItem.index = mCol.Count + 1
    mCol.Add newItem, newItem.GetID
    Set AddObject = newItem

End Function

Public Function Add(Optional DefaultName As Boolean = False) As COutputLink
    'create a new object
    Dim objNewMember As COutputLink
    Set objNewMember = New COutputLink

    objNewMember.index = mCol.Count + 1
    mCol.Add objNewMember, objNewMember.GetID

    'return the object created
    Set Add = objNewMember
    Set objNewMember = Nothing

End Function

Public Function Save(ByRef arc As CArchive) As Boolean
    On Error GoTo eHandler
    Save = False
    Dim ol As COutputLink
    
    arc.SaveItem aiBEGINOUTPUTLINKS
    arc.SaveItem aiVALUE, "NAME", name
    arc.SaveItem aiVALUE, "OUTPUTSOURCE", OutputSourceName
    arc.SaveItem aiVALUE, "OUTPUTSOURCELOCATION", SchemaFileLastKnownLocation
    arc.SaveItem aiVALUE, "VERIFY", VerifyOutput
    arc.SaveItem aiVALUE, "OUTPUTTO", OutputTo

    If mCol.Count > 0 Then
        arc.SaveItem aiCOMMENT, "BEGIN INDIVIDUAL OUTPUT LINK ITEMS"
        For Each ol In mCol
            If Not ol.Save(arc) Then Exit Function
        Next ol
    End If

    Save = True
    arc.SaveItem aiENDITEM
    Exit Function

eHandler:
    LogError "COutputLinks", "Save", Error(Err)
End Function

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"
                name = value
            Case "OUTPUTSOURCELOCATION"
                SchemaFileLastKnownLocation = value
            Case "OUTPUTSOURCE"
                OutputSourceName = value
            Case "VERIFY"
                VerifyOutput = value
            Case "OUTPUTTO"
                OutputTo = value
            Case "BEGIN OUTPUTLINK"
                Add().Load arc

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

    Load = True
done:
    Exit Function

eHandler:
    LogError "COutputLinks", "Load", Error(Err)
End Function

Public Property Get item(vntIndexKey As Variant) As COutputLink
Attribute item.VB_UserMemId = 0
    On Error Resume Next
    Set item = Nothing
    Set item = mCol(vntIndexKey)
End Property

Public Property Get Count() As Long
    Count = mCol.Count
End Property

Public Sub Remove(vntIndexKey As Variant)
    If VarType(vntIndexKey) = vbObject Then
        ' The index is an object of type "COutputLink"
        Dim ol As COutputLink
        Dim n As Integer
        n = 1
        ' Search for this objects index in our collection.
        For Each ol In mCol
            If ol Is vntIndexKey Then
                mCol.Remove n
                Exit For
            End If
            n = n + 1
        Next
    Else
        mCol.Remove vntIndexKey
    End If
End Sub

Public Property Get NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
Attribute NewEnum.VB_MemberFlags = "40"
    Set NewEnum = mCol.[_NewEnum]
End Property

Private Sub Class_Initialize()
    mUniqueID = GetUniqueID
    mVerifyOutput = False
    mType = otNONE
    
    'creates the collection when this class is created
    Set mCol = New Collection
End Sub

Private Sub Class_Terminate()
    'destroys collection when this class is terminated
    Set mCol = Nothing
End Sub