Готовые решения и полезные коды на Visual Basic .NET (Часть-1)

Public Class TabsStripControl
    Inherits UserControl
    Event TabClick(sender As Object, e As TabPage)
 
    Private Sub TabsStripControl_Load(sender As Object, e As EventArgs) Handles Me.Load
        SetStyle(ControlStyles.AllPaintingInWmPaint Or
                 ControlStyles.OptimizedDoubleBuffer Or
                 ControlStyles.ResizeRedraw Or
                 ControlStyles.UserPaint, True)
    End Sub
    Sub New()
        InitializeComponent()
    End Sub
    Private Sub InitializeComponent()
        Me.PanelHostContext = New System.Windows.Forms.Panel()
        Me.PanelHostElement = New System.Windows.Forms.Panel()
        Me.PanelHostTabs = New System.Windows.Forms.Panel()
        Me.PanelHostElementWin = New System.Windows.Forms.Panel()
        Me.PanelHostContext.SuspendLayout()
        Me.PanelHostElement.SuspendLayout()
        Me.SuspendLayout()
        '
        'PanelHostContext
        '
        Me.PanelHostContext.BackColor = System.Drawing.Color.Transparent
        Me.PanelHostContext.Controls.Add(Me.PanelHostTabs)
        Me.PanelHostContext.Dock = System.Windows.Forms.DockStyle.Top
        Me.PanelHostContext.Location = New System.Drawing.Point(0, 0)
        Me.PanelHostContext.Name = "PanelHostContext"
        Me.PanelHostContext.Size = New System.Drawing.Size(470, 23)
        Me.PanelHostContext.TabIndex = 0
        '
        'PanelHostElement
        '
        Me.PanelHostElement.BackColor = System.Drawing.Color.Transparent
        Me.PanelHostElement.Controls.Add(Me.PanelHostElementWin)
        Me.PanelHostElement.Dock = System.Windows.Forms.DockStyle.Fill
        Me.PanelHostElement.Location = New System.Drawing.Point(0, 23)
        Me.PanelHostElement.Name = "PanelHostElement"
        Me.PanelHostElement.Padding = New System.Windows.Forms.Padding(1)
        Me.PanelHostElement.Size = New System.Drawing.Size(470, 306)
        Me.PanelHostElement.TabIndex = 1
        '
        'PanelHostTabs
        '
        Me.PanelHostTabs.AutoSize = True
        Me.PanelHostTabs.Dock = System.Windows.Forms.DockStyle.Left
        Me.PanelHostTabs.Location = New System.Drawing.Point(0, 0)
        Me.PanelHostTabs.Name = "PanelHostTabs"
        Me.PanelHostTabs.Size = New System.Drawing.Size(0, 23)
        Me.PanelHostTabs.TabIndex = 0
        '
        'PanelHostElementWin
        '
        Me.PanelHostElementWin.BackColor = System.Drawing.Color.WhiteSmoke
        Me.PanelHostElementWin.Dock = System.Windows.Forms.DockStyle.Fill
        Me.PanelHostElementWin.Location = New System.Drawing.Point(1, 1)
        Me.PanelHostElementWin.Name = "PanelHostElementWin"
        Me.PanelHostElementWin.Size = New System.Drawing.Size(468, 304)
        Me.PanelHostElementWin.TabIndex = 0
        '
        'TabsStripControl
        '
        Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
        Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
        Me.Controls.Add(Me.PanelHostElement)
        Me.Controls.Add(Me.PanelHostContext)
        Me.Name = "TabsStripControl"
        Me.Size = New System.Drawing.Size(470, 329)
        Me.PanelHostContext.ResumeLayout(False)
        Me.PanelHostContext.PerformLayout()
        Me.PanelHostElement.ResumeLayout(False)
        Me.ResumeLayout(False)
 
    End Sub
    Private WithEvents PanelHostContext As System.Windows.Forms.Panel
    Private WithEvents PanelHostElement As System.Windows.Forms.Panel
    Private WithEvents PanelHostTabs As System.Windows.Forms.Panel
    Friend WithEvents PanelHostElementWin As System.Windows.Forms.Panel
 
    Private Sub TabsStripControl_Paint(sender As Object, e As PaintEventArgs) Handles Me.Paint
        With e.Graphics
            .FillRectangle(New SolidBrush(Color.FromArgb(245, 245, 245)),
                            0, PanelHostContext.Height - 1,
                            sender.Width - 1, sender.Height - PanelHostContext.Height - 1)
            .DrawRectangle(New Pen(Color.FromArgb(204, 206, 219)),
                           0, PanelHostContext.Height - 1, sender.Width - 1,
                           sender.Height - PanelHostContext.Height - 1)
 
            .DrawLine(New Pen(Color.FromArgb(0, 122, 204), 2),
                               0, PanelHostContext.Height - 1,
                               sender.Width, PanelHostContext.Height - 1)
        End With
    End Sub
 
    Public Function AddTab(name As String, text As String, control As Control) As TabPage
        Dim TabPage As New TabPage With {.Text = text, .Name = name, .Dock = DockStyle.Right,
                                         .Parent = PanelHostTabs, .ControlHost = control}
        AddHandler TabPage.Click, Sub(sender, e)
                                      RaiseEvent TabClick(Me, sender)
                                      For Each item In PanelHostTabs.Controls
                                          If control.Equals(item, sender) Then
                                              PanelHostElementWin.Controls.Clear()
                                              item.ControlHost.Dock = DockStyle.Fill
                                              item.ControlHost.Parent = PanelHostElementWin
                                              item.IsActiveTab = True
                                          Else
                                              item.IsActiveTab = False
                                          End If
                                      Next
 
                                  End Sub
        Return TabPage
    End Function
 
    Public Function AddTab(TabPage As TabPage) As TabPage
        With TabPage
            .Dock = DockStyle.Right
            .Parent = PanelHostTabs
        End With
 
        AddHandler TabPage.Click, Sub(sender, e)
                                      RaiseEvent TabClick(Me, sender)
                                      For Each item In PanelHostTabs.Controls
                                          If Control.Equals(item, sender) Then
                                              PanelHostElement.Controls.Clear()
                                              item.ControlHost.Dock = DockStyle.Fill
                                              item.ControlHost.Parent = PanelHostElementWin
                                              item.IsActiveTab = True
                                          Else
                                              item.IsActiveTab = False
                                          End If
                                      Next
 
                                  End Sub
        Return TabPage
    End Function
 
 
    Public ReadOnly Property TabPages As TabPage()
        Get
            Dim TResult() As TabPage = {}
            If PanelHostTabs.Controls.Count > 0 Then
                For Each item In PanelHostTabs.Controls
                    If TypeOf (item) Is TabPage Then
                        ReDim Preserve TResult(TResult.Length)
                        TResult(TResult.Length - 1) = item
                    End If
                Next
            End If
 
            Return TResult
        End Get
    End Property
 
    Public Class TabPage
        Inherits UserControl
        Private boolIsActive As Boolean = False
        Private MouseType As Integer = -1
        Private ElementHost As Control
        Private SelectClose As Boolean = False
 
        Sub New()
            SetStyle(ControlStyles.AllPaintingInWmPaint Or
                 ControlStyles.OptimizedDoubleBuffer Or
                 ControlStyles.ResizeRedraw Or
                 ControlStyles.UserPaint, True)
        End Sub
 
        Public Property ControlHost As Control
            Get
                Return ElementHost
            End Get
            Set(value As Control)
                ElementHost = value
            End Set
        End Property
 
        Public Overrides Property Text As String
            Get
                Return MyBase.Text
            End Get
            Set(value As String)
                MyBase.Text = value
            End Set
        End Property
 
        Public Property IsActiveTab As Boolean
            Get
                Return boolIsActive
            End Get
            Set(value As Boolean)
                boolIsActive = value
                If boolIsActive Then
                    BackColor = Color.FromArgb(0, 122, 204)
                    ForeColor = Color.White
                Else
                    BackColor = Color.Transparent
                    ForeColor = Color.Black
                    MouseType = -1
                End If
            End Set
        End Property
 
        Private Sub TabPage_MouseClick(sender As Object, e As MouseEventArgs) Handles Me.MouseClick
            If e.Button = Windows.Forms.MouseButtons.Left And SelectClose Then
                ControlHost.Parent = Nothing
                sender.Dispose()
            End If
        End Sub
 
        Private Sub TabPage_MouseEnter(sender As Object, e As EventArgs) Handles Me.MouseEnter
            If Not IsActiveTab Then
                BackColor = Color.FromArgb(28, 151, 234)
                ForeColor = Color.White
                MouseType = 0
                Refresh()
            End If
        End Sub
 
        Private Sub TabPage_MouseLeave(sender As Object, e As EventArgs) Handles Me.MouseLeave
            If Not IsActiveTab Then
                BackColor = Color.Transparent
                ForeColor = Color.Black
                MouseType = -1
                SelectClose = False
                Refresh()
            End If
            SelectClose = False
            Refresh()
        End Sub
 
        Private Sub TabPage_MouseMove(sender As Object, e As MouseEventArgs) Handles Me.MouseMove
            If e.X > sender.Width - 20 Then
                SelectClose = True
                Refresh()
            Else
                SelectClose = False
                Refresh()
            End If
        End Sub
 
        Private Sub TabPage_Paint(sender As Object, e As PaintEventArgs) Handles Me.Paint
            With e.Graphics
                Dim SFont = .MeasureString(Text, Font).ToSize
                sender.Width = SFont.Width + 30
                .DrawString(Text, Font, New SolidBrush(ForeColor),
                2,
                sender.Height / 2 - SFont.Height / 2)
                If MouseType = 0 Then
                    If SelectClose Then
                        .FillRectangle(New SolidBrush(Color.FromArgb(82, 176, 239)), sender.Width - 19, 3, 16, 16)
                    End If
                    .DrawString("r", New Font("Webdings", 9), Brushes.White, sender.Width - 19, 1)
                End If
            End With
        End Sub
    End Class
