importschemacode.bas

Data monkey是一个强大的是数据传输和转换应用程序。使用DataMonkey用户可以把复杂的文本文件格式

Attribute VB_Name = "ImportSchemaCode"
' 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

Function ImportSchema(ConnectString As String, schema As COutputSchema) As Boolean
    On Error GoTo eHandler
    ImportSchema = False
    
    Dim Connection As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim Tbl As COutputTargetTable
    Dim fld As COutputTargetField
    
    If schema Is Nothing Then
        Set schema = New COutputSchema
    End If
    
    schema.SchemaType = otDB
    
    Set Connection = New ADODB.Connection
    Connection.Open ConnectString
    
    '*******************
    ' Import the Tables.
    '*******************
    
    ' Open a recordset with all of the table information.
    Set rs = Connection.OpenSchema(adSchemaTables)
    
    Do Until rs.EOF
        If rs("TABLE_TYPE") = "TABLE" Then
            Set Tbl = schema.GetOutputTables.Add(False)
            Tbl.name = rs("TABLE_NAME")
        End If
        
        Set Tbl = Nothing
        rs.MoveNext
    Loop
    rs.Close
    Set rs = Nothing
    
    '**********************************
    ' Import the Fields for the tables.
    '**********************************
    
    ' Open a recordset with all the column (field) information.
    Set rs = Connection.OpenSchema(adSchemaColumns)
    Do Until rs.EOF
        
        ' Get a reference to the table object that will own this field.
        If Not Tbl Is Nothing Then
            If Not Tbl.name = rs("TABLE_NAME") Then
                Set Tbl = schema.GetOutputTables.ItemByName(rs("TABLE_NAME"))
            End If
        Else
            Set Tbl = schema.GetOutputTables.ItemByName(rs("TABLE_NAME"))
        End If

        ' If we found our table object, add a field to it.
        If Not Tbl Is Nothing Then
            ' Add the field object.
            Set fld = Tbl.GetFields.Add(False)
            
            ' Make sure the field was added.
            If fld Is Nothing Then GoTo done
            
            ' Setup the field properties.
            fld.name = rs("COLUMN_NAME")
            fld.dbType = rs("DATA_TYPE")
            
            Set fld = Nothing
        End If
        rs.MoveNext
    Loop
    
    rs.Close
    Set rs = Nothing
    
    '********************
    ' Import the indexes.
    '********************
    
    For Each Tbl In schema.GetOutputTables
    
        ' Open a recordset with all the index information.
        Set rs = Connection.OpenSchema(adSchemaIndexes, Array(Empty, Empty, Empty, Empty, Tbl.name))

        rs.MoveFirst
        While Not rs.EOF
            If Not IsNull(rs("UNIQUE")) Then
            
                ' We found a unique indexed field.
                If rs("UNIQUE") Then
                    ' Get the field.
                    Set fld = Tbl.GetFields.ItemByName(rs("COLUMN_NAME"))
                    If Not fld Is Nothing Then
                        ' Set the indexed property to true.
                        fld.UniqueIndexed = True
                    End If
                End If
            End If
            
            rs.MoveNext
        Wend
        
        rs.Close
        Set rs = Nothing
    Next Tbl
    
    ImportSchema = True
    
done:
    Connection.Close
    Set Connection = Nothing
    Exit Function

eHandler:
    LogError "ImportSchema", "Import Schema", Error(Err), False
End Function

