frmwiz1.frm

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

         _ExtentY        =   847
         _Version        =   393216
         DialogTitle     =   "Select Output Source"
         Filter          =   "Schema Files (*.sch)|*.sch|All Files (*.*)|*.*"
      End
      Begin VB.Label Label3 
         Caption         =   "Selected Output Schemas"
         Height          =   255
         Left            =   2400
         TabIndex        =   90
         Top             =   2280
         Width           =   2055
      End
      Begin VB.Image imgImage 
         Appearance      =   0  'Flat
         BorderStyle     =   1  'Fixed Single
         Height          =   2010
         Index           =   7
         Left            =   60
         Picture         =   "frmWiz1.frx":1D24C
         Stretch         =   -1  'True
         Top             =   60
         Width           =   2010
      End
      Begin VB.Label Label18 
         Caption         =   "Available Output Schemas"
         Height          =   255
         Left            =   2400
         TabIndex        =   79
         Top             =   120
         Width           =   2475
      End
      Begin VB.Label lblHelp 
         Caption         =   "Select the output schemas you wish to import data to."
         Height          =   1755
         Index           =   7
         Left            =   60
         TabIndex        =   50
         Top             =   2220
         Width           =   1995
      End
   End
   Begin VB.Frame fraStep 
      Caption         =   "Finish"
      Height          =   3975
      Index           =   10
      Left            =   4320
      TabIndex        =   80
      Top             =   2940
      Width           =   7335
      Begin VB.Image imgImage 
         Appearance      =   0  'Flat
         BorderStyle     =   1  'Fixed Single
         Height          =   2010
         Index           =   10
         Left            =   60
         Picture         =   "frmWiz1.frx":1E806
         Stretch         =   -1  'True
         Top             =   60
         Width           =   2010
      End
      Begin VB.Label Label20 
         Caption         =   $"frmWiz1.frx":1E908
         Height          =   1695
         Left            =   2400
         TabIndex        =   82
         Top             =   300
         Width           =   4575
      End
      Begin VB.Label lblHelp 
         Caption         =   "Finished"
         Height          =   1755
         Index           =   10
         Left            =   60
         TabIndex        =   81
         Top             =   2220
         Width           =   1995
      End
   End
End
Attribute VB_Name = "frmWiz1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' 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 mCurFrame As Integer
Private mNewImport As CImport
Private mTemplate As CWizardTemplate
Private mInitializing As Boolean

Dim mCurLine As CInputRecord
Dim mCurSchema As COutputSchema

Const SQL_SUCCESS As Long = 0
Const SQL_FETCH_NEXT As Long = 1
Private mNumOutputSources As Integer
Dim mOutputSources(1 To 2, 1 To 100) As String

Private Sub btnAddField_Click()
    
    Dim di As CInputField
    Dim numFields As Long
    
    ' Add new data item with default name.
    Set di = mCurLine.AddDataPoint(True)
    
    ' Get new name.
    di.name = InputBox("Enter a name for the new Data Item", "New Data Item", di.name)

    ' Add a "Get Data" action.
    Dim act As CCmdGetValue
    Set act = New CCmdGetValue

    ' Subtract the field we just added, we want to know how many
    ' fields there were before this one.
    numFields = mCurLine.GetDataPoints.Count - 1
    
    ' Try to guess where this field is going to lie.
    If mNewImport.Delimited Then
        ' Set the default position to be the number of items in the list.
        act.Position = numFields + 1
    ElseIf numFields > 0 Then
        ' Set the default starting column as where the last field left off.
        Dim prevAct As CCmdGetValue
        Set prevAct = mCurLine.GetDataPoint(numFields).GetAction(0)
        act.Position = prevAct.Position + prevAct.Length
        Set prevAct = Nothing
    End If

    ' For some formats, assume the first item on each line is a record name.
    If mNewImport.InputSourceType = DB Or mNewImport.InputSourceType = OTHER Then
        act.Position = act.Position + 1
    End If
    
    ' Get the pertinent values for the action.
    If act.EditProperties(di.name, mNewImport) = vbOK Then
        di.AddAction act
    End If
    
    ' Add an entry to our listbox.
    lstFields.ListItems.Add , di.GetID, di.name
    
    Set act = Nothing
    Set di = Nothing
    
    ' Since we have at least one item, we can enable the delete button.
    Me.btnDeleteField.Enabled = True
    
End Sub

Private Sub btnAddLine_Click()

    ' Ask for new line name.
    Set mCurLine = Nothing
    mCurFrame = GetFrameNumFromName("LineName")
    ShowFrame mCurFrame

End Sub

Private Function GetFrameNumFromName(FrameCaption As String) As Integer
    Dim i As Integer
    
    For i = 0 To fraStep.Count - 1
        If fraStep(i).Caption = FrameCaption Then
            GetFrameNumFromName = i
            Exit Function
        End If
    Next i
    
    
    GetFrameNumFromName = 0
End Function

Private Sub btnAddLineCommand_Click()

    ' Add a new action to the checkpoint.
    lfcAddCheckpointAction mCurLine, lstLineActions, mNewImport
    SetLineActionButtons
End Sub