End Class

   
    Shared Function Account_UpdateInfo(ByVal _UserId As Integer, ByVal _ulogin As String, ByVal _fname As String, ByVal _lname As String, ByVal _mname As String, ByVal _utype As Integer, ByVal _Isactive As Boolean, ByVal _pphone As Object, ByVal _wphone As Object, ByVal _addr As String, ByVal _other As Object) As Boolean
 
        Dim _command As New MySqlCommand
        With _command.Parameters
            .AddWithValue("@id", _UserId)
            .AddWithValue("@ulogin", _ulogin.ToLower)
            .AddWithValue("@fname", _fname)
            .AddWithValue("@lname", _lname)
            .AddWithValue("@mname", _mname)
            .AddWithValue("@utype", _utype)
            .AddWithValue("@isactive", _Isactive)
            .AddWithValue("@pphone", GetStringOrNULL(_pphone))
            .AddWithValue("@wphone", GetStringOrNULL(_wphone))
            .AddWithValue("@aud", GetStringOrNULL(_addr))
            .AddWithValue("@other", GetStringOrNULL(_other))
        End With
        _command.Connection = _Connect
        _command.CommandText = "UPDATE [task_users] SET [ulogin] = @ulogin, [fname] = @fname, [lname] = @lname, [mname] = @mname, [utype]=@utype, [isactive]=@isactive, [pphone]=@pphone, [wphone]=@wphone, [aud]=@aud, [other]=@other WHERE [id]=@id"
        Try
            If _Connect.State = ConnectionState.Closed Then
                _Connect.Open()
            End If
            _command.ExecuteNonQuery()
            _Connect.Close()
            Return True
        Catch e1 As MySqlException
            WriteErrorLog("Процедура обновления данных пользователя (Account_UpdateInfo)", e1.Message)
            Return False
        Catch e2 As Exception
            WriteErrorLog("Процедура обновления данных пользователя (Account_UpdateInfo)", e2.Message)
            Return False
        End Try
    End Function

 ''' <summary>
    ''' Процедура обновления данных пользователя
    ''' </summary>
    ''' <param name="_UserId">Айди пользователя</param>
    ''' <param name="_ulogin">Логин в нижнем регистре</param>
    ''' <param name="_fname">Имя</param>
    ''' <param name="_lname">Фамилия</param>
    ''' <param name="_mname">Отчество</param>
    ''' <param name="_utype">тип учетной записи 0 - viewonly, 1 - User, 2 - Admin</param>
    ''' <param name="_Isactive">0 отключен, 1 включен</param>
    ''' <param name="_pphone">Личный телефон</param>
    ''' <param name="_wphone">Рабочий телефон</param>
    ''' <param name="_addr">Аудитория</param>
    ''' <param name="_other">Другое</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Shared Function Account_UpdateInfo(ByVal _UserId As Integer, ByVal _ulogin As String, ByVal _fname As String, ByVal _lname As String, ByVal _mname As String, ByVal _utype As Integer, ByVal _Isactive As Boolean, ByVal _pphone As Object, ByVal _wphone As Object, ByVal _addr As String, ByVal _other As Object) As Boolean
 
        Dim _command As New MySqlCommand
        With _command.Parameters
            .AddWithValue("@id", _UserId)
            .AddWithValue("@ulogin", _ulogin.ToLower)
            .AddWithValue("@fname", _fname)
            .AddWithValue("@lname", _lname)
            .AddWithValue("@mname", _mname)
            .AddWithValue("@utype", _utype)
            .AddWithValue("@isactive", _Isactive)
            .AddWithValue("@pphone", GetStringOrNULL(_pphone))
            .AddWithValue("@wphone", GetStringOrNULL(_wphone))
            .AddWithValue("@aud", GetStringOrNULL(_addr))
            .AddWithValue("@other", GetStringOrNULL(_other))
        End With
        _command.Connection = _Connect
        _command.CommandText = "UPDATE [task_users] SET [ulogin] = @ulogin, [fname] = @fname, [lname] = @lname, [mname] = @mname, [utype]=@utype, [isactive]=@isactive, [pphone]=@pphone, [wphone]=@wphone, [aud]=@aud, [other]=@other WHERE [id]=@id"
        Try
            If _Connect.State = ConnectionState.Closed Then
                _Connect.Open()
            End If
            _command.ExecuteNonQuery()
            _Connect.Close()
            Return True
        Catch e1 As MySqlException
            WriteErrorLog("Процедура обновления данных пользователя (Account_UpdateInfo)", e1.Message)
            Return False
        Catch e2 As Exception
            WriteErrorLog("Процедура обновления данных пользователя (Account_UpdateInfo)", e2.Message)
            Return False
        End Try
    End Function

