coutputdump.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 = "COutputDump"
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 mFileNum As Integer
Private mLineNum As Integer
Private mEOF As Boolean
Private mCurLine As String
Private mTableNames As Collection
Private mPrevTable As Integer

Public Function GetType() As otOutputSourceType
    GetType = otOutputSourceType.otNONE
End Function

Public Function AddNewRecord(hTable As Integer) As Boolean
    AddNewRecord = True
    mTableNames(CStr(hTable)).AppendData vbCrLf & vbTab
    mLineNum = mLineNum + 1
End Function

Public Function openTable(TableName As String) As Integer
    Dim key As Integer
    Dim newObj As New COutputDumpTable
    
    key = mTableNames.Count + 1
    newObj.name = TableName
    
    mTableNames.Add item:=newObj, key:=CStr(key)
    openTable = key
End Function

Public Sub CloseTable(hTable As Integer)
    
    Dim dt As COutputDumpTable
    Set dt = mTableNames(CStr(hTable))
    
    With frmOutputDump.txtOutput
        
        ' Add two crlf's for every table, after the first.
        If Len(left$(.Text, 1)) <> 0 Then .Text = .Text & vbCrLf & vbCrLf
        .Text = .Text & dt.name
        .Text = .Text & dt.Data
    End With
    
    Set dt = Nothing

    mTableNames.Remove CStr(hTable)
End Sub

Public Function GetTableName(hTable As Integer) As String
    GetTableName = mTableNames(CStr(hTable)).name
End Function

' LocateFor
' If a field named FieldName is found in the table named TableName
' True is returned.
' Otherwise false is returned.
Public Function LocateFor(TableName, fieldName) As Boolean
    On Error Resume Next
    LocateFor = False
End Function

Public Function StoreValue(hTable As Integer, value As COutputFieldProxy) As Boolean
    On Error GoTo eHandler
    StoreValue = False
    
    Dim DataObj As COutputDumpTable
    Set DataObj = mTableNames(CStr(hTable))
    If DataObj Is Nothing Then Exit Function
    
    DataObj.AppendData value.name + ": " + CStr(value)
    StoreValue = True
    Exit Function
eHandler:
    LogError "COutputDump", "StoreValue", Error(Err)
'
End Function

Public Property Let fileName(ByVal vData As String)
End Property

Public Property Get fileName() As String
    fileName = "Screen"
End Property

Public Sub ResetOutput()

    '**************************************************
    ' Make sure the file is closed and all our internal
    ' variables are re-initialized.
    '**************************************************
    
    If mFileNum <> -1 Then
        Close mFileNum
        mFileNum = -1
    End If
    
    mEOF = False
    mLineNum = 0
    mFileNum = -1
    Set mTableNames = Nothing
    Set mTableNames = New Collection
End Sub
Private Sub Class_Initialize()
    ResetOutput
End Sub

Public Function OpenOutput() As Integer
    
    On Error GoTo eHandler
    OpenOutput = 0
    
    ResetOutput
    
    ' Clear and Show the default output window.
    frmOutputDump.Show
    frmOutputDump.txtOutput.Text = ""
    
    Exit Function

eHandler:
    LogError "COutputDump", "OpenOutput", Error(Err)
    OpenOutput = Err
End Function

Public Sub CloseOutput()
    Dim dt As COutputDumpTable
    With frmOutputDump.txtOutput
    For Each dt In mTableNames
        .Text = .Text + dt.Data
    Next dt
    End With
    
    Set mTableNames = Nothing
End Sub

Private Sub Class_Terminate()
    Set mTableNames = Nothing
End Sub