cinputobject.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 = "CInputObject"
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:
' [e-mail] or [e-mail]

Option Explicit

'local variable(s) to hold property value(s)
Private mInputObject As Object
Private mvarInputType As eInputType

Private mFileName As String
Private mUserID As String
Private mPwd As String
Private mAutoRun As Boolean

Private mLastItemReferenced As Variant

' Speed up finding "next" delimiter when items are referenced
' in order. Instead of having to count delimiters from beginning.
Private mLastDelimiter As Long
Private mLastDelimiterStringPos As Long
Private mLastDelimiterValue As String

Public Function EditProperties()
    With frmInputDefaults
        .Source = mFileName
        .UID = mUserID
        .Pwd = mPwd
        .AutoRun = mAutoRun
        .Show vbModal
        
        If GFormReturnValue = vbOK Then
            fileName = .Source
            mUserID = .UID
            mPwd = .Pwd
            mAutoRun = .AutoRun
        End If
    End With
    
    Unload frmInputDefaults
    
End Function

Public Function GetLastItemReferenced() As Variant
    GetLastItemReferenced = mLastItemReferenced
End Function

Public Property Let InputType(ByVal vData As eInputType)
    CreateInputObjectReference vData
    mvarInputType = vData
End Property

Public Function SupportsGetSchema() As Boolean
    If Not mInputObject Is Nothing Then
        SupportsGetSchema = mInputObject.SupportsGetSchema()
    Else
        SupportsGetSchema = False
    End If
End Function
' This function will import a schema and return a 2 dimensional array
' in the form Array(TableName, FieldName) for each schema element.
Public Function GetSchema() As String()
    If Not mInputObject Is Nothing Then
        GetSchema = mInputObject.GetSchema()
    End If
End Function

Private Function CreateInputObjectReference(newType As eInputType) As Boolean
    
    CreateInputObjectReference = True
    
    ' Don't recreate input object if it already exists.
    If newType = mvarInputType Then Exit Function
    
    Set mInputObject = Nothing
    
    Select Case newType
        Case eInputType.ASCII
            Set mInputObject = New CInputObjImplAscii
        Case eInputType.DB
            Set mInputObject = New CInputObjImplDB
        Case eInputType.SQLDB
            Set mInputObject = New CInputObjImplSQL
        Case Else
            LogError "CInputObject", "InputType", "Unsupported Input Object Type"
            CreateInputObjectReference = False
            Exit Function
    End Select
    
    mvarInputType = newType
    
    ' Setup the properties for the new object.
    mInputObject.fileName = Me.fileName
    
End Function

Public Function OpenInput() As Integer
    On Error GoTo eHandler
    
    OpenInput = 0
    
    ' Reset the cache that speeds up finding delimited values.
    ResetDelimitedCache
    
    If mInputObject Is Nothing Then
        If Not CreateInputObjectReference(mvarInputType) Then Exit Function
    End If

    mInputObject.fileName = mFileName
    
    OpenInput = mInputObject.OpenInput()
    If mInputObject.fileName <> Me.fileName Then
        Me.fileName = mInputObject.fileName
    End If

    Exit Function

eHandler:
    LogError "CInputObject", "OpenInput", Error(Err)
    OpenInput = Err
End Function

' Close open files, etc...
Public Sub CloseInput()
    If mInputObject Is Nothing Then Exit Sub
    
    ' Reset the cache that speeds up finding delimited values.
    ResetDelimitedCache
    
    ' Set info for error logging.
    mLastItemReferenced = vbEmpty

    mInputObject.CloseInput
End Sub

Public Property Get InputType() As eInputType
    InputType = mvarInputType
End Property

Public Function GetLineNumber() As Long
    If mInputObject Is Nothing Then Exit Function
    GetLineNumber = mInputObject.GetLineNumber()
End Function

Public Function GotoLine(LineNumber As Long) As Long
    If mInputObject Is Nothing Then Exit Function
    
    ' Reset the cache that speeds up finding delimited values.
    ResetDelimitedCache
    
    GotoLine = mInputObject.GotoLine(LineNumber)
End Function

Public Function GetNextLine() As Variant
    If mInputObject Is Nothing Then Exit Function
    
    ' Reset the cache that speeds up finding delimited values.
    ResetDelimitedCache

    GetNextLine = mInputObject.GetNextLine()
End Function

Public Function GetCurrentLine() As Variant
    If mInputObject Is Nothing Then Exit Function
    GetCurrentLine = mInputObject.GetCurrentLine()
    mLastItemReferenced = GetCurrentLine
End Function

Public Property Let fileName(ByVal vData As String)
    mFileName = vData
    If Not mInputObject Is Nothing Then
        mInputObject.fileName = mFileName
    End If
End Property
Public Property Get fileName() As String
    fileName = mFileName
End Property

Public Function IsEOF() As Boolean
    IsEOF = mInputObject.IsEOF
End Function