Public Class ProcessItem
    Private _id As Integer
    Private _title As String
 
    Sub New(id As Integer, title As String)
        _id = id
        _title = title
    End Sub
 
    Public ReadOnly Property ID As Integer
        Get
            Return _id
        End Get
    End Property
 
    Public ReadOnly Property Title As String
        Get
            Return _title
        End Get
    End Property
 
    Public Overrides Function ToString() As String
        Return _title
    End Function
End Class

Public Class Form1
 
    Private ListProcesses As New Dictionary(Of ProcessItem, String)
 
    Private Sub MainWindow_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        For Each p In Process.GetProcesses
            Try
                If Not p.MainWindowTitle = String.Empty Then
                    ListProcesses.Add(New ProcessItem(p.Id, p.MainWindowTitle), p.Modules(0).FileName)
                End If
            Catch ex As Exception
 
            End Try
        Next
    End Sub
 
 
    Private Sub TimerScan_Tick(sender As Object, e As EventArgs) Handles TimerScan.Tick
        'отображаем список запущенных процессов
        For Each p In ListProcesses
            Try
                With Process.GetProcessById(p.Key.ID)
                    If Not .MainWindowTitle = String.Empty Then
                        If Not ListBoxProccess.Items.Contains(.MainWindowTitle) Then
                            ListBoxProccess.Items.Add(.MainWindowTitle)
                        End If
                    End If
                End With
            Catch ex As Exception
                ListProcesses.Remove(p.Key)
 
                ListBoxProccess.Items.Remove(p.Key.Title)
                Exit For
            End Try
        Next
 
        For Each p In Process.GetProcesses
            Try
                If Not p.MainWindowTitle = String.Empty Then
                    If Not ListProcesses.ContainsValue(p.Modules(0).FileName) Then
                        ListProcesses.Add(New ProcessItem(p.Id, p.MainWindowTitle), p.Modules(0).FileName)
                    End If
                End If
 
            Catch ex As Exception
 
            End Try
        Next
    End Sub
