coutputascii.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 = "COutputAscii"
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 mvarFileName As String 'local copy
Private mFileNum As Integer
Private mLineNum As Integer
Private mEOF As Boolean
Private mCurLine As String
Private mTableNames As Collection

Public Function AddNewRecord(hTable As Integer) As Boolean
    Print #mFileNum, ""
    Print #mFileNum, mTableNames(CStr(hTable))
    AddNewRecord = True
End Function

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

Public Sub CloseTable(hTable As Integer)
    mTableNames.Remove CStr(hTable)
End Sub

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

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

Public Function StoreValue(hTable As Integer, ByRef value As COutputFieldProxy) As Boolean
    On Error GoTo eHandler
    StoreValue = False
    
    Print #mFileNum, "   " & value.name & ": " & value.value

    StoreValue = True
    Exit Function
eHandler:
    LogError "COutputASCII", "StoreValue", Error(Err)
End Function

Public Sub CloseOutput()
    ResetOutput
End Sub

' LocateFor
' If a field named FieldName is found in the table named TableName
' True is returned.
' Otherwise false is returned.
Public Function LocateFor(TableName, ForValue) As Boolean
    On Error Resume Next
    LocateFor = False
End Function
Public Property Let fileName(ByVal vData As String)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.FileName = 5
    mvarFileName = vData
End Property

Public Property Get fileName() As String
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.FileName
    fileName = mvarFileName
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
    End If
    
    Set mTableNames = Nothing
    
    mEOF = False
    mLineNum = 0
    mFileNum = -1
    mvarFileName = ""
    
End Sub
Private Sub Class_Initialize()
    ResetOutput
End Sub

Public Function OpenOutput() As Integer
    
    On Error GoTo eHandler
    OpenOutput = 0
    
    ' If not database has been yet specified, ask for one.
    If Len(mvarFileName) = 0 Then
        With fMainForm.dlgCommonDialog
        'set the flags and attributes of the
        'common dialog control
        .DialogTitle = "Select file to store data"
        .Filter = "Text files (*.txt)|*.txt|All Files (*.*)|*.*"
        .ShowSave
        If Len(.fileName) = 0 Then Exit Function
        mvarFileName = .fileName
        End With
    End If
    Dim sFile As String

    Set mTableNames = New Collection
    
    mFileNum = FreeFile
    Open mvarFileName For Output As #mFileNum
    
    Exit Function

eHandler:
    If Err <> 32755 Then    ' (dialog cancelled)
        LogError "COutputASCII", "OpenOutput", Error(Err)
    End If
    mFileNum = -1
    OpenOutput = Err
End Function

Private Sub Class_Terminate()
    Set mTableNames = Nothing
End Sub