outputsourcecode.bas

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

Attribute VB_Name = "OutputSourceCode"
' 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 Const TABLETAG = 1
Private Const FIELDTAG = 2
Private mSchema As COutputSchema
Private mTree As TreeView


' This function returns an array containing the names
' of all the output sources in the "output sources" subdirectory
' arr is a 2 dimensional array of strings (1..2, 1..?)
' The first element denotes:
'   1: Name of the output source file
'   2: Name out the output source
' The second element is a simple index, 1..NumOutputSources
Function osGetOutputSourceNames(arr() As String) As Integer
    Dim Path As String
    Dim fileName As String
    Dim SourceName As String
    Dim i As Integer
    
    i = 0
    
    fileName = Dir(GOutputSourceDirectory + "\*.sch", vbNormal)
    Do While fileName <> ""
        fileName = GOutputSourceDirectory + "\" + fileName
        i = i + 1
        
        If i > UBound(arr, 2) Then
            ReDim Preserve arr(2, i + 10)
        End If
        
        ' Get the official source name.
        If (GetNameFromFile(fileName, SourceName)) Then
            arr(1, i) = fileName
            arr(2, i) = SourceName
        End If

        fileName = Dir
    Loop
    osGetOutputSourceNames = i
    Exit Function

eHandler:
    LogError "frmSelectOutputSource", "osGetOutputSourceNames", Error(Err), False
    
End Function

Public Function osLoadTreeBranch(targ As COutputTargetTable)
    Dim of As COutputTargetField
    ' Add each target to the tree.
    For Each of In targ.GetFields
        osAddTreeItem targ.GetID, of.GetID, of.name, etiType.tidataitem, "DataItem"
    Next of
End Function

Public Function osFillDataTree(schema As COutputSchema)
    On Error GoTo eHandler
    
    Dim newItem As node
    Dim ot As COutputTargetTable
    
    ' Delete any existing items from the tree.
    mTree.Nodes.Clear

    ' Add the root object to the tree.
    osAddTreeItem "", schema.GetID, schema.name, etiType.tiimport, "Output"

    ' Add each target to the tree.
    For Each ot In schema.GetOutputTables
        osAddTreeItem schema.GetID, ot.GetID, ot.name, etiType.ticheckpoint, "CheckPoint"

        ' Add all the field items for this table.
        osLoadTreeBranch ot
    Next ot
    
    Exit Function
    
eHandler:
    LogError "OutputSourceCode", "osFillDataTree", Error(Err), False
    
End Function

Sub osSetTreeReference(ByRef tr As TreeView)
    Set mTree = tr
End Sub

Public Sub osAddTreeItem(ParentKey As String, key As Variant, _
                        DisplayText As String, _
                        tag As Variant, ImageTag As String)
    On Error GoTo eHandler
    Dim newItem As ComctlLib.node
    
    If ParentKey = "" Then
        ' Add a root item.
        Set newItem = mTree.Nodes.Add(, , key, DisplayText)
    Else
        ' Add a sub item.
        Set newItem = mTree.Nodes.Add(ParentKey, _
            tvwChild, key, DisplayText)
    End If
    
    newItem.Image = ImageTag
    newItem.tag = tag
        
    Set newItem = Nothing
    Exit Sub
eHandler:
    LogError "OutputSourceCode", "osAddTreeItem", Error(Err), False
    
End Sub

Public Sub osLoadDataTypesIntoCombo(ByRef cboDT As ComboBox)
    On Error GoTo eHandler
    
    Dim i As Integer
    
    ' Clear any pre-existing items from the comboboxes.
    cboDT.Clear
    
    ' Add all our defined data types to the box, along with
    ' the index used to access their various properties.
    For i = 1 To GOutputID.GetNumDBTypes
        ' Add the name and index number.
        cboDT.AddItem GOutputID.GetDBTypeName(i, True)
        cboDT.ItemData(i - 1) = GOutputID.GetDBTypeID(i, True)
    Next i
    
    Exit Sub

