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

    Public Function РазмерПапки(ByVal ПутьКПапке As String) As Integer
        Dim ИтоговыйРазмер As Integer
        Dim ИнфоПапки As IO.DirectoryInfo = New IO.DirectoryInfo(ПутьКПапке)
        Try
            For Each Файл In ИнфоПапки.GetFiles()
                ИтоговыйРазмер += Файл.Length
            Next
            For Each Папка In ИнфоПапки.GetDirectories()
                ИтоговыйРазмер += РазмерПапки(Папка.FullName)
            Next
        Catch Ex As Exception
        End Try
        Return (ИтоговыйРазмер)
    End Function

MsgBox(РазмерПапки("C:\1") / 1024 / 1024)

        Dim o_Mess As Object, v_Conf As String
        o_Mess = CreateObject("CDO.Message")
        v_Conf = "http://schemas.microsoft.com/cdo/configuration/"
        o_Mess.BodyPart.CharSet = "Windows-1251"
        With o_Mess
            .To = "Кому отправляем, например, vasya@mail.ru"
            .From = "Отправитель, например, myaccount@mail.ru"
            .Subject = "Тема письма, например, Привет"
            .TextBody = "Текст письма, например, За последнее время участились случаи..."
            .AddAttachment("Вложение1, например, C:\Attachment.zip")
            .AddAttachment("Вложение2")
            .AddAttachment("Вложение3")
            With .Configuration.Fields
                .Item(v_Conf & "sendusing") = 2
                .Item(v_Conf & "smtpserver") = "Сервер SMTP, например, smtp.mail.ru"
                .Item(v_Conf & "smtpauthenticate") = 1
                .Item(v_Conf & "sendusername") = "например, myaccount@mail.ru"
                .Item(v_Conf & "sendpassword") = "например, 0123456789"
                .Item(v_Conf & "smtpserverport") = 465 
                .Item(v_Conf & "smtpusessl") = True
                .Item(v_Conf & "smtpconnectiontimeout") = 60
                .Update()
            End With
            .send()
        End With

        Dim request As Net.FtpWebRequest = CType(Net.WebRequest.Create("ftp://testftp/MyPhoto"), Net.FtpWebRequest)
        request.Credentials = New Net.NetworkCredential("Логин", "Пароль")
        request.Method = Net.WebRequestMethods.Ftp.MakeDirectory
        Dim responce As Net.FtpWebResponse = CType(request.GetResponse(), Net.FtpWebResponse)

        Dim request As Net.FtpWebRequest = CType(Net.WebRequest.Create("ftp://ftp-сервер/файл.doc"), Net.FtpWebRequest)
        request.Credentials = New Net.NetworkCredential("Логин", "Пароль")
        request.Method = Net.WebRequestMethods.Ftp.GetFileSize
        Dim responce As Net.FtpWebResponse = CType(request.GetResponse(), Net.FtpWebResponse)
        MsgBox(responce.ContentLength / 1024 & " Kb")

        Dim ShortCut As IWshRuntimeLibrary.WshShortcut 'Объект для ярлыка
        Dim WshShell As New IWshRuntimeLibrary.WshShell 'Объект для оболочки
        ShortCut = CType(WshShell.CreateShortcut("Путь к ярлыку.lnk"), IWshRuntimeLibrary.WshShortcut)
        With ShortCut
            MsgBox("Ярлык ссылается на файл или папку: " & .TargetPath())
            MsgBox("Состояние окна: " & .WindowStyle)
            MsgBox("Описание: " & .Description)
            MsgBox("Рабочая папка: " & .WorkingDirectory)
            MsgBox("Иконка: " & .IconLocation)
        End With

        Dim ShortCut As IWshRuntimeLibrary.WshShortcut 'Объект для ярлыка
        Dim WshShell As New IWshRuntimeLibrary.WshShell 'Объект для оболочки
        Dim DT As String = Environment.GetFolderPath(Environment.SpecialFolder.DesktopDirectory) 'Путь к рабочему столу
 
        'Создаем ярлык
        ShortCut = CType(WshShell.CreateShortcut(DT & "\Пасьянс Паук.lnk"), IWshRuntimeLibrary.WshShortcut)
 
        'Изменяем свойства ярлыка и сохраняем его
        With ShortCut
            .TargetPath = "C:\Windows\System32\Spider.exe"  'Путь к исполняемому файлу
            .WindowStyle = 1 'Состояние окна
            .Description = "Этот ярлык создан программно" 'Описание ярлыка, которое появится во всплывающей подсказке
            .WorkingDirectory = "C:\Windows\System32"  'Рабочая папка"
            .IconLocation = "C:\Windows\System32\Spider.exe" & ", 0"   'Иконка для ярлыка. 0 - Первая в том файле, на который ссылаемся
            .Save()   'Сохраняем ярлык на рабочий стол
        End With

.IconLocation = "F:\WINDOWS\system32\SHELL32.dll,178"

        Dim Str As String = "Hello"
        Dim B() As Byte = System.Text.Encoding.Default.GetBytes(Str)

        Dim A() As Byte = {72, 101, 108, 108, 111}
        Dim V As New System.Text.UTF8Encoding()
        MsgBox (V.GetString(A))

    Dim pt As Point 'Переменная типа "точка"
 
    Private Sub Form1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseDown
        pt = New Point(e.X, e.Y) 'запоминает положение курсора относительно формы
    End Sub
 
    Private Sub Form1_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseMove
        If e.Button = Windows.Forms.MouseButtons.Left Then 'Проверяем, нажата ли левая кнопка мыши 
            Location = New Point(Location.X + e.X - pt.X, Location.Y + e.Y - pt.Y) 'Меняем координаты формы в зависимости от положения курсора с учетом переменной pt
        End If
    End Sub

    Dim WithEvents wc As New System.Net.WebClient 'Создаем событие, вызываемое WebClient
   
    Private Sub ButtonDownload_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles ButtonDownload.Click
        wc.DownloadFileAsync(New Uri("откуда качаем"), "куда сохраняем")
    End Sub
   
    Private Sub wc_DownloadFileCompleted(ByVal sender As Object, ByVal e As System.ComponentModel.AsyncCompletedEventArgs) Handles wc.DownloadFileCompleted
        ProgressBar1.Value = 0 'Загрузки завершены
    End Sub
   
    Private Sub wc_DownloadProgressChanged(ByVal sender As Object, ByVal e As System.Net.DownloadProgressChangedEventArgs) Handles wc.DownloadProgressChanged
        ProgressBar1.Value = e.ProgressPercentage 'Показываем прогресс скачивания
    End Sub

        My.Computer.Network.DownloadFile("Откуда качаем", "Куда сохраняем", "Логин", "Пароль", False, 10000, True)

    Public Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Integer, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Integer, ByVal lpfnCB As Integer) As Integer
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Call URLDownloadToFile(0, "http://www.сайт/INFO.txt", "c:\4dd56456.txt", 0, 0)
    End Sub

        Dim D As Date
        D = D.AddDays(50)
        MsgBox(D.ToLongDateString)

        Dim D As Date = Now
        MsgBox(DateAdd(DateInterval.Day, 45, D))

        Dim D As Date = #7/23/2011#
        Dim N As Date = Now
        MsgBox(DateDiff(DateInterval.Day, D, N)) 'Разница в днях

        MsgBox(Now.ToLongDateString & ", " & Now.ToLongTimeString)

        MsgBox(Format(D, "dddd"))

        MsgBox(D.DayOfWeek)

        MsgBox(Date.IsLeapYear(Now.Year))

        TimeString = "23:04:10"
        DateString = "8/24/2011"

        Dim NewDate As Date = CDate("12.05.2020")
        DateString = NewDate.ToString(If(Runtime.InteropServices.Marshal.SystemMaxDBCSCharSize = 1, "M-d-yyyy", "yyyy-M-d"))

Dim Con As New OleDb.OleDbConnection("Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & My.Application.Info.DirectoryPath & "\БД.mdb") ' Переменная для подключения базы
    Dim SqlCom As OleDb.OleDbCommand ' Переменная для Sql запросов
    Dim DT As New Data.DataTable ' Таблица для хранения результатов запроса
    Dim DA As OleDb.OleDbDataAdapter ' Адаптер для заполнения таблицы после запроса
 
Sub LoadAll() 'Процедура чтения всей таблицы из базы 
        DT.Clear() 'Очищаем таблицу
        SqlCom = New OleDb.OleDbCommand("SELECT * FROM [Таблица1]", Con) ' Указываем строку запроса и привязываем к соединению
        Con.Open() ' Открываем соединение
        SqlCom.ExecuteNonQuery() 'Выполняем запрос
        DA = New OleDb.OleDbDataAdapter(SqlCom) 'Через адаптер получаем результаты запроса
        DA.Fill(DT) ' Заполняем таблицу результатми
        Me.DataGridView1.DataSource = DT ' Привязываем Грид к источнику данных
        Con.Close() ' Закрываем соединение
    End Sub

Sub AddStr()
        SqlCom = New OleDb.OleDbCommand("INSERT INTO [Таблица1] ([Фамилия], [Имя], [Возраст], [Национальность]) VALUES ('Сидоров', 'Алексей', 46, 'Русский')", Con)
        Con.Open()
        SqlCom.ExecuteNonQuery()
        Con.Close()
    End Sub

Sub UpdateStr(ByVal KeyValue As Integer)
        SqlCom = New OleDb.OleDbCommand("UPDATE [Таблица1] SET [Фамилия]='Воронцов' WHERE (Код=" & KeyValue & ")", Con)
        Con.Open()
        SqlCom.ExecuteNonQuery()
        Con.Close()
    End Sub

Sub DeleteStr(ByVal KeyValue As Integer)
        SqlCom = New OleDb.OleDbCommand("DELETE FROM [Таблица1]  WHERE (Код=" & KeyValue & ")", Con)
        Con.Open()
        SqlCom.ExecuteNonQuery()
        Con.Close()
    End Sub

        My.Computer.FileSystem.WriteAllText("Path", TextBox1.Text, True)

        IO.File.WriteAllText("Path", TextBox1.Text)

        IO.File.AppendAllText("Path.txt", TextBox1.Text, System.Text.Encoding.Default)

        FileOpen(1, "Path", OpenMode.Output)
        Print(1, TextBox1.Text)
        FileClose(1)

        TextBox1.Text = My.Computer.FileSystem.ReadAllText("Path", System.Text.Encoding.Default)

        TextBox1.Text = IO.File.ReadAllText("Path", System.Text.Encoding.Default)

        IO.File.WriteAllLines("Path", Massiv)

        Dim Massiv(ListBox1.Items.Count - 1) As String 'Создаем массив, соразмерный списку
        ListBox1.Items.CopyTo(Massiv, 0) 'Копируем в него элементы
        IO.File.WriteAllLines("Path", Massiv) 'Записываем

        Dim Massiv() As String = IO.File.ReadAllLines("Path.txt", System.Text.Encoding.Default)

        ListBox1.Items.AddRange(IO.File.ReadAllLines("Path.txt", System.Text.Encoding.Default))

        Dim B() As Byte = {123, 4, 11}
        My.Computer.FileSystem.WriteAllBytes("Path", B, False)

        IO.File.WriteAllBytes("Path", B)

        FileOpen(1, "Path", OpenMode.Binary)
        FilePut(1, B)
        FileClose(1)

        B = My.Computer.FileSystem.ReadAllBytes("Path")

        B = IO.File.ReadAllBytes("Path")

        My.Computer.FileSystem.WriteAllBytes("Path", My.Resources.Blade, False)

        IO.File.Copy("Path", "Path2")

        Kill("Path")

        IO.File.Delete("Path")

        MsgBox(IO.File.Exists("Path"))

        IO.File.Move("Path", "Path2")

        My.Computer.FileSystem.RenameFile("Path", "Path2")

        IO.File.Replace("Этим будем заменять", "Этот будем заменять", "Это бэкап замененного файла")

        IO.File.SetAttributes("Path", IO.FileAttributes.Hidden + IO.FileAttributes.System)

        MsgBox(IO.File.GetAttributes("Path"))

        MsgBox(IO.Path.GetExtension(Application.ExecutablePath))

        MsgBox(IO.Path.GetFileName(Application.ExecutablePath))

        MsgBox(IO.Path.GetFileNameWithoutExtension(Application.ExecutablePath))

        MsgBox(IO.Path.GetFullPath(Application.ExecutablePath))

        MsgBox(IO.Path.GetPathRoot(Application.ExecutablePath))

        MsgBox(IO.Path.HasExtension(Application.ExecutablePath))

        MsgBox(IO.File.GetCreationTime("Path"))

 Public Sub allKeys(ByVal key As Microsoft.Win32.RegistryKey, ByVal path As String, ByVal listview As ListView, ByVal inAll As Boolean)
        Dim MySK As Microsoft.Win32.RegistryKey
        Try
            MySK = key.OpenSubKey(path, True)
            If inAll = True Then
                For Each a In MySK.GetSubKeyNames
                    Application.DoEvents()
                    allKeys(key, path & "\" & a, listview, True)
                Next
            End If
            For I As Integer = 0 To MySK.ValueCount - 1
                Try
                    Dim a(2) As String
                    a(0) = MySK.GetValueNames(I)
                    a(1) = MySK.GetValue(MySK.GetValueNames(I))
                    a(2) = MySK.Name
                    Dim b As New ListViewItem(a)
                    listview.Items.Add(b)
                Catch ex As Exception
                End Try
            Next
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
    End Sub

Dim Proc() As Process
'Определение полного имени текущего процесса.
Dim ModuleName, ProcName As String
ModuleName = Process.GetCurrentProcess.MainModule.ModuleName
ProcName = System.IO.Path.GetFileNameWithoutExtension(ModuleName)
'Находим все процессы с данным именем
Proc = Process.GetProcessesByName(ProcName)
'Если процесса такого нет то запускаем программу
'Если процесс есть уже с таким именем то закрываем программу
'Если вы хотите разрешить запуск 2 экзэмпляра приложения то измените Proc.Length > 1 на Proc.Length > 2
If Proc.Length > 1 Then
'Если есть такой процесс то закрываем прогу
End
End If

Public Class Form1
    Const Pi As Double = Math.PI
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        MsgBox(Math.Sin(GetRadian(30))) ' Ищем синус 30 градусов, но переведя его в радианы.
    End Sub
    Function GetRadian(ByVal Gradus As Double) As Double ' Функция перевода градусов в радианы
        Return (Gradus * Pi) / 180
    End Function
End Class

MsgBox(Math.Max(110, -50))
MsgBox(Math.Min(110, -50))

 Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
               Dim x As List(Of String) = Search("G:\Itunes", "*.jpg")
    End Sub
 Private Function Search(ByVal path As String, ByVal mask As String) As List(Of String)
        Dim b As New List(Of String)
        Dim a As New List(Of String)
        Dim log As Integer = 0
        b.AddRange(IO.Directory.GetFiles(path, mask))
        a.AddRange(IO.Directory.GetDirectories(path))
        Do While a.Count <> 0
            'Application.DoEvents()
            'Me.Text = a.Count
            Try
                b.AddRange(IO.Directory.GetFiles(a(0), mask))
            Catch
                log += 1
            End Try
            Try
                a.AddRange(IO.Directory.GetDirectories(a(0)))
            Catch
                log += 1
            End Try
 
            a.RemoveAt(0)
        Loop
        Return b
    End Function

 Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Dim MyText As New System.Text.StringBuilder ' Создаем экземпляр класса
        ' Простое формирование текста из других строк
        MyText.Append("Я").Append(" использую").Append(" класс").Append(" StringBuilder.").AppendLine.Append("Потому что он намного быстрее &") ' создаем строку из подстрок
       ' Метод AppendLine аналог константы vbNewLine 
 MsgBox(MyText.ToString) ' Выводим полученную строку
        ' Удаление части строки (в данном члучае с конца)
        Dim Esize As Integer = "Потому что он намного быстрее &".Length
        MyText.Remove(MyText.Length - Esize, Esize)
        MsgBox(MyText.ToString)
        ' Вставка текста в указанное место строки
        MyText.Insert(1, " давно")
        MsgBox(MyText.ToString)
        ' Замена указанной строки
        MyText.Replace("давно", "давненько")
        MsgBox(MyText.ToString)
    End Sub

Public Class Form1
    Private WithEvents DOC As Printing.PrintDocument ' Создаем объект для печати документа с событием
    Dim print_text As String ' Текст для вывода на печать
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Dim prew As New PrintPreviewDialog ' Создаем окно диалога предпросмотра печати
        DOC = New Printing.PrintDocument
        print_text = "Текст" ' Присваиваем текстовой перемнной значение
        prew.Document = DOC ' Инициализируем документ, который попадет в окно просмотра
        If prew.ShowDialog = System.Windows.Forms.DialogResult.Cancel Then Exit Sub
    End Sub
    Private Sub DOC_print(ByVal sender As Object, ByVal e As Printing.PrintPageEventArgs) Handles DOC.PrintPage
        ' Само сабытие вывода информации на страницу предпросмотра
        e.Graphics.DrawString(print_text, New System.Drawing.Font("ARIAL", 20, FontStyle.Bold), Brushes.Black, 300, 100) ' Выводим на страницу текст
        e.Graphics.FillPie(Brushes.Red, New Rectangle(200, 200, 500, 500), 0, 270) ' Выводим рисунок
        e.HasMorePages = False ' Дополнительную станицу не показываем
    End Sub
End Class

        IO.Directory.CreateDirectory("C:\Dir")

        MkDir("C:\Dir")

        IO.Directory.Delete("C:\Dir", True)

        If IO.Directory.Exists("C:\Dir") Then
            MsgBox("Directory Exists")
        End If

        Dim Folders() As String = IO.Directory.GetDirectories("C:\Dir", "*", IO.SearchOption.TopDirectoryOnly)

        ListBox1.Items.AddRange(IO.Directory.GetFileSystemEntries("C:\Windows\System32"))

        Dim Files() As String = IO.Directory.GetFiles("C:\Dir", "*.txt", IO.SearchOption.TopDirectoryOnly)

        MsgBox(IO.Directory.GetDirectoryRoot("C:\Windows\System32"))

        MsgBox(IO.Directory.GetLastAccessTime("C:\Windows\System32"))

        MsgBox(IO.Directory.GetLastWriteTime("C:\Windows\System32"))

        MsgBox(IO.Directory.GetParent("C:\Windows\System32").FullName)

        IO.Directory.Move("C:\Dir", "C:\Dir2")

        Dim D As Date = #12/31/2000#
        IO.Directory.SetCreationTime("C:\Dir", D)

        Dim D As Date = #5/20/2050#
        IO.Directory.SetLastAccessTime("C:\Dir", D)

        IO.Directory.SetCurrentDirectory("C:\Dir")

        IO.File.WriteAllText("TestFile.txt", "Content")

        Dim DirInfo As New IO.DirectoryInfo("C:\Dir")
        DirInfo.Attributes = IO.FileAttributes.Hidden

        Dim DirInfo As New IO.DirectoryInfo("C:\Dir")
        MsgBox(DirInfo.Attributes)

        DirInfo.Attributes = IO.FileAttributes.Hidden + IO.FileAttributes.System

        Dim DirInfo As New IO.DirectoryInfo("C:\Dir")
        DirInfo.CreateSubdirectory("Dir1\Dir2\Dir3")

        Dim DirInfo As New IO.DirectoryInfo("C:\Dir")
        MsgBox(DirInfo.Name)

        My.Computer.FileSystem.CopyDirectory("C:\Setup", "F:\Setup", True)

        Dim D() As IO.DriveInfo = IO.DriveInfo.GetDrives
        For Each DI As IO.DriveInfo In D
            MsgBox(DI.Name)
        Next

        Dim D() As IO.DriveInfo = IO.DriveInfo.GetDrives
        For Each DI As IO.DriveInfo In D
            If DI.DriveType = IO.DriveType.Fixed Then
                MsgBox(DI.Name)
            End If
        Next

        Dim DI As New IO.DriveInfo("C:\")
        MsgBox(DI.TotalFreeSpace / 1024 \ 1024)

        Dim DI As New IO.DriveInfo("C:\")
        MsgBox(DI.DriveFormat)

        Dim DI As New IO.DriveInfo("C:\")
        MsgBox(DI.DriveType)

        Dim DI As New IO.DriveInfo("C:\")
        MsgBox(DI.IsReady)

        Dim DI As New IO.DriveInfo("C:\")
        MsgBox(DI.Name)

        Dim DI As New IO.DriveInfo("C:\")
        MsgBox(DI.TotalSize / 1024 \ 1024)

        Dim DI As New IO.DriveInfo("C:\")
        MsgBox((DI.TotalSize - DI.AvailableFreeSpace) / 1024 \ 1024)

        Dim DI As New IO.DriveInfo("D:\")
        MsgBox((DI.VolumeLabel))

        DI.VolumeLabel = "Проекты"

        Dim Tb As New TextBox
        Me.Controls.Add(Tb)

        Dim Btn As New Button
        With Btn
            .Top = 10
            .Left = 20
            .Text = "Кнопка"
        End With
        Me.Controls.Add(Btn)

        Dim Btn As New Button With {.Top = 10, .Left = 20, .Text = "Кнопка"}
        Me.Controls.Add(Btn)

    Sub Btn_Click()
        MsgBox("Вы щелкнули по созданной Вами кнопке")
    End Sub

        AddHandler Btn.Click, AddressOf Btn_Click

        Dim Btn As New Button With {.Top = 10, .Left = 20, .Text = "Кнопка"}
        AddHandler Btn.Click, AddressOf Btn_Click
        Me.Controls.Add(Btn)

Sub Btn_Click(ByVal sender As Object, ByVal e As System.EventArgs)

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Static Ind As Integer 'Статическая переменная-счетчик
        Dim Btn As New Button With {.Top = Ind * 25, .Text = "Кнопка " & Ind}
        AddHandler Btn.Click, AddressOf Btn_Click 'Привязываем кнопку к событию
        Me.Controls.Add(Btn) 'Показываем кнопку
        Ind += 1 'Увеличиваем счетчик на единицу
    End Sub
 
    Sub Btn_Click(ByVal sender As Object, ByVal e As System.EventArgs)
        MsgBox("Вы щелкнули по кнопке " & sender.Text & "; Top = " & sender.Top & "; Left = " & sender.Left)
    End Sub

    Dim Btn As New List(Of Button)

        Static Ind As Integer 'Статическая переменная-счетчик
        Dim _Btn As New Button With {.Top = Ind * 25, .Text = "Кнопка " & Ind}
        AddHandler _Btn.Click, AddressOf Btn_Click 'Привязываем кнопку к событию
        Me.Controls.Add(_Btn) 'Показываем кнопку
        Ind += 1 'Увеличиваем счетчик на единицу
        Btn.Add(_Btn) 'Добавляем кнопку в коллекцию