End Class

Event ConnectionRequest(ByVal sender As Object, ByVal e As ConnectionRequestEventArgs)
    Event DataReceived(ByVal sender As Object, ByVal e As DataReceivedEventArgs)
    Event Connected(ByVal sender As Object, ByVal e As ConnectedEventArgs)
    Event StartListener(ByVal sender As Object, ByVal e As EventArgs)
    Event EndListener(ByVal sender As Object, ByVal e As EventArgs)
    Event Disconnected(ByVal sender As Object, ByVal e As DisconnectedEventArgs)
    Event SendCompleted(ByVal sender As Object, ByVal e As EventArgs)
    Event SendAllCompleted(ByVal sender As Object, ByVal e As EventArgs)
    Event SendFileCompleted(ByVal sender As Object, ByVal e As EventArgs)
 
Public Property BufferReceive() As Long
Public ReadOnly Property IsStart() As Boolean
Public ReadOnly Property Users() As List(Of Net.Sockets.Socket)
Public Sub Start(ByVal address As Net.IPAddress, ByVal port As Integer)
Public Sub Start(ByVal address As String, ByVal port As Integer)
Public Sub [Stop]()
Public Sub KickAll()
Public Sub Kick(ByVal socket As Net.Sockets.Socket)
Public Sub Kick(ByVal address As String, ByVal port As String)
Public Sub Send(ByVal buffer() As Byte, ByVal socket As Net.Sockets.Socket)
Public Sub SendAll(ByVal buffer() As Byte)
Public Sub SendFile(ByVal fileName As String, ByVal socket As Net.Sockets.Socket)
 Public Sub SendFile(ByVal fileName As String, ByVal preBuffer() As Byte, ByVal postBuffer() As Byte, ByVal flags As Net.Sockets.TransmitFileOptions, ByVal socket As Net.Sockets.Socket)