eHandler:
    LogError "OutputSourceCode", "osLoadDataTypesIntoCombo", Error(Err), False
    
End Sub

Sub osInitialize(obj As COutputSchema)
    On Error GoTo eHandler
    
    With frmEditOutputSchema
    ' Store a reference to the schema object we are editing.
    Set mSchema = obj
    
    ' Tell the tree functions what tree to deal with
    Set mTree = .treeOutputSchema
    osLoadDataTypesIntoCombo .cboDataType

    ' Fill the data tree.
    osFillDataTree mSchema

    ' Select the first item in the tree.
    If .treeOutputSchema.Nodes.Count > 0 Then
        Set .treeOutputSchema.SelectedItem = .treeOutputSchema.Nodes(1)
        osDisplayProperties
    End If

    ' Display schema options.
    .rbIgnore.value = mSchema.IgnoreUniqueIndexDuplicates
    .rbReplace.value = Not mSchema.IgnoreUniqueIndexDuplicates
    End With
    Exit Sub

eHandler:
    LogError "OutputSourceCode", "osInitialize", Error(Err), False
    
End Sub

Sub osDisplayProperties()
    
    Dim ot As Object
    With frmEditOutputSchema
    
    If .treeOutputSchema.SelectedItem.tag <> etiType.tidataitem Then
        .fraProperties.Visible = False
        Exit Sub
    End If
    
    .fraProperties.Visible = True
    
    ' Get a reference to the newly selected item.
    Set ot = osGetReferenceToTreeItem()
    
    If .treeOutputSchema.SelectedItem.tag = etiType.tidataitem Then
        ' Display the new items properties.
        .lblTypeDescription = ot.GetDBTypeDescription
        .cboDataType = ot.GetDBTypeName
        .chkUniqueIndex.value = IIf(ot.UniqueIndexed, vbChecked, vbUnchecked)
    End If
    Set ot = Nothing
    End With
    
End Sub

Sub osUpdateSchemaProperties()
    With frmEditOutputSchema

    ' Update the general schema properties.
    mSchema.IgnoreUniqueIndexDuplicates = _
        IIf(.rbIgnore.value, True, False)
    
    End With
End Sub

Function osUpdateItems(Optional node As ComctlLib.node = Nothing) As Boolean
    With frmEditOutputSchema
    osUpdateItems = False
    
    Dim ot As Object
    Dim ImageTag As String
    
    If node Is Nothing Then Set node = .treeOutputSchema.SelectedItem
    
    Set ot = osGetReferenceToTreeItem(node)
    If ot Is Nothing Then
        Exit Function
    Else
        
        If node.tag = etiType.tidataitem Then
            ot.UniqueIndexed = IIf(.chkUniqueIndex.value = vbChecked, True, False)
            ot.dbType = .cboDataType.ItemData(.cboDataType.ListIndex)
            ImageTag = "DataItem"
        Else
            ImageTag = "CheckPoint"
        End If

        ' Make sure the items tree image is correct.
        ' If no particular treenode has been specified,
        ' use the current selection.
        If node Is Nothing Then
            .treeOutputSchema.SelectedItem.Image = ImageTag
        Else
            node.Image = ImageTag
        End If
        Set ot = Nothing
    End If
    
    osUpdateItems = True
    End With
    Exit Function
    
eHandler:
    LogError "OutputSourceCode", "osUpdateItems", Error(Err), False
End Function


