cinputascii.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 = "CInputObjImplAscii"
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 Long
Private mEOF As Boolean
Private mCurLine As String

Public Function SupportsGetSchema() As Boolean
    SupportsGetSchema = False
End Function
Public Function GetSchema() As String()
End Function

Public Function GetLineNumber() As Long
    GetLineNumber = mLineNum
End Function

Public Function GotoLine(LineNumber As Long) As Long
    mLineNum = LineNumber
End Function

Public Function Properties()
End Function

Public Function GetNextLine() As String
    On Error GoTo eHandler
    
    GetNextLine = ""
    mCurLine = ""
   
    If mEOF Or mvarFileName = "" Then Exit Function
    
    '*****************************************
    ' Open the input file if not already open.
    '*****************************************
    
    If mFileNum = -1 Then
        If OpenInput <> 0 Then Exit Function
    End If

    If EOF(mFileNum) Then
        mEOF = True
    Else
    
        '**********************************
        ' Read the next line from our file.
        '**********************************
        
        Line Input #mFileNum, mCurLine
        
        GetNextLine = mCurLine
        
        mLineNum = mLineNum + 1
    End If
    
    Exit Function
    
eHandler:
    LogError "CInputObjImplAscii", "GetNextLine", Error(Err)
    
End Function

Public Function GetCurrentLine() As String
    GetCurrentLine = mCurLine
End Function

Public Function IsEOF() As Boolean
    IsEOF = mEOF
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 Function OpenInput() As Integer
    On Error GoTo eHandler
    Dim i As Integer
    
    OpenInput = 0
    ResetInput  ' Reset our internal variables.
    
    ' If no text file has been yet specified, ask for one.
    If Len(mvarFileName) = 0 Then
        With fMainForm.dlgTextDialog
        'set the flags and attributes of the
        'common dialog control
        .ShowOpen
        If Len(.fileName) = 0 Then Exit Function
        mvarFileName = .fileName
        End With
    End If
    
    i = FreeFile
    Open mvarFileName For Input As i
    mFileNum = i
    Exit Function
    
eHandler:
    OpenInput = Err
    mFileNum = -1
    If Err <> 32755 Then    ' (dialog cancelled)
        LogError "CInputObjImplAscii", "OpenInput", Error(Err)
    Else
        GCancelImport = True
    End If
End Function

Public Sub CloseInput()
    ' Close open files, etc...
    ResetInput
End Sub

Public Sub ResetInput()

    '**************************************************
    ' 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
    
End Sub
Private Sub Class_Initialize()
    mvarFileName = ""
    ResetInput
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 value As Variant, item As String, retVal As Integer
    
    Load = False
    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

    Loop While True
    Load = True
    
terminate:
    Exit Function
    
eHandler:
    LogError "CInputObjImplAscii", "Load", Error(Err)
End Function

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

    arc.SaveItem aiBEGINOBJECT
    arc.SaveItem aiENDITEM
    Save = True
    Exit Function

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