cimport.cls

Data monkey是一个强大的是数据传输和转换应用程序。使用DataMonkey用户可以把复杂的文本文件格式

' Actually import the data from the datafile.
Public Function Import(Optional ImportFileName As String = "") As Boolean

    On Error GoTo eHandler

    Dim LogFileOpened As Boolean

    Import = False
    GCancelImport = False
    
    ' So we will know if there are any errors in the log afterwards.
    ResetErrorCount

    mSkipLines = 0

    If mLogToFile Then
        ' Open the error log.
        LogFileOpened = OpenLogFile("Initializing Import", _
                                    mLogFilePath, mOverwriteLogfile)
    Else
        LogFileOpened = False
    End If

    '*********************************************
    ' Setup the object that will feed us the data.
    '*********************************************

    'Set mInputObject = New CInputObject
    'mInputObject.InputType = mvarInputSourceType
    'mInputObject.fileName = ImportFileName

    If mInputObject.OpenInput() <> 0 Then
        If Not GCancelImport Then
            LogError "CImport", "Import", "Unable to open Input Source '" & mInputObject.fileName & "'"
        End If
        GoTo done
    End If
    
    '*********************************************************
    ' Select a set of links that has been defined to map
    ' the Input to the Output. This will also tell us what
    ' OutputSchema and what type of output we are going to use
    '*********************************************************

    Dim LinkIndex As Integer
    frmSelectOutputLinks.Show vbModal
    LinkIndex = frmSelectOutputLinks.OutputLinksIndex
    Unload frmSelectOutputLinks
    If GFormReturnValue = vbCancel Then
        GCancelImport = True
        GoTo done
    End If
    
    '*******************************
    ' Instantiate the Schema Object.
    '*******************************
    
    Dim arc As New CArchive
    Set mSchema = New COutputSchema
    ' The link object tries to keep track of the schema file.
    arc.fileName = mOutputLinks(LinkIndex).SchemaFileLastKnownLocation
    Do While Not arc.OpenFile()
        arc.fileName = mOutputLinks(LinkIndex).LocateSchemaFile
        If Len(Trim(arc.fileName)) = 0 Then
            'MsgBox "Import cancelled", vbOKOnly, "Cancelled"
            LogError "CImport", "Import", "Import Cancelled", True
            GoTo done
        End If
    Loop

    If Len(arc.fileName) = 0 Then
        mSchema.SchemaType = otNONE
    Else
        If Not mSchema.Load(arc) Then GoTo done
        ' Make sure the schema file location is up to date.
        arc.CloseFile
    End If

    '*********************************************
    ' Link up the Input Items to the SchemaObject.
    '*********************************************
    
    If Not mOutputLinks(LinkIndex).LinkUp(mCheckPts, mSchema) Then
        GoTo done
    End If
    
    '*************************************************************
    ' Instantiate the object that will handle the physical output.
    '*************************************************************

    Set mOutputObject = New COutputObject
    mOutputObject.OutputType = mOutputLinks(LinkIndex).OutputTo
    If mOutputObject.OpenOutput() <> 0 Then
        If Not GCancelImport Then
            LogError "CImport", "Import", "Unable to open Output Source '" & mOutputObject.fileName & "'"
        End If
        GoTo done
    End If
    
    ' Prepare the output object to receive data.
    If Not mSchema.PrepareOutput Then GoTo done

    Dim info As String
    info = "Import information" & vbCrLf
    info = info & "Import project: " & Me.name & vbCrLf
    info = info & "Input file: " & Me.GetInputObject.fileName & vbCrLf
    info = info & "Output file: " & Me.GetOutputObject.fileName & vbCrLf
    info = info & "Output links: " & mOutputLinks(LinkIndex).name
    LogComment info, "?"

    '****************************************************************
    ' Execute our actions, one of which will process the checkpoints.
    '****************************************************************
    
    GImportInProgress = True
    
    Dim act As Object
    For Each act In mActions
        
        If GCancelImport = True Then Exit For

        If act.CmdType = eCmdTypes.cmdExecute Then
            ' Do the bulk of the import.
            ProcessChildren
        Else
            If act.Execute() = False Then Exit Function
        End If
    Next act

    Import = Not GCancelImport

done:
    On Error Resume Next
    
    ' No longer report 'in process' error info.
    GImportInProgress = False
    
    ' Finish flushing data, etc...
    mSchema.CleanUp
    
    ' Close the input source.
    mInputObject.CloseInput
    
    ' Close the output source.
    mOutputObject.CloseOutput
    
    Set mOutputObject = Nothing
    Set mSchema = Nothing
    
    ' Close the error log.
    CloseLogFile
    
    ' If we were unable to open a logfile, reset the error
    ' count so the calling process won't ask the user to
    ' 'Check the log file'
    If Not LogFileOpened Then ResetErrorCount

    Exit Function
    