Private Sub SetLineActionButtons()
    If lstLineActions.ListItems.Count > 0 Then
        Me.btnEditLineCommand.Enabled = True
        Me.btnDeleteLineCommand.Enabled = True
    Else
        Me.btnEditLineCommand.Enabled = False
        Me.btnDeleteLineCommand.Enabled = False
    End If
End Sub

Private Sub SetLineButtons()
    If lstLines.ListItems.Count > 0 Then
        Me.btnEditLine.Enabled = True
        Me.btnDeleteLine.Enabled = True
    Else
        Me.btnEditLine.Enabled = False
        Me.btnDeleteLine.Enabled = False
    End If
End Sub

Private Sub btnAddSchema_Click()
        
    SelectSchema lstOutputSources.ListIndex

End Sub

Private Sub SelectSchema(ItemIndex As Integer)
    
    With lstOutputSources
    If .ListCount < 1 Or .ListCount < ItemIndex Then Exit Sub

    ' Add the schema to the "Selected" list.
    lstSelectedSchemas.AddItem .List(ItemIndex)
    lstSelectedSchemas.ItemData(lstSelectedSchemas.NewIndex) = .ItemData(ItemIndex)
    lstSelectedSchemas.ListIndex = lstSelectedSchemas.NewIndex

    ' Remove the selected item from the "Available" list.
    .RemoveItem ItemIndex
    
    If .ListCount > 0 Then
        ' Select the first item in the list.
        .ListIndex = 0
    Else
        ' Disable the add button, since all the schemas are added.
        btnAddSchema.Enabled = False
    End If
    End With
    
    ' We know there is at least one schema to remove now.
    btnRemoveSchema.Enabled = True

End Sub

Private Sub btnBrowseForSchemas_Click()
    On Error GoTo eHandler
    
    Dim name As String
    Dim i As Integer
    
    ' Get the filename.
    dlgCommon.ShowOpen
    If dlgCommon.fileName = "" Then Exit Sub
    
    ' Get the name of the new item.
    If GetNameFromFile(dlgCommon.fileName, name) Then
    
        Dim AlreadyInList As Integer, Count As Integer
        Dim newName As String
        newName = name

        ' Make sure this item isn't already in our list.
        Do
            ' Assume our schema name is unique.
            AlreadyInList = False

            For i = 0 To lstOutputSources.ListCount - 1
            
                ' If schema name is not unique, change it.
                If lstOutputSources.List(i) = newName Then
                    Count = Count + 1
                    newName = name & str(Count)
                    AlreadyInList = True
                    Exit For
                End If
            Next i
        Loop While AlreadyInList = True
        
        ' If we had to change the name to be unique, tell the user.
        If newName <> name Then
            MsgBox "A schema with the name '" & name & _
                "' already exists. The name of this schema has been temporarily changed to '" _
                & newName & "' to distinguish it.", _
                vbInformation Or vbOKOnly
            name = newName
        End If
        
        ' Store the new filename and schema name in our list.
        mNumOutputSources = mNumOutputSources + 1
        mOutputSources(1, mNumOutputSources) = dlgCommon.fileName
        mOutputSources(2, mNumOutputSources) = name
        
        ' Add the schema to the 'Selected' listbox.
        lstSelectedSchemas.AddItem name
        lstSelectedSchemas.Selected(lstSelectedSchemas.NewIndex) = True
        lstSelectedSchemas.ListIndex = lstSelectedSchemas.NewIndex
        lstSelectedSchemas.ItemData(lstSelectedSchemas.NewIndex) = mNumOutputSources
    End If

eHandler:

End Sub

Private Sub btnCancel_Click()
    
    GFormReturnValue = vbCancel
    Set mNewImport = Nothing
    Unload Me

End Sub

Private Sub btnDeleteField_Click()
    Dim cp As CInputRecord
    
    lfcDeleteField mCurLine, lstFields
    
    ' Update the status of the various buttons.
    SetFieldScreenButtonStatus
End Sub

Private Sub btnDeleteLine_Click()
    
    ' Add a new item with a default name.
    lfcDeleteCheckpoint mNewImport, lstLines

    ' Update the status of the various buttons.
    SetLineButtons

End Sub

Private Sub btnDeleteLineCommand_Click()
    
    ' Remove the action from the Checkpoint.
    mCurLine.GetActions.Remove lstLineActions.SelectedItem.key
    mCurLine.GetActions.Reorder
    lfcLoadActionList mCurLine.GetActions(), lstLineActions

    ' Update the status of the various buttons.
    SetLineActionButtons
End Sub

Private Sub btnEditLine_Click()
    ' Ask for new line name.
    Set mCurLine = mNewImport.GetCheckPoint(lstLines.SelectedItem.key)
    mCurFrame = GetFrameNumFromName("LineName")
    ShowFrame mCurFrame
End Sub

Private Sub btnEditLineCommand_Click()
    Dim act As Object
    
    ' Get the action being edited.
    Set act = mCurLine.GetAction(lstLineActions.SelectedItem.key)
    
    ' Edit the action.
    act.EditProperties mCurLine.name, mNewImport

    ' Reset the text for this command in case something changed.
    lstLineActions.SelectedItem.Text = act.GetSpecificDescription
End Sub

Private Sub btnEnterSchema_Click()
    
    Dim sch As New COutputSchema
    Dim ol As COutputLinks
    Dim fileName As String