⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 cimport.cls

📁 Data monkey是一个强大的是数据传输和转换应用程序。使用DataMonkey用户可以把复杂的文本文件格式
💻 CLS
📖 第 1 页 / 共 2 页
字号:
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CImport"
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:
' TheodoreWard@Hotmail.com or TheodoreWard@Yahoo.com

Option Explicit
Option Compare Text

'********************************************
'local variable(s) to hold property value(s).
'********************************************

Private mSkipLines As Integer
Private mOverwriteLogfile As Boolean
Private mLogFilePath As String
Private mLogToFile As Boolean
Private mVersion As String
Private mCheckPts As CInputRecords
Private mActions As New CActions
Private mInputObject As CInputObject
Private mOutputObject As COutputObject
Private mvarname As String 'local copy
Private mVarIsDelimited As Boolean 'local copy
Private mVarIsSingleLineFormat As Boolean 'local copy
Private mVarMultiPass As Boolean 'local copy
Private mvarDelimiter As String 'local copy
Private mvarInputSourceType As eInputType 'local copy
Private mUniqueID As String
Private mOutputLinks As New COutputLinksManager
Private mSchema As New COutputSchema
Private mDirty As Boolean

Public Property Let dirty(NewValue As Boolean)
    mDirty = NewValue
End Property
Public Property Get dirty() As Boolean
    dirty = mDirty
End Property

' Return the UniqueID for this object.
Public Function GetID() As String
    GetID = mUniqueID
End Function

' Return the object that keeps track of our various Output Links objects.
Public Function GetOutputLinksManager() As COutputLinksManager
    Set GetOutputLinksManager = mOutputLinks
End Function

' Get a specific Import level action.
Public Function GetAction(ActionKey As Variant) As Object
    Set GetAction = mActions.item(ActionKey)
End Function

' Get our Action object collection.
Public Function GetActions() As CActions
    Set GetActions = mActions
End Function

' Add a new action to our collection.
Public Function AddAction(key As eCmdTypes) As Object
    Set AddAction = mActions.AddNew(key)
End Function

' The type of object we will be importing from.
Public Property Let InputSourceType(ByVal vData As eInputType)
    mvarInputSourceType = vData
    ' TLW -- Just added this in.
    'Set mInputObject = New CInputObject
    mInputObject.InputType = vData
End Property

Public Property Get InputSourceType() As eInputType
    InputSourceType = mvarInputSourceType
End Property

' Get the object that will read our input source.
Public Function GetInputObject() As CInputObject
    Set GetInputObject = mInputObject
End Function
Public Function GetOutputObject() As COutputObject
    Set GetOutputObject = mOutputObject
End Function

' Get the object which defines the output device.
' This is only available during an actual import.
Public Function GetSchemaObject() As COutputSchema
    Set GetSchemaObject = mSchema
End Function

' Default delimiter used to separate data items in the input.
Public Property Let Delimiter(ByVal vData As String)
    mvarDelimiter = vData
End Property
Public Property Get Delimiter() As String
    Delimiter = mvarDelimiter
End Property

' So far this is unused.
Public Property Let MultiPass(ByVal vData As Boolean)
    mVarMultiPass = vData
End Property
Public Property Get MultiPass() As Boolean
    MultiPass = mVarMultiPass
End Property

' Whether or not we log to file or screen.
Public Property Let LogToFile(ByVal vData As Boolean)
    mLogToFile = vData
End Property
Public Property Get LogToFile() As Boolean
    LogToFile = mLogToFile
End Property

' Describes if the input contains only one, or more than one different
' types of line formats.
' So far, I believe this is unused.
Public Property Let SingleLineFormat(ByVal vData As Boolean)
    mVarIsSingleLineFormat = vData
End Property
Public Property Get SingleLineFormat() As Boolean
    SingleLineFormat = mVarIsSingleLineFormat
End Property

Public Property Let LogFilePath(vData As String)
    mLogFilePath = vData
End Property
Public Property Get LogFilePath() As String
    LogFilePath = mLogFilePath
End Property

Public Property Let OverwriteLogfile(vData As Boolean)
    mOverwriteLogfile = vData
End Property
Public Property Get OverwriteLogfile() As Boolean
    OverwriteLogfile = mOverwriteLogfile
End Property

' Describes whether or not the input lines' data is by default
' delimited or is recognized by position.
Public Property Let Delimited(ByVal vData As Boolean)
    mVarIsDelimited = vData
End Property
Public Property Get Delimited() As Boolean
    Delimited = mVarIsDelimited
End Property

Public Property Let SkipLines(ByVal vData As Integer)
    mSkipLines = vData
End Property
Public Property Get SkipLines() As Integer
    SkipLines = mSkipLines
End Property

' Name of the import object.
Public Property Let name(ByVal vData As String)
    mvarname = vData
End Property
Public Property Get name() As String
    name = mvarname
End Property

' Get a descriptive name to identify the input device.
Public Function GetInputSourceName( _
    Optional ByVal id As eInputType = eInputType.none) _
    As String

    If id = eInputType.none Then id = mvarInputSourceType
    GetInputSourceName = GInputID.GetInputTypeDescription(id)