Public Sub DoSchemaImport()
    Dim arc As New CArchive
    Dim Filter As String
    Dim ConnectString As String
    Dim NewSchema As COutputSchema
    
    ' Show the ODBC logon screen to choose the DB schema to import.
    frmODBCLogon.Show vbModal
    ConnectString = frmODBCLogon.GetConnectString
    Unload frmODBCLogon
    If Not GFormReturnValue = vbOK Then Exit Sub

    ' Import the schema file.
    If Not ImportSchema(ConnectString, NewSchema) Then Exit Sub
    
    ' Get a new name for the schema.
    Do
        NewSchema.name = InputBox("Enter a name for the new Schema", "New Schema Name", "New Schema")
        NewSchema.name = Trim(NewSchema.name)
        If NewSchema.name = "" Then
            Dim i As Integer
            i = MsgBox("Discard changes to new schema?", vbYesNo Or vbQuestion, "Cancel Import")
            If i = vbYes Then Exit Sub
        End If
    Loop While NewSchema.name = ""

    NewSchema.Edit
    If Not GFormReturnValue = vbOK Then Exit Sub
    
    ' Save the new file.
    Filter = "Schema Files(*.sch)|*.sch|All Files(*.*)|*.*"
    If arc.BrowseFileSave("Save Schema as...", , Filter) Then
        NewSchema.SchemaType = otDB
        NewSchema.Save arc
        arc.CloseFile
    End If
    
    Exit Sub

eHandler:
    ' Cancel was pressed on one of the open/save boxes.
    If Err = 32755 Then Exit Sub
    LogError "frmMain", "mnuEditOutputSource", Error(Err), False
End Sub

Function ImportInputSchema(ConnectString As String, Import As CImport) As Boolean
    On Error GoTo eHandler
    ImportInputSchema = False

    Dim Tbl As CInputRecord
    Dim fld As CInputField
    Dim ifAct As CCmdIf
    Dim getValAct As CCmdGetValue
    Dim cnt As Integer
    Dim schema() As String
    Dim i As Integer, numSchemaItems As Integer
    
    ' Make sure we have a valid input object that supports schema importing.
    If Import Is Nothing Then
        Exit Function
    End If
    If Import.GetInputObject.SupportsGetSchema <> True Then
        Exit Function
    End If

    ' Set the connection string.
    Import.GetInputObject.fileName = ConnectString
    
    ' Get the schema into a string array.
    schema = Import.GetInputObject.GetSchema()
    
    Set Tbl = Nothing
    
    '**********************************
    ' Import the Table and Field names.
    '**********************************
    
    numSchemaItems = UBound(schema, 2)
    
    For i = 1 To numSchemaItems
        
        ' Do we already have a table object?
        If Not Tbl Is Nothing Then
            ' Yes, is the current table object is the one we want?
            If Not Tbl.name = schema(1, i) Then
                ' No, see if the table object we want already exists.
                Set Tbl = Import.GetCheckPointByName(schema(1, i))
                cnt = 2
            End If
        End If

        ' If we couldn't find a pre-existing table object, create a new one.
        If Tbl Is Nothing Then
            Set Tbl = Import.AddCheckPoint(False)
            Tbl.name = schema(1, i)
            
            ' Add the if command to select the correct table.
            Set ifAct = Tbl.GetActions.AddNew(cmdif)
            If Not ifAct Is Nothing Then
                ifAct.LHSType = cvtLineOfInput
                ifAct.LHSDelimited = True
                ifAct.LHSDelimiter = ","
                ifAct.LHSInputLinePosition = 1
                ifAct.RHSType = cvtConstant
                ifAct.RHS = Tbl.name
                Set ifAct = Nothing
            End If

            ' Add a default execute command
            Tbl.GetActions.AddNew cmdExecute

        End If
        
        ' If we now have the table object, add a new field to it.
        If Not Tbl Is Nothing Then
            ' Add the field object.
            Set fld = Tbl.AddDataPoint(False)

            ' Make sure the field was added.
            If fld Is Nothing Then GoTo done
            
            ' Setup the field properties.
            fld.name = schema(2, i)
            
            ' Create a default action to get the value from this field.
            Set getValAct = fld.GetActions.AddNew(cmdGetValue)
            getValAct.Delimited = True
            getValAct.Delimiter = ","
            ' Get the n+1 item from the line of input.
            getValAct.Position = Tbl.GetDataPoints.Count + 1
            Set getValAct = Nothing
            Set fld = Nothing

        End If
    Next i
    
    ImportInputSchema = True
    
done:
    Exit Function

eHandler:
    LogError "ImportSchemaCode", "ImportInputSchema", Error(Err), False
End Function