eHandler:
    GImportInProgress = False
    LogError "CImport", "Import", Error(Err)
    GoTo done
End Function

' This does the bulk of the importing, getting data from the
' input object and passing it to the checkpoints for processing.
Public Sub ProcessChildren()
    On Error GoTo eHandler
    
    Dim cp As CInputRecord
    Dim line As String
    Dim i As Long
    
    fMainForm.MousePointer = vbHourglass
    frmImporting.Show , fMainForm
    
    '**********************************************************
    ' Loop until we are out of data or the import is cancelled.
    '**********************************************************
    
    Do While Not mInputObject.IsEOF() And Not GCancelImport

        ' Get the next line of data.
        line = mInputObject.GetNextLine()
        
        If mSkipLines > 0 Then
            mSkipLines = mSkipLines - 1
        Else
            ' Give the data to our checkpoints to process.
            mCheckPts.Import line
        End If
        
        i = mInputObject.GetLineNumber
        If i Mod 10 = 0 Then
            DoEvents
            frmImporting.SetLineNumber i
        End If
        
    Loop
    
finished:
    fMainForm.MousePointer = vbDefault
    Unload frmImporting
    Exit Sub
    
eHandler:
    LogError "CImport", "ProcessChildren", Error(Err)
    GoTo finished
End Sub

' Unused.
Public Function Verify(ImportFileSource As String) As Boolean
End Function

' Load the gimport object from the file opened in the global Archive
' object.
Public Function Load(arc As CArchive) As Boolean
 
    On Error GoTo eHandler
    
    Dim i As Integer, retVal As Integer
    Dim value As Variant, item As String
    
    Load = False
            
    Do
        retVal = arc.GetNextItem(item, value)

        ' Error, log it, then exit with error.
        If retVal = ArcRetType.cERROR Then
            arc.AddError
            GoTo terminate
            
        ' We are done with this object, leave.
        ElseIf retVal = ArcRetType.cENDITEM Then
            Exit Do
        End If

        Select Case item
            Case "NAME"
                mvarname = value
            Case "VERSION"
                mVersion = value
                If GVersion <> value Then
                    LogError "CImport", "Load", _
                        "The project you are loading was created with a differnt version of this application (" _
                        & mVersion & _
                        ") and may not load properly. If you choose to save this project, it will be saved in the current format (" _
                        & GVersion & _
                        ") and may not load correctly in other versions of this application", _
                        False
                End If

            Case "SINGLELINEFORMAT"
                mVarIsSingleLineFormat = value
            Case "DELIMITED"
                mVarIsDelimited = value
            Case "DELIMITER"
                mvarDelimiter = value
            Case "MULTIPASS"
                mVarMultiPass = value
            Case "LOGTOFILE"
                mLogToFile = value
            Case "LOGFILE"
                mLogFilePath = value
            Case "OVERWRITELOGFILE"
                mOverwriteLogfile = value
            Case "BEGIN CHECKPOINT"
                AddCheckPoint().Load arc
            Case "BEGIN ACTION"
                AddAction(GCmdHelper.CommandTypeFromName(CStr(value))).Load arc
            Case "BEGIN OUTPUTLINKSMANAGER"
                mOutputLinks.Load arc
            Case "BEGIN INPUTOBJECT"
                mInputObject.Load arc
            Case "INPUTTYPE"
                InputSourceType = GetInputSourceValue(value)
            
        End Select
    
    Loop While True
        
    Me.dirty = False
    Load = True
    
terminate:
    
    Exit Function
    
eHandler:

    LogError "CImport", "Load", Error(Err)
End Function

Private Sub Class_Initialize()
    Set mCheckPts = New CInputRecords
    Set mActions = New CActions
    Set mInputObject = New CInputObject
    Set mOutputObject = Nothing
    mLogToFile = False
    mSkipLines = 0
    mVersion = GVersion
    mUniqueID = GetUniqueID
    mDirty = False
End Sub

' Change the name of a checkpoint, and all associates.
Public Function ChangeCheckPointName(id As String, newName As String) As Boolean

    ChangeCheckPointName = False
    
    Dim cp As CInputRecord
    
    ' Get the checkpoint.
    Set cp = GetCheckPoint(id)
    
    If cp Is Nothing Then
        MsgBox "Cannot find CheckPoint", vbCritical, "Error"
    Else
        ' Change the name.
        GImport.GetOutputLinksManager.ChangedCheckPointName cp.name, newName
        cp.name = newName
    End If
    
    Set cp = Nothing
    ChangeCheckPointName = True

End Function

Private Sub Class_Terminate()
    Set mCheckPts = Nothing
    Set mActions = Nothing
    Set mInputObject = Nothing
    Set mOutputObject = Nothing
End Sub