Event Connected(ByVal sender As Object, ByVal e As ConnectedEventArgs)
    Event DataReceived(ByVal sender As Object, ByVal e As DataReceivedEventArgs)
    Event Disconnected(ByVal sender As Object, ByVal e As DisconnectedEventArgs)
    Event SendCompleted(ByVal sender As Object, ByVal e As EventArgs)
    Event SendFileCompleted(ByVal sender As Object, ByVal e As EventArgs)
 
Public Function GetTcpClient() As Net.Sockets.TcpClient
Public Sub Send(ByVal buffer() As Byte)
Public Sub SendFile(ByVal fileName As String)
Public Property BufferReceive() As Long
Public ReadOnly Property IsConnected() As Boolean
Public Sub Disconnect()
Public Function Connect(ByVal address As String, ByVal port As Integer) As Boolean

Public Class ReceivedClipboardFiledEventArgs
    Private _exception As Exception
    Sub New(ex As Exception)
        _exception = ex
    End Sub
    ''' <summary>
    ''' Получает текущую ошибку
    ''' </summary>
    ''' <value></value>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public ReadOnly Property Exception As Exception
        Get
            Return _exception
        End Get
    End Property
End Class

Public Class ReceivedClipboardTextEventArgs
    Private _text As String = String.Empty
    Sub New(t As String)
        _text = t
    End Sub
    ''' <summary>
    ''' Получает новый текст с буфера обмена.
    ''' </summary>
    ''' <value></value>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public ReadOnly Property Text As String
        Get
            Return _text
        End Get
    End Property
End Class

Imports System.ComponentModel
 