Private Sub Class_Initialize()
    Set mInputObject = Nothing
    mvarInputType = eInputType.none
    ' Reset the cache that speeds up finding delimited values.
    ResetDelimitedCache
End Sub

Public Function GetValue(start As Integer, Length As Integer) As Variant
    On Error Resume Next
    GetValue = ""
    GetValue = Mid(GetCurrentLine(), start, Length)
    mLastItemReferenced = GetValue
End Function

Public Function GetDelimitedValue(ByVal pos As Integer, ByVal delim As String) As Variant

    On Error GoTo eHandler
        
    Dim i1 As Integer, i2 As Integer, Count As Integer
    Dim line As String, CountFrom As Integer
    
    GetDelimitedValue = ""
    line = GetCurrentLine
    If Trim(line) = "" Then Exit Function
    
    ' Convert special characters e.g. #9 into the characters they represent.
    FixUpDelimiter delim
        
    ' If we are getting the next value after whatever value we got
    ' last time, we can save ourselves some work by starting
    ' where we left off.
    If mLastDelimiterValue = delim And pos > mLastDelimiter Then
        i1 = mLastDelimiterStringPos
        CountFrom = mLastDelimiter
    Else
        i1 = 1
        CountFrom = 1
    End If

    ' Count delimiters until just before the data item we want.
    For Count = CountFrom To pos - 1
        i1 = InStr(i1, line, delim)
        If i1 < 1 Then Exit Function
        i1 = i1 + 1
    Next
    
    ' Cache this info to speed things up next time.
    CacheDelimitedValues delim, pos, i1
    
    ' There are two delimiters back to back with no spaces.
    If Mid(line, i1, Len(delim)) = delim Then
        Exit Function
    End If
    
    ' Get the delmiter that marks the end of the item.
    i2 = InStr(i1, line, delim) - i1

    ' If no more delimiters, get everything to the end of the line.
    If i2 < 1 Then i2 = Len(line) - i1 + 1

    ' Get everything from between the 2 enclosing delimiters.
    GetDelimitedValue = Mid(line, i1, i2)
    mLastItemReferenced = GetDelimitedValue
    
    Exit Function

eHandler:
    LogError "CInputObject", "GetDelimitedValue", Error(Err)
'
End Function

Private Sub CacheDelimitedValues(DelimiterValue As String, DelimiterPos As Integer, StringPos As Integer)
    mLastDelimiterValue = DelimiterValue
    mLastDelimiter = DelimiterPos
    mLastDelimiterStringPos = StringPos
End Sub

Private Sub ResetDelimitedCache()

    ' Set the delimiter positions very high initially so that
    ' the test if DelimiterPos > PrevDelimiterPos will initially fail.
    mLastDelimiterValue = ""
    mLastDelimiter = &HFFFFFFF
    mLastDelimiterStringPos = &HFFFFFFF
End Sub

Public Sub FixUpDelimiter(ByRef delim As String)
    Dim temp As String
    Dim i As Integer, j As Integer
    On Error GoTo eHandler

    temp = delim
    delim = ""
    For i = 1 To Len(temp)
        If Mid(temp, i, 1) = "#" Then
            j = 0
            While Mid(temp, i + j + 1, 1) <= "9" And Mid(temp, i + j + 1, 1) >= "0"
                j = j + 1
            Wend
            If j > 0 Then
                delim = delim & Chr(CInt(Mid(temp, i + 1, j)))
                i = i + j
            Else
                delim = delim & Mid(temp, i, 1)
            End If
        Else
            delim = delim & Mid(temp, i, 1)
        End If
    Next i
    Exit Sub
    
eHandler:
    Resume
End Sub

' 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 retVal As Integer
    Dim value As Variant, item As String
    
    Load = False
    
    ' Make sure nothing is still open.
    CloseInput
    
    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 "SOURCE"
                fileName = value
            Case "USERID"
                mUserID = value
            Case "PWD"
                mPwd = value
            Case "OBJTYPE"
                InputType = value
                CreateInputObjectReference InputType
            Case "BEGIN OBJECT"
                mInputObject.Load arc
        End Select
    
    Loop While True
    Load = True
    
terminate:
    Exit Function
    
eHandler:
    LogError "CInputObject", "Load", Error(Err)
End Function

Public Function Save(ByRef arc As CArchive) As Boolean
    On Error GoTo eHandler
    Save = False
    Dim ol As COutputLinks

    arc.SaveItem aiBEGININPUTOBJECT

    arc.SaveItem aiVALUE, "SOURCE", fileName
    arc.SaveItem aiVALUE, "USERID", mUserID
    arc.SaveItem aiVALUE, "PWD", mPwd

    arc.SaveItem aiVALUE, "OBJTYPE", InputType
    
    If Not mInputObject Is Nothing Then
        mInputObject.Save arc
    End If
    
    arc.SaveItem aiENDITEM
    Save = True
    Exit Function

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