coutputobject.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 = "COutputObject"
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
Private mOutputObject As Object
Private mFileName As String

' Info for logging error messages.
Private mlastOperation As String
Private mLastFieldReferenced As String
Private mLastTableReferenced As String
Private mLastValueReferenced As Variant
Private mType As otOutputSourceType

' Create and return a copy of this object.
Public Function Copy() As COutputObject
    On Error GoTo eHandler
    Set Copy = Nothing

    Dim newObj As COutputObject
    Set newObj = New COutputObject

    newObj.OutputType = Me.OutputType
    newObj.fileName = Me.fileName

    Set Copy = newObj
    Set newObj = Nothing
    Exit Function

eHandler:
    LogError "COutputObject", "copy", Error(Err), False

End Function

' Store an imported value to the given output field.
Public Function StoreValue(hTable As Integer, ByRef value As COutputFieldProxy) As Integer
    On Error Resume Next
    StoreValue = 0
    
    If mOutputObject Is Nothing Then
        Exit Function
    End If

    ' Set info for error logging.
    SetLoggingInfo "StoreValue", hTable, value
    
    StoreValue = mOutputObject.StoreValue(hTable, value)
    
End Function

Public Function GetTableName(hTable As Integer) As String
    GetTableName = mOutputObject.GetTableName(hTable)
End Function

' LocateFor
' If a field named FieldName is found in the table named TableName
' and that field contains the value specified in ForValue then
' the record pointer is positioned to the specified table and
' True is returned.
' Otherwise
' the record pointer position is undefined
' and false is returned.
Public Function LocateFor(hTable As Integer, ForValue As COutputFieldProxy) As Integer
    'On Error Resume Next
    If mOutputObject Is Nothing Then Exit Function
    
    ' Set info for error logging.
    SetLoggingInfo "LocateFor", hTable, ForValue

    LocateFor = mOutputObject.LocateFor(hTable, ForValue)
End Function

Public Function openTable(TableName As String) As Integer
    On Error Resume Next
    openTable = False
    If mOutputObject Is Nothing Then Exit Function
    
    SetLoggingInfo "OpenTable", -1
    mLastTableReferenced = TableName
    openTable = mOutputObject.openTable(TableName)
    
End Function

Public Sub GetLoggingInfo(op As String, Tbl As String, fld As String, val As Variant)
    op = mlastOperation
    Tbl = mLastTableReferenced
    fld = mLastFieldReferenced
    val = mLastValueReferenced
End Sub

Private Sub SetLoggingInfo(op As String, Tbl As Integer, Optional val As COutputFieldProxy = Null)
    mlastOperation = op
    If Tbl = -1 Then
        mLastTableReferenced = ""
    Else
        mLastTableReferenced = mOutputObject.GetTableName(Tbl)
    End If
    
    If val Is Nothing Then
        mLastFieldReferenced = ""
        mLastValueReferenced = ""
    Else
        mLastFieldReferenced = val.name
        mLastValueReferenced = val.value
    End If
    
End Sub

Public Function UpdateTable(hTable As Integer) As Integer
    On Error Resume Next
    
    ' Set info for error logging.
    SetLoggingInfo "UpdateTable", hTable
    
    UpdateTable = mOutputObject.UpdateTable(hTable)
End Function

Public Sub CloseTable(hTable As Integer)
    On Error Resume Next
    If mOutputObject Is Nothing Then Exit Sub
    
    ' Set info for error logging.
    SetLoggingInfo "CloseTable", hTable
    
    mOutputObject.CloseTable hTable
End Sub

Public Function AddNewRecord(hTable As Integer) As Integer
    On Error Resume Next
    If mOutputObject Is Nothing Then Exit Function
    
    ' Set info for error logging.
    SetLoggingInfo "AddNewRecord", hTable
    
    AddNewRecord = mOutputObject.AddNewRecord(hTable)
End Function

Public Function EditRecord(hTable As Integer) As Integer
    On Error Resume Next
    If mOutputObject Is Nothing Then Exit Function
    EditRecord = mOutputObject.EditRecord(hTable)
End Function

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

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

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

Public Property Get fileName() As String
    fileName = mFileName
End Property

Public Function IsEOF() As Boolean
    If mOutputObject Is Nothing Then Exit Function
    IsEOF = mOutputObject.IsEOF
End Function

Private Sub Class_Initialize()
    OutputType = otOutputSourceType.otNONE
    Set mOutputObject = Nothing
End Sub

Public Function OpenOutput() As Integer
    
    OpenOutput = 0
    If Not mOutputObject Is Nothing Then Exit Function

    ' Delete the current output object.
    Set mOutputObject = Nothing

    ' Create the new output object.
    Select Case mType
        Case otOutputSourceType.otNONE
            Set mOutputObject = New COutputDump
        Case otOutputSourceType.otASCII
            Set mOutputObject = New COutputAscii
        Case otOutputSourceType.otDB
            Set mOutputObject = New COutputDB
        Case otOutputSourceType.otXML
            Set mOutputObject = New COutputObjImplXML
        Case Else
            MsgBox "Error loading output object. Invalid output type.", vbCritical Or vbOKOnly
            OpenOutput = 1
            Exit Function
    End Select

    mOutputObject.fileName = mFileName
    
    ' Set info for error logging.
    SetLoggingInfo "OpenOutput", -1
    OpenOutput = mOutputObject.OpenOutput()
    
    If mOutputObject.fileName <> mFileName Then
        mFileName = mOutputObject.fileName
    End If
End Function

Public Sub CloseOutput()
    If mOutputObject Is Nothing Then Exit Sub
    
    ' Set info for error logging.
    SetLoggingInfo "CloseOutput", -1

    mOutputObject.CloseOutput
    Set mOutputObject = Nothing
End Sub