Public Class IntegrationClipboard
    Inherits Component
    Event ReceivedClipboardText(sender As Object, e As ReceivedClipboardTextEventArgs)
    Event ReceivedClipboardFiled(sender As Object, e As ReceivedClipboardFiledEventArgs)
    Private _enabled As Boolean = False
    Private _timeout As Integer = 500
    Private _filter As String = "*"
    Private _threadReceived As Threading.Thread
    Private _current As Threading.SynchronizationContext
    Sub New()
        _current = Threading.SynchronizationContext.Current
    End Sub
    ''' <summary>
    ''' Получает или указывает запущена ли интеграция буфера обмена.
    ''' </summary>
    ''' <value></value>
    ''' <returns></returns>
    ''' <remarks></remarks>
    <DefaultValue(False)> Public Property Enabled As Boolean
        Get
            Return _enabled
        End Get
        Set(value As Boolean)
            _enabled = value
            If _enabled Then
                If _threadReceived Is Nothing Then
                    _threadReceived = New Threading.Thread(AddressOf Event_Received)
                    _threadReceived.IsBackground = True
                    _threadReceived.SetApartmentState(Threading.ApartmentState.STA)
                    _threadReceived.Start()
                End If
            End If
        End Set
    End Property
    ''' <summary>
    ''' Получает или указывает время ожидания буфера обмена.
    ''' </summary>
    ''' <value></value>
    ''' <returns></returns>
    ''' <remarks></remarks>
    <DefaultValue(500)> Public Property Timeout As Integer
        Get
            Return _timeout
        End Get
        Set(value As Integer)
            _timeout = value
        End Set
    End Property
    ''' <summary>
    ''' Получает или указывает фильтр текста.
    ''' </summary>
    ''' <value></value>
    ''' <returns></returns>
    ''' <remarks></remarks>
    <DefaultValue("*")> Public Property Filter As String
        Get
            Return _filter
        End Get
        Set(value As String)
            _filter = value
        End Set
    End Property
    Private Sub Event_Received()
        Dim r_Text As String = String.Empty
        Dim s_Text As String = String.Empty
        If Clipboard.ContainsText Then
            r_Text = Clipboard.GetText
        End If
        While _enabled
            If Clipboard.ContainsText Then
                s_Text = Clipboard.GetText
                If Not r_Text = s_Text Then
                    r_Text = s_Text
                    Try
                        Dim m_Filters() As String = Split(_filter, "|")
                        For Each f In m_Filters
                            If s_Text Like f Then
                                _current.Post(AddressOf post_ReceivedClipboardText, s_Text)
                                Exit For
                            End If
                        Next
                    Catch ex As Exception
                        _current.Post(AddressOf post_ReceivedClipboardFiled, ex)
                    End Try
                End If
            End If
            Threading.Thread.Sleep(_timeout)
        End While
    End Sub
    Private Sub post_ReceivedClipboardFiled(e As Object)
        RaiseEvent ReceivedClipboardFiled(Me, New ReceivedClipboardFiledEventArgs(e))
    End Sub
    Private Sub post_ReceivedClipboardText(e As Object)
        RaiseEvent ReceivedClipboardText(Me, New ReceivedClipboardTextEventArgs(e))
    End Sub
End Class

' (C) Emiliarge, 2014
 
Imports System.Data.SQLite
 
Public Class frmMain
 
#Region "Fields"
 
    Private szDbFile As String = "helloSqlite.sqlite"
    Private szDbTableName As String = "Моя таблица"
 
    Private uConn As SQLiteConnection
    Private uCmd As SQLiteCommand
    Private uAdapter As SQLiteDataAdapter
    Private uBuilder As SQLiteCommandBuilder
 
    Private dt As DataTable
 