End Function

' Get the defined type to describe the input device.
Public Function GetInputSourceValue(ByVal id As String) As eInputType
    GetInputSourceValue = eInputType.none
    
    Select Case id
        Case GetInputSourceName(eInputType.ASCII)
            GetInputSourceValue = eInputType.ASCII
        Case GetInputSourceName(eInputType.DB)
            GetInputSourceValue = eInputType.DB
        Case GetInputSourceName(eInputType.SQLDB)
            GetInputSourceValue = eInputType.SQLDB
        Case GetInputSourceName(eInputType.OTHER)
            GetInputSourceValue = eInputType.OTHER
    End Select
    
End Function

' Save the import object.
Public Function Save(arc As CArchive) As Boolean

    On Error GoTo eHandler
    Dim i As Integer
    If arc Is Nothing Then Exit Function
    
    Save = False
    
    If Not arc.SaveItem(aiCOMMENT, "Import definition file") Then Exit Function
    
    ' Save the import properties first.
    If Not arc.SaveItem(aiCOMMENT, "Import Properties") Then Exit Function
    If Not arc.SaveItem(aiBEGINIMPORT, mvarname) Then Exit Function
    If Not arc.SaveItem(aiVALUE, "NAME", mvarname) Then Exit Function
    If Not arc.SaveItem(aiVALUE, "VERSION", GVersion) Then Exit Function
    If Not arc.SaveItem(aiVALUE, "INPUTTYPE", GetInputSourceName(mvarInputSourceType)) Then Exit Function
    If Not arc.SaveItem(aiVALUE, "SINGLELINEFORMAT", str(mVarIsSingleLineFormat)) Then Exit Function
    If Not arc.SaveItem(aiVALUE, "DELIMITED", str(mVarIsDelimited)) Then Exit Function
    If Not arc.SaveItem(aiVALUE, "DELIMITER", mvarDelimiter) Then Exit Function
    If Not arc.SaveItem(aiVALUE, "MULTIPASS", str(mVarMultiPass)) Then Exit Function
    If Not arc.SaveItem(aiVALUE, "LOGTOFILE", mLogToFile) Then Exit Function
    If Not arc.SaveItem(aiVALUE, "LOGFILE", mLogFilePath) Then Exit Function
    If Not arc.SaveItem(aiVALUE, "OVERWRITELOGFILE", mOverwriteLogfile) Then Exit Function

    ' Save the Action structures.
    arc.SaveItem aiCOMMENT, "Begin Actions for Import " + mvarname
    mActions.Save arc

    ' Save the Checkpoint structures.
    arc.SaveItem aiCOMMENT, "Begin CheckPoints for Import " + mvarname
    mCheckPts.Save arc
    
    ' Save the defined output links.
    arc.SaveItem aiCOMMENT, "Begin Output Links for Import " + mvarname
    mOutputLinks.Save arc

    ' Save the input object.
    arc.SaveItem aiCOMMENT, "Begin Input Object"
    mInputObject.Save arc
    
    ' Write the end block for the entire Import.
    arc.SaveItem aiENDITEM

    Me.dirty = False
    Save = True

terminate:
    Exit Function
    
eHandler:
    LogError "CImport", "Save", Error(Err)
End Function

' Return a checkpoint based on the key or index from our collection.
Public Function GetCheckPoint(CheckPointKey As Variant) As CInputRecord
    Set GetCheckPoint = mCheckPts.item(CheckPointKey)
End Function

' Return a checkpoint based on it's name from our collection.
Public Function GetCheckPointByName(cpName As String) As CInputRecord
    Dim cp As CInputRecord
    For Each cp In mCheckPts
        If cp.name = cpName Then
            Set GetCheckPointByName = cp
            Exit Function
        End If
    Next cp
End Function

' Get the checkpoint collection.
Public Function GetCheckPoints() As CInputRecords
    Set GetCheckPoints = mCheckPts
End Function

' Add a new checkpoint to the collection.
Public Function AddCheckPoint(Optional DefaultName As Boolean = False) As CInputRecord
    
    Set AddCheckPoint = Nothing
    On Error GoTo eHandler
    
    Dim cp As CInputRecord
        
    ' Create a new CheckPoint and add it to our import object.
    Set cp = mCheckPts.Add

    If DefaultName Then
        Dim i As Integer
        Dim name As String
        Dim temp As CInputRecord
        
        ' Default name for new data item.
        name = "New CheckPoint"
        
        ' Increment the number on the end of the name until
        ' we find a name that doesn't already exist.
        i = 0
        Do
            i = i + 1
            Set temp = Nothing
            Set temp = GetCheckPointByName(name + Trim(str(i)))
        Loop While Not temp Is Nothing
        
        ' Make the new name permanent.
        cp.name = name + Trim(str(i))
        cp.index = mCheckPts.Count

    End If
    
    Set AddCheckPoint = cp
    Set cp = Nothing
    
    Exit Function

eHandler:
    LogError "Import", "AddCheckPoint", Error(Err)
    
End Function

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -