cinputrecords.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 = "CInputRecords"
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" ,"CCheckPoint"
Attribute VB_Ext_KEY = "Member0" ,"CCheckPoint"
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]

'local variable to hold collection
Private mCol As Collection

Public Sub ClearLinks()
    Dim cp As CInputRecord
    For Each cp In mCol
        cp.ClearLinks
    Next cp
End Sub

Public Function InsertCheckpointObject(newObj As CInputRecord, insertAt As Integer) As CInputRecord
    On Error GoTo eHandler
    Dim i As Integer
    Set InsertCheckpointObject = Nothing
    
    If newObj Is Nothing Then Exit Function
    
    newObj.index = insertAt

    If insertAt > mCol.Count Then
        ' Insert as last item.
        newObj.index = insertAt
        mCol.Add newObj, newObj.GetID
    Else
        ' Insert the item into our collection before the item that
        ' currently occupies the position indicated.
        mCol.Add newObj, newObj.GetID, mCol(insertAt).GetID
        
        For i = mCol.Count To insertAt + 1 Step -1
            mCol(i).index = i
        Next i
    End If
    
    Set InsertCheckpointObject = newObj
    Exit Function
eHandler:

End Function

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

    Dim newObj As CInputRecords
    Set newObj = New CInputRecords
    Dim obj As CInputRecord
    
    For Each obj In mCol
        newObj.Add obj.Copy
    Next obj
    Set Copy = newObj
    Set newObj = Nothing
    Exit Function

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

End Function

Public Function ItemByName(name As String) As CInputRecord
    On Error GoTo eHandler
    Set ItemByName = Nothing
    
    Dim cp As CInputRecord
    
    For Each cp In mCol
        If cp.name = name Then
            Set ItemByName = cp
            Set cp = Nothing
            Exit Function
        End If
    Next cp
    Exit Function
    
eHandler:
    LogError "CInputRecords", "ItemByName", Error(Err)
End Function

Public Function Add(Optional newItem As CInputRecord = Nothing, Optional AutoIndex As Boolean = True) As CInputRecord
    
    On Error GoTo eHandler
    Set Add = Nothing
    
    ' Create a new object
    Dim objNewMember As CInputRecord
    
    If newItem Is Nothing Then
        Set objNewMember = New CInputRecord
    Else
        Set objNewMember = newItem
    End If
    
    ' Automatically calculate the index value to place the
    ' new member at the end of our list of checkpoints.
    If AutoIndex Then
        Dim highest As Integer
        Dim item As CInputRecord
        highest = 0
        
        ' Find the current highest index.
        For Each item In mCol
            If item.index > highest Then
                highest = item.index
            End If
        Next
        
        ' Add the new index.
        objNewMember.index = highest + 1
    End If
    
    ' Add the object to our collection.
    mCol.Add objNewMember, objNewMember.GetID
    
    ' Return the object created
    Set Add = objNewMember
    
    Exit Function
    
eHandler:
    LogError "CInputRecords", "Add", Error(Err)
    
End Function

Public Function Import(line As String) As Boolean

    On Error GoTo eHandler
    
    Import = False
    ' Pass it to each of our checkpoints for processing.
    For Each cp In mCol
        cp.Import line
        If GCancelImport Then Exit Function
    Next
    
    Import = True
    Exit Function
eHandler:
    LogError "CInputRecords", "Import", Error(Err)
    
End Function

Public Property Get item(vntIndexKey As Variant) As CInputRecord
Attribute item.VB_UserMemId = 0
    On Error Resume Next
    
    Set item = Nothing
    
    'used when referencing an element in the collection
    'vntIndexKey contains either the Index or Key to the collection,
    'this is why it is declared as a Variant
    'Syntax: Set foo = x.Item(xyz) or Set foo = x.Item(5)
  
    Set item = mCol(vntIndexKey)
  
End Property



Public Property Get Count() As Long
    'used when retrieving the number of elements in the
    'collection. Syntax: Debug.Print x.Count
    Count = mCol.Count
End Property


Public Sub Remove(vntIndexKey As Variant)
    'used when removing an element from the collection
    'vntIndexKey contains either the Index or Key, which is why
    'it is declared as a Variant
    'Syntax: x.Remove(xyz)


    mCol.Remove vntIndexKey
End Sub

Public Property Get NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
Attribute NewEnum.VB_MemberFlags = "40"
    'this property allows you to enumerate
    'this collection with the For...Each syntax
    Set NewEnum = mCol.[_NewEnum]
End Property

Private Sub Class_Initialize()
    '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

' Reorder the items in our collection by index.
Public Sub Reorder()

    Dim temp As Collection
    Dim i As Integer
    If mCol.Count < 1 Then Exit Sub
    Set temp = mCol
    Set mCol = Nothing
    Set mCol = New Collection
    
    i = 0
    Do While temp.Count > 0
        Dim obj As Object
        Dim j As Integer
        Dim smallest As Integer
            
        i = i + 1       'Incremement the new index.
        
        '***************************************
        ' Find the object with the lowest index.
        '***************************************
        
        smallest = 1
        For j = 1 To temp.Count
            If temp(j).index < temp(smallest).index Then
                smallest = j
            End If
        Next j
        
        Set obj = temp(smallest)
        obj.index = i
        mCol.Add item:=obj, key:=obj.GetID
        temp.Remove obj.GetID
        Set obj = Nothing
    Loop

End Sub

Public Function Save(arc As CArchive) As Boolean
    On Error GoTo eHandler
    Save = False
    
    Dim cp As CInputRecord
    For Each cp In mCol
        If cp.Save(arc) = False Then Exit Function
        Set cp = Nothing
        arc.SaveItem aiBLANKLINE
    Next

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