#End Region
 
    Public Sub New()
 
        ' This call is required by the Windows Form Designer.
        InitializeComponent()
 
        ' Add any initialization after the InitializeComponent() call.
        uConn = New SQLiteConnection(String.Format("Data Source = {0};", szDbFile))
        uConn.Open()
 
        uCmd = New SQLiteCommand(String.Format("CREATE TABLE IF NOT EXISTS [{0}] (" & _
                                               "id INTEGER PRIMARY KEY AUTOINCREMENT, " & _
                                               "'Текстовый столбец' TEXT, " & _
                                               "'Столбец для целых чисел' INTEGER" & _
                                               ")", szDbTableName), uConn)
        uCmd.ExecuteNonQuery()
 
        uAdapter = New SQLiteDataAdapter("SELECT * FROM [" & szDbTableName & "]", uConn)
        uBuilder = New SQLiteCommandBuilder(uAdapter)
        dt = New DataTable
        uAdapter.Fill(dt)
        dt.Columns("id").ReadOnly = True ' запрет на редактирование поля счетчика
        DataGridView1.DataSource = dt
    End Sub
 
    Private Sub frmMain_FormClosed(ByVal sender As System.Object, ByVal e As System.Windows.Forms.FormClosedEventArgs) Handles MyBase.FormClosed
 
        uAdapter.Update(dt)
 
    End Sub
 
    Private Sub DataGridView1_DataError(ByVal sender As System.Object, ByVal e As System.Windows.Forms.DataGridViewDataErrorEventArgs) Handles DataGridView1.DataError
 
        If dt.Columns(e.ColumnIndex).DataType Is GetType(Int64) Or _
            dt.Columns(e.ColumnIndex).DataType Is GetType(Int32) Or _
            dt.Columns(e.ColumnIndex).DataType Is GetType(Int16) Then
 
            Dim rectColumn As Rectangle
            rectColumn = DataGridView1.GetColumnDisplayRectangle(e.ColumnIndex, False)
 
            Dim rectRow As Rectangle
            rectRow = DataGridView1.GetRowDisplayRectangle(e.RowIndex, False)
 
            ToolTip1.ToolTipTitle = "В это поле можно вводить только целые числа"
            ToolTip1.Show(" ", _
                          DataGridView1, _
                          rectColumn.Left, rectRow.Top + rectRow.Height)
 
        End If
 
    End Sub
 
    Private Sub DataGridView1_MouseDown(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles DataGridView1.MouseDown
        ToolTip1.Hide(DataGridView1)
    End Sub
End Class

' (C) Emiliarge, 2014
 
Imports Microsoft.Win32
Imports System.IO
Imports System.Data.SqlClient
 
Public Class frmMain
 
#Region "Fields"
 
    Private szServerName As String = "localhost\sqlexpress"
    Private szDbName As String = "helloSqlServer"
    Private szConnStr As String
 
    Private szDbTableName As String = "Моя таблица"
 
    Private sqlConn As SqlConnection
    Private sqlCmd As SqlCommand
    Private sqlAdapter As SqlDataAdapter
    Private sqlBuilder As SqlCommandBuilder
 
    Private dt As DataTable
 
#End Region
 
    Public Sub New()
 
        ' This call is required by the Windows Form Designer.
        InitializeComponent()
 
        ' Add any initialization after the InitializeComponent() call.
 
        ' Подключение к серверу
        szConnStr = String.Format("Server = {0}; " & _
                                  "Trusted_Connection = Yes; " & _
                                  "Database = master;", _
                                  szServerName)
        sqlConn = New SqlConnection(szConnStr)
        sqlConn.Open()
 
        ' Проверка, есть ли база данных
        Dim bExists As Boolean
        For Each dr As DataRow In sqlConn.GetSchema("Databases").Rows
            If dr("database_name") = szDbName Then
                bExists = True
            End If
        Next
 
        ' Создание базы данных, если ее нет
        If Not bExists Then
            ' Получение пути к папке с MSSQL (в ее подпапке DATA - файлы баз данных)
            ' По умолчанию-C:\Program Files\Microsoft SQL Server\MSSQL10.SQLEXPRESS\MSSQL\
 
            Dim szDataPath As String = ""
            Using hKeyMSSQL = Registry.LocalMachine.OpenSubKey("SOFTWARE\Microsoft\Microsoft SQL Server")
                For Each szSubKey In hKeyMSSQL.GetSubKeyNames()
                    If szSubKey.StartsWith("MSSQL") Then
                        Using hKey = hKeyMSSQL.OpenSubKey(szSubKey).OpenSubKey("Setup")
                            szDataPath = hKey.GetValue("SQLDataRoot") + "\DATA"
                            Exit For
                        End Using
                    End If
                Next
            End Using
 
            Dim szCreateDbQuery As String
            If File.Exists(String.Format("C:\Program Files\Microsoft SQL Server\MSSQL10.SQLEXPRESS\MSSQL\DATA\{0}.mdf", szDbName)) Then
                ' файл базы есть, но отсоединен
                szCreateDbQuery = String.Format("CREATE DATABASE [{0}] ON (" & _
                                                "    FILENAME = N'{1}\{0}.mdf'" & _
                                                ") FOR ATTACH;", _
                                                szDbName, szDataPath)
 
            Else
                ' базы нет вообще
                szCreateDbQuery = String.Format("CREATE DATABASE [{0}] ON (" & _
                                                "    NAME = {0}, " & _
                                                "    FILENAME = N'{1}\{0}.mdf'" & _
                                                ");", _
                                                szDbName, szDataPath)
            End If
            sqlCmd = New SqlCommand(szCreateDbQuery, sqlConn)
            sqlCmd.ExecuteNonQuery()
        End If
 
        ' Подключение к базе
        szConnStr = String.Format("Server = {0}; " & _
                                  "Trusted_Connection = Yes; " & _
                                  "Database = {1};", _
                                  szServerName, _
                                  szDbName)
        sqlConn = New SqlConnection(szConnStr)
        sqlConn.Open()
 
        ' Создание таблицы, если ее нет
        Dim szCreateQuery As String
        szCreateQuery = String.Format("IF NOT EXISTS (" & _
                                      "    SELECT [name] " & _
                                      "    FROM sys.tables " & _
                                      "    WHERE [name] = '{0}'" & _
                                      ") " & _
                                      "CREATE TABLE [{0}] (" & _
                                      "    id [INT] IDENTITY(1,1) PRIMARY KEY CLUSTERED, " & _
                                      "    [Текстовый столбец] [TEXT] NULL, " & _
                                      "    [Столбец для целых чисел] [INT] NULL " & _
                                      ")", _
                                      szDbTableName)
        sqlCmd = New SqlCommand(szCreateQuery, sqlConn)
        sqlCmd.ExecuteNonQuery()
 
        ' Загрузка таблицы
        sqlAdapter = New SqlDataAdapter("SELECT * FROM [" & szDbTableName & "]", sqlConn)
        sqlBuilder = New SqlCommandBuilder(sqlAdapter)
        dt = New DataTable
        sqlAdapter.Fill(dt)
        dt.Columns("id").ReadOnly = True ' запрет на редактирование поля счетчика
        DataGridView1.DataSource = dt
 
    End Sub
 
    Private Sub frmMain_FormClosed(ByVal sender As System.Object, ByVal e As System.Windows.Forms.FormClosedEventArgs) Handles MyBase.FormClosed
 
        sqlAdapter.Update(dt)
 
    End Sub
 
    '
    ' DataGridView1
    '
 
    Private Sub DataGridView1_DataError(ByVal sender As System.Object, ByVal e As System.Windows.Forms.DataGridViewDataErrorEventArgs) Handles DataGridView1.DataError
 
        If dt.Columns(e.ColumnIndex).DataType Is GetType(Int64) Or _
            dt.Columns(e.ColumnIndex).DataType Is GetType(Int32) Or _
            dt.Columns(e.ColumnIndex).DataType Is GetType(Int16) Then
 
            Dim rectColumn As Rectangle
            rectColumn = DataGridView1.GetColumnDisplayRectangle(e.ColumnIndex, False)
 
            Dim rectRow As Rectangle
            rectRow = DataGridView1.GetRowDisplayRectangle(e.RowIndex, False)
 
            ToolTip1.ToolTipTitle = "В это поле можно вводить только целые числа"
            ToolTip1.Show(" ", _
                          DataGridView1, _
                          rectColumn.Left, rectRow.Top + rectRow.Height)
        End If
 
    End Sub
 
    Private Sub DataGridView1_MouseDown(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles DataGridView1.MouseDown
 
        ToolTip1.Hide(DataGridView1)
 
    End Sub
End Class

' (C) Emiliarge, 2014
 
Imports System.Data.SqlClient
 
Public Class frmMain
 
#Region "Fields"
 
    Dim sqlConn As SqlConnection
    Dim sqlAdapter As SqlDataAdapter
    Dim sqlCmdBuilder As SqlCommandBuilder
 
    Dim dt As New DataTable
 
#End Region
 
    Private Sub btnConnect_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnConnect.Click
 
        sqlConn = New SqlConnection("Server = localhost\sqlexpress; Trusted_Connection = Yes; Database = helloSqlServer;")
 
        sqlAdapter = New SqlDataAdapter("SELECT * FROM [Моя таблица]", sqlConn)
 
        sqlCmdBuilder = New SqlCommandBuilder(sqlAdapter)
 
        sqlAdapter.Fill(dt)
        DataGridView1.DataSource = dt
 
    End Sub
 
    Private Sub btnSave_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnSave.Click
 
        sqlAdapter.Update(dt)
 
    End Sub
 
End Class