frmimportvolume.frm

一个交通专用的gis-T系统

Private Sub chkFirstRow_Click()
    optDelimiter_Click (intIndex)
End Sub

Private Sub cmbfield_Click()

    If cmbfield.Text <> "自定义..." Then
        If flxPreview.Col = -1 Then Exit Sub
        aryNameAndType(flxPreview.Col + 1, 1) = cmbfield.Text
        flxPreview.Row = 0
        flxPreview.Text = cmbfield.Text
        flxPreview.RowSel = flxPreview.Rows - 1
        TxtField.Visible = False
    Else
        TxtField.Visible = True
        TxtField.SetFocus
        TxtField.SelStart = 0
        TxtField.SelLength = Len(TxtField)
    End If
        
    If cmbfield.Text = "LinkID" Then
        cboType.Text = "NUMBER"
    ElseIf cmbfield.Text = "NodeI" Then
        cboType.Text = "NUMBER"
    ElseIf cmbfield.Text = "NodeJ" Then
        cboType.Text = "NUMBER"
    ElseIf cmbfield.Text = "Volume" Then
        cboType.Text = "NUMBER"
    End If
        
        
End Sub



Private Sub Cmdcancel_Click()
    Unload Me
End Sub

Private Sub cmdFinish_Click()
    Dim intLoop As Integer
    Dim strTrashCan As String
    Dim strTrash As String
    'check for junk and duplicate names
    AccessTableName = txtname
    Randomize
    cmdFinish.Enabled = False
    cmdPrevious.Enabled = False
    For intLoop = 1 To UBound(aryNameAndType, 1)
        If InStr(strTrashCan, aryNameAndType(intLoop, 1)) <> 0 Then
            If chkFix.Value = 1 Then
                aryNameAndType(intLoop, 1) = aryNameAndType(intLoop, 1) & Rnd * 100
            Else
                MsgBox "字段名称重复 '" & aryNameAndType(intLoop, 1) & "'", vbInformation, "数据导入向导"
                picWizard(intStep).Visible = False
                picWizard(2).Visible = True
                intStep = 2
                cmdnext.Enabled = True
                cmdFinish.Enabled = True
                Exit Sub
            End If
        Else
            strTrashCan = strTrashCan & "|" & aryNameAndType(intLoop, 1)
            strTrash = RemoveJunk(CStr(aryNameAndType(intLoop, 1)))
            If Len(strTrash) <> Len(aryNameAndType(intLoop, 1)) Or Len(strTrash) = 0 Then
                If chkFix.Value = 1 Then
                    aryNameAndType(intLoop, 1) = RemoveJunk(CStr(aryNameAndType(intLoop, 1)))
                    If Len(aryNameAndType(intLoop, 1)) = 0 Then aryNameAndType(intLoop, 1) = "Field" & intLoop
                Else
                    MsgBox "无效字段名称 '" & aryNameAndType(intLoop, 1) & "'", vbInformation, "数据导入向导"
                    picWizard(intStep).Visible = False
                    picWizard(2).Visible = True
                    intStep = 2
                    cmdnext.Enabled = True
                    cmdFinish.Enabled = True
                    Exit Sub
                End If
            End If
        End If
    Next intLoop
    strTrash = txtname
    If Len(RemoveJunk(txtname)) <> Len(strTrash) Or Len(strTrash) = 0 Then
        If chkFix.Value = 1 Then
            txtname = RemoveJunk(CStr(txtname))
            If Len(txtname) = 0 Then txtname = "Table1"
        Else
            MsgBox "无效的数据表名 '" & txtname & "'", vbInformation, "数据导入向导"
            picWizard(intStep).Visible = False
            picWizard(3).Visible = True
            intStep = 3
            cmdnext.Enabled = True
            cmdFinish.Enabled = True
            Exit Sub
        End If
    End If
    ImportASCII
    
    MsgBox "流量数据读入完毕，以下将对数据格式编排进行调整，视数据库大小需要一定时间，点击确定继续！"
    On Error Resume Next
    
    Dim Linktable As TableDef
    Dim LinkFd As Field
    Set Linktable = mDbBiblio.TableDefs("Links")

    Dim TestField As String
    Dim ExistsTableQuery As Boolean

    '如果没有volume字段则创建
    TestField = Linktable("Volume").Name
    If Err = NameNotInCollection Then
        ExistsTableQuery = True
        Set Fd = Linktable.CreateField("Volume", dbDouble)
        Linktable.Fields.Append Fd
        Err = 0
    End If
    mDbBiblio.TableDefs.Append Linktable

    
    Dim RsTable As Recordset
    Dim Rslink As Recordset
    Set RsTable = mDbBiblio.OpenRecordset("Volume")

    Load FrmProgress
    FrmProgress.Show
    Dim stval
    step = 0
    If RsTable.RecordCount <> 0 Then
        stval = 100 / RsTable.RecordCount
    End If
        
    
    
    TestField = RsTable("LinkId").Name
    If Err = NameNotInCollection Then
        ExistsTableQuery = True
        RsTable.MoveFirst

        Do Until RsTable.EOF
            
            Set Rslink = mDbBiblio.OpenRecordset("select * from Links where NodeI=" & RsTable!NodeI & " and " & " NodeJ=" & RsTable!NodeJ)
            Rslink.Edit
            Rslink!Volume = RsTable!Volume
            Rslink.Update
            RsTable.MoveNext
            Err = 0
            step = step + stval
            Progress step, "格式化流量数据"
        
        Loop
    Else
        RsTable.MoveFirst
        Do Until RsTable.EOF
            Set Rslink = mDbBiblio.OpenRecordset("select * from Links where LinkId=" & RsTable!LinkId)
            Rslink.Edit
            Rslink!Volume = RsTable!Volume
            Rslink.Update
            RsTable.MoveNext
            Err = 0
            step = step + stval
            Progress step, "格式化流量数据"
        
        Loop
        
    End If
    Unload FrmProgress
    Unload Me
    
End Sub

Private Sub cmdFrom_Click()
    Dim intFound As Integer
    CD1.DialogTitle = "All Files"
    CD1.Filter = "All Files|*.*"
    CD1.ShowOpen
    ASCIIFileName = CD1.FileName
    If Len(CD1.FileName) > 25 Then
        intFound = InStr(20, CD1.FileName, "\")
        If intFound <> 0 Then
            CD1.FileName = Mid(ASCIIFileName, 1, intFound) & "...\" & CD1.FileTitle
        End If
    End If
    txtFrom = CD1.FileName
    CD1.FileName = ""
End Sub

Private Sub cmdNext_Click()
    If intStep = 0 Then cmdnext.Enabled = False: CheckFileNames
    cmdPrevious.Enabled = True
    picWizard(intStep).Visible = False
    intStep = intStep + 1
    If intStep + 1 = picWizard.Count Then cmdnext.Enabled = False
    If intStep = picWizard.Count Then intStep = intStep - 1
    picWizard(intStep).Visible = True
    picHeader.Visible = True
    DisplayCaption
    If intStep = 3 Then cmdFinish.Enabled = True
End Sub

Private Sub cmdPrevious_Click()
    picWizard(intStep).Visible = False
    cmdnext.Enabled = True
    cmdFinish.Enabled = False
    If intStep <= 1 Then picHeader.Visible = False: cmdPrevious.Enabled = False
    If intStep = 0 Then intStep = intStep + 1
    intStep = intStep - 1
    picWizard(intStep).Visible = True
    DisplayCaption
End Sub

Private Sub DisplayCaption()
    Select Case intStep
        Case 1
            lblHeader = "请选择源数据文件："
            lblStep = "请选择有效的路段流量数据文件，支持格式为ASCII编码文本文件"
            txtFrom.SetFocus
        Case 2
            lblHeader = "定义字段信息："
            lblStep = "请根据下述预览窗口选择字段之间有效分隔符号"
            'Since this is the screen where the preview is displayed, we need to refresh the preview grid
            If Not Edited Then Call optDelimiter_Click(intIndex)
            flxPreview.SetFocus
        Case 3
            lblHeader = "导入数据至MICROSOFT ACCESS数据库"
            lblStep = "文件所导入的MICROSOFT ACCESS数据库表名"
            txtname.SetFocus
            txtname.SelStart = 0
            txtname.SelLength = Len(txtname)
    End Select
End Sub

Private Sub flxPreview_Click()
    
    If flxPreview.Rows = 0 Then Exit Sub
    flxPreview.Row = 0
    flxPreview.RowSel = flxPreview.Rows - 1
    If flxPreview.Col = -1 Then Exit Sub
    TxtField = aryNameAndType(flxPreview.Col + 1, 1)
    cboType.Text = aryNameAndType(flxPreview.Col + 1, 2)
 
    
End Sub

Private Sub Form_Load()
    
    flxPreview.Cols = 0
    cboQualifier.AddItem Chr$(34)
    cboQualifier.AddItem "'"
    cboQualifier.AddItem "{none}"
    cboQualifier.Text = "{none}"
    cboType.AddItem "DOUBLE"
    cboType.AddItem "NUMBER"
    cboType.AddItem "TEXT"
    cboType.AddItem "MEMO"
    cboType.AddItem "DATE/TIME"
    cboType.AddItem "CURRENCY"
    cboType.AddItem "AUTONUMBER"
    cboType.AddItem "YES/NO"
    
    cmbfield.AddItem "LinkId"
    cmbfield.AddItem "NodeI"
    cmbfield.AddItem "NodeJ"
    cmbfield.AddItem "Volume"
    cmbfield.AddItem "自定义..."
    cmbfield.Text = "选择字段名称..."

    txtTo.Text = MDBPath
    AccessFileName = MDBPath
    intStep = 0
    
End Sub

Private Sub optDelimiter_Click(Index As Integer)
    intIndex = Index
    Select Case Index
        Case 0
            PreviewASCII vbTab
        Case 1
            PreviewASCII ";"
        Case 2
            PreviewASCII ","
        Case 3
            PreviewASCII " "
        Case 4
            txtOther.SetFocus
    End Select
End Sub

Private Sub tmrUnload_Timer()
    Complete = True
    Unload Me
End Sub

Private Sub txtField_Change()
    If flxPreview.Col = -1 Then Exit Sub
    aryNameAndType(flxPreview.Col + 1, 1) = TxtField
    flxPreview.Row = 0
    flxPreview.Text = TxtField
    flxPreview.RowSel = flxPreview.Rows - 1
End Sub

Private Sub txtField_LostFocus()
    Edited = True
End Sub


Private Sub txtTo_Change()
'    CheckFileNames
End Sub

Private Sub txtFrom_Change()
    CheckFileNames
End Sub

Private Sub txtTo_LostFocus()
    If InStr(txtTo, "...") = 0 Then ASCIIFileName = txtTo
End Sub

Private Sub txtFrom_LostFocus()
    If InStr(txtFrom, "...") = 0 Then ASCIIFileName = txtFrom
End Sub

Private Sub txtOther_Change()
    PreviewASCII txtOther
End Sub

Private Sub CheckFileNames()
    If InStr(ASCIIFileName, "...") <> 0 Then txtFrom = "": ASCIIFileName = ""
    If InStr(AccessFileName, "...") <> 0 Then txtTo = "": AccessFileName = ""
    If Dir(ASCIIFileName) <> "" And txtFrom <> "" And Dir(AccessFileName) <> "" And txtTo <> "" Then
        cmdnext.Enabled = True
    Else
        cmdnext.Enabled = False
        cmdFinish.Enabled = False
    End If
End Sub

Private Function RemoveJunk(strData As String)
    Dim lngLoop As Long
    Dim strTmp As String
    Dim strChar As String
    For lngLoop = 1 To Len(strData)
        strChar = Mid(strData, lngLoop, 1)
        If strChar Like "[A-Z]" Or strChar Like "[a-z]" Or strChar Like "[0-9]" Then
            strTmp = strTmp & Mid(strData, lngLoop, 1)
        End If
        DoEvents
    Next lngLoop
    If Mid(strTmp, 1, 1) Like "#" Then strTmp = ""
    RemoveJunk = strTmp
End Function