查询工具

Region "自定义工具"

    '得到所有的odbc名称
    Public Function GetODBCDns(ByVal Cmb As ComboBox) As Boolean
        Dim str As String
        Dim rootkey As Microsoft.Win32.RegistryKey, subkey As Microsoft.Win32.RegistryKey
        Dim dsnlist() As String
        'rootkey = Microsoft.Win32.Registry.CurrentUser
        rootkey = Microsoft.Win32.Registry.LocalMachine
        str = "SOFTWARE\\ODBC\\ODBC.INI\\" '\\ODBC Data Sources

        subkey = rootkey.OpenSubKey(str)

        'dsnlist = subkey.GetValueNames
        dsnlist = subkey.GetSubKeyNames
        subkey.Close()
        rootkey.Close()
        Cmb.Items.Clear()

        Dim i As Integer
        For i = 0 To dsnlist.Length - 1
            If (dsnlist(i).StartsWith("b") Or dsnlist(i).StartsWith("B") Or dsnlist(i).StartsWith("s") Or dsnlist(i).StartsWith("S")) Then
                Cmb.Items.Add(dsnlist(i).ToString)
            End If
        Next
        Try
            Cmb.SelectedIndex = 0
        Catch
            GetODBCDns = False
            Exit Function
        End Try
        GetODBCDns = True
    End Function

    '加载sql语句文件
    Private Function LoadSql(ByVal R1 As RichtextColorBox, ByVal R2 As RichTextBox) As Boolean

        Dim File_name As String
        Dim op As New OpenFileDialog()

        op.InitialDirectory = Application.StartupPath & "\"
        op.Filter = "文本文件(*.txt)|*.txt|Sql文件(*.sql)|*.sql"
        op.FilterIndex = 2
        op.RestoreDirectory = True
        op.Multiselect = True

        If op.ShowDialog() = DialogResult.OK Then
            If op.FileNames.Length > 0 Then
                RichTextSql.Clear()
                Dim StrSql As String
                Dim i As Integer
                For i = 0 To op.FileNames.Length - 1
                    File_name = op.FileNames(i)
                    If Not File.Exists(File_name) Then
                        R2.Text = File_name & "{0} 文件不存在." & vbCrLf
                        Return False
                    End If
                    Dim Sreadline1 As Stream
                    Sreadline1 = File.OpenRead(File_name)
                    Dim sr As StreamReader = New StreamReader(Sreadline1, _
                        System.Text.Encoding.Default)
                    Dim Line As String
                    Do
                        Line = sr.ReadLine()
                        If Line Is Nothing Then
                            Exit Do
                        End If
                        StrSql = StrSql & Line.Trim
                    Loop Until Line Is Nothing
                Next
                StrSql = StrSql.ToLower.Replace("create", vbCrLf & "create")
                StrSql = StrSql.ToLower.Replace("insert into", vbCrLf & "insert into")
                StrSql = StrSql.ToLower.Replace("update", vbCrLf & "update")
                StrSql = StrSql.ToLower.Replace("drop", vbCrLf & " drop")
                R1.rAppendText(StrSql.Trim & "")
                R2.Text = R2.Text & "文件数据已加载完成." & vbCrLf
            End If
        Else
            R2.Text = R2.Text & "没有加载任何信息." & vbCrLf
        End If
        Return True
    End Function

    '执行Sql语句
    Private Function RunSql(ByVal StrSql As String, ByVal Richtext As RichTextBox, ByVal Connstr As String) As Boolean

        If StrSql.Trim.Length = 0 Then
            Richtext.Text = Richtext.Text & "没有要执行任何的Sql语句." & vbCrLf
            Exit Function
        End If
        Dim Cn As New ADODB.Connection()
        Dim Cmd As New ADODB.Command()
        Cn.ConnectionString = Connstr
        Try
            Cn.Open()
        Catch es As Exception
            Richtext.Text = Richtext.Text & Connstr & vbCrLf
            Richtext.Text = Richtext.Text & es.Message & vbCrLf
            Richtext.Text = Richtext.Text & "数据库连接错误." & vbCrLf
            Return False
        End Try

        Try
            Cmd.ActiveConnection = Cn
            Cmd.CommandType = ADODB.CommandTypeEnum.adCmdText
            Cmd.CommandText = StrSql
            Cmd.Execute()
        Catch es As Exception
            Richtext.Text = StrSql & vbCrLf
            Richtext.Text = Richtext.Text & es.Message.ToString & vbCrLf
            Richtext.Text = Richtext.Text & "执行sql语句错误." & vbCrLf
            Cn.Close()
            Return False
        End Try
        Cn.Close()
        Richtext.Text = Richtext.Text & "执行Sql语句完成." & vbCrLf
    End Function

#End Region