Function osGetReferenceToTreeItem(Optional node As ComctlLib.node = Nothing) As Object

    On Error GoTo eHandler
    Set osGetReferenceToTreeItem = Nothing
    With frmEditOutputSchema
    
    Dim parent As String
    Dim ot As Object
    Dim col As New Collection
    Dim item As ComctlLib.node
    Dim Count As Integer
    
    Count = 1
    If node Is Nothing Then
        Set item = .treeOutputSchema.SelectedItem
    Else
        Set item = node
    End If

    If item Is Nothing Or item.key = mSchema.GetID Then
        Set osGetReferenceToTreeItem = Nothing
    Else
    
    ' THIS CODE IS UNCHANGED SINCE THERE WHERE MULTIPLE
    ' LEVELS POSSIBLE, NOT THAT ONLY TABLES AND FIELDS
    ' ARE POSSIBLE, THIS SHOULD BE SIMPLIFIED.
    
        ' Trace the path back up through the tree to the root item.
        Do
            If item.key = mSchema.GetID Then Exit Do
            col.Add item.key
            Count = Count + 1
            Set item = item.parent
        Loop While Not item Is Nothing
    
        ' Find the node we are going to add a child to.
        Set ot = mSchema.GetOutputTables.item(col(col.Count))
        For Count = col.Count - 1 To 1 Step -1
            Set ot = ot.GetFields.item(col(Count))
        Next Count
        
        Set osGetReferenceToTreeItem = ot
        Set ot = Nothing
    End If
    End With

    Exit Function
    
eHandler:
    LogError "OutputSourceCode", "osGetReferenceToSelectedItem", Error(Err), False
    '
End Function

Public Sub osAddItem()
    On Error GoTo eHandler
    With frmEditOutputSchema
    
    Dim ot As COutputTargetTable

    If .treeOutputSchema.SelectedItem.tag = etiType.tiimport Then
        
        '*****************
        ' Add a new table.
        '*****************

        Set ot = mSchema.GetOutputTables.Add(True)
        
        ' Add the new item to the tree.
        osAddTreeItem mSchema.GetID, ot.GetID, ot.name, etiType.ticheckpoint, "CheckPoint"
            
    ElseIf .treeOutputSchema.SelectedItem.tag = etiType.ticheckpoint Then

        '****************************
        ' Add a new field to a table.
        '****************************

        Dim of As COutputTargetField
        
        ' Get the schema object being referred to by the tree selection.
        Set ot = osGetReferenceToTreeItem()
        
        ' Add the new sub item.
        Set of = ot.GetFields.Add(True)
        
        ' Set the properties for the new item.
        Set of.parent = ot

        ' Add the new item to the tree.
        osAddTreeItem ot.GetID, of.GetID, of.name, etiType.tidataitem, "DataItem"
    
        Set of = Nothing
    End If
    
    Set ot = Nothing
    End With
    
    Exit Sub
    
eHandler:
    LogError "OutputSourceCode", "osAddItem", Error(Err), False
    
End Sub

Public Sub osAfterLabelEdit(NewString As String)
    
    ' An items name was edited, so update the name.
    
    Dim ot As Object
    
    Set ot = osGetReferenceToTreeItem()
    If ot Is Nothing Then
        mSchema.name = NewString
    Else
        ot.name = NewString
        Set ot = Nothing
    End If
End Sub

Public Sub osDeleteItem()
    On Error GoTo eHandler
    
    With frmEditOutputSchema
    With .treeOutputSchema
        If .SelectedItem.key = mSchema.GetID Then
            MsgBox "Cannot remove the root item", vbCritical Or vbOKOnly, "Error"
            Exit Sub
        End If
        
        ' Remove a table object.
        If .SelectedItem.parent.key = mSchema.GetID Then
            mSchema.GetOutputTables.Remove .SelectedItem.key
            
        ' Remove a field object.
        Else
            Dim ot As COutputTargetTable
            Set ot = osGetReferenceToTreeItem(.SelectedItem.parent)
            ot.GetFields.Remove .SelectedItem.key
            Set ot = Nothing
        End If
        
        ' Remove the item from our tree.
        .Nodes.Remove .SelectedItem.index
        
    End With
    End With
    Exit Sub
eHandler:
    LogError "frmEditOutputSchema", "Delete", Error(Err), False
    

End Sub