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

Private Sub RichTextBoxДляПримера_MouseMove(ByVal sender As Object, ByVal e As MouseEventArgs) Handles RichTextBoxДляПримера.MouseMove
        If Not RichTextBoxДляПримера.ClientRectangle.Contains(e.Location) Then
            RichTextBoxДляПримера.Capture = False
        ElseIf Not RichTextBoxДляПримера.Capture Then
            RichTextBoxДляПримера.Capture = True
        End If
    End Sub

    Private Sub WebBrowser_Event(sender As Object, e As EventArgs) Handles WebBrowser1.DocumentCompleted, WebBrowser1.DocumentTitleChanged
        If WebBrowser1.DocumentText.Contains("""http://www.w3.org/TR/html4/loose.dtd""") Then
            WebBrowser1.DocumentText = "<h1>Не получилось загрузить данную страницу</h1>"
        End If
    End Sub

        Private Sub StartupNextInstanceHandler(ByVal sender As Object, ByVal e As Microsoft.VisualBasic.ApplicationServices.StartupNextInstanceEventArgs) Handles Me.StartupNextInstance
            ' StartupNextInstance: возникает при запуске приложения, допускающего одновременное выполнение только одного экземпляра, если это приложение уже активно.
            Form1.Activate() 'переводим юзера на главную форму, ибо приложение будет всё еще "вне фокуса"
            Form1.AlreadyStarted() 'запускаем метод для показа сообщения
            e.BringToForeground = True
        End Sub

    Dim AlreadyStartedError = "Это приложение уже запущено :/"
    Sub AlreadyStarted()
        Interaction.MsgBox(Prompt:=AlreadyStartedError, 16, "Ошибка инициализации")
    End Sub

    Sub AlreadyStarted()
        Dim Answer = Interaction.MsgBox(Prompt:="Приложение уже запущено. Перезапустить его?", 4, "Перезапустить приложение?")
        If Answer = MsgBoxResult.Yes Then Application.Restart()
    End Sub

Imports System.Runtime.InteropServices
Imports System.Security
Public Class IconInjector
    Public Sub InjectIcon(ByVal exeFileName As String, ByVal iconFileName As String)
        InjectIcon(exeFileName, iconFileName, 1, 1)
    End Sub
    Public Sub InjectIcon(ByVal exeFileName As String, ByVal iconFileName As String, ByVal iconGroupID As UInteger, ByVal iconBaseID As UInteger)
        Const RT_ICON = 3UI
        Const RT_GROUP_ICON = 14UI
        Dim iconFile As New IconFile
        iconFile = iconFile.FromFile(iconFileName)
        Dim hUpdate = NativeMethods.BeginUpdateResource(exeFileName, False)
        Dim data = iconFile.CreateIconGroupData(iconBaseID)
        NativeMethods.UpdateResource(hUpdate, New IntPtr(RT_GROUP_ICON), New IntPtr(iconGroupID), 0, data, data.Length)
        For i = 0 To iconFile.ImageCount - 1
            Dim image = iconFile.ImageData(i)
            NativeMethods.UpdateResource(hUpdate, New IntPtr(RT_ICON), New IntPtr(iconBaseID + i), 0, image, image.Length)
        Next
        NativeMethods.EndUpdateResource(hUpdate, False)
    End Sub
End Class
<SuppressUnmanagedCodeSecurity()> _
Public Class NativeMethods
    <DllImport("kernel32")> Public Shared Function BeginUpdateResource(ByVal fileName As String, <MarshalAs(UnmanagedType.Bool)> ByVal deleteExistingResources As Boolean) As IntPtr
    End Function
    <DllImport("kernel32")> Public Shared Function UpdateResource(ByVal hUpdate As IntPtr, ByVal type As IntPtr, ByVal name As IntPtr, ByVal language As Short, <MarshalAs(UnmanagedType.LPArray, SizeParamIndex:=5)> ByVal data() As Byte, ByVal dataSize As Integer) As <MarshalAs(UnmanagedType.Bool)> Boolean
    End Function
    <DllImport("kernel32")> _
    Public Shared Function EndUpdateResource(ByVal hUpdate As IntPtr, <MarshalAs(UnmanagedType.Bool)> ByVal discard As Boolean) As <MarshalAs(UnmanagedType.Bool)> Boolean
    End Function
End Class
<StructLayout(LayoutKind.Sequential)> _
Public Structure ICONDIR
    Public Reserved As UShort
    Public Type As UShort
    Public Count As UShort
End Structure
<StructLayout(LayoutKind.Sequential)> _
Public Structure ICONDIRENTRY
    Public Width As Byte
    Public Height As Byte
    Public ColorCount As Byte
    Public Reserved As Byte
    Public Planes As UShort
    Public BitCount As UShort
    Public BytesInRes As Integer
    Public ImageOffset As Integer
End Structure
<StructLayout(LayoutKind.Sequential)> _
Public Structure BITMAPINFOHEADER
    Public Size As UInteger
    Public Width As Integer
    Public Height As Integer
    Public Planes As UShort
    Public BitCount As UShort
    Public Compression As UInteger
    Public SizeImage As UInteger
    Public XPelsPerMeter As Integer
    Public YPelsPerMeter As Integer
    Public ClrUsed As UInteger
    Public ClrImportant As UInteger
End Structure
<StructLayout(LayoutKind.Sequential, Pack:=2)> _
Public Structure GRPICONDIRENTRY
    Public Width As Byte
    Public Height As Byte
    Public ColorCount As Byte
    Public Reserved As Byte
    Public Planes As UShort
    Public BitCount As UShort
    Public BytesInRes As Integer
    Public ID As UShort
End Structure
Public Class IconFile
    Private iconDir As New ICONDIR
    Private iconEntry() As ICONDIRENTRY
    Private iconImage()() As Byte
    Public ReadOnly Property ImageCount As Integer
        Get
            Return iconDir.Count
        End Get
    End Property
    Public ReadOnly Property ImageData(ByVal index As Integer) As Byte()
        Get
            Return iconImage(index)
        End Get
    End Property
    Public Function FromFile(ByVal filename As String) As IconFile
        Dim instance As New IconFile
        Dim fileBytes() As Byte = IO.File.ReadAllBytes(filename)
        Dim pinnedBytes = GCHandle.Alloc(fileBytes, GCHandleType.Pinned)
        instance.iconDir = DirectCast(Marshal.PtrToStructure(pinnedBytes.AddrOfPinnedObject, GetType(ICONDIR)), ICONDIR)
        instance.iconEntry = New ICONDIRENTRY(instance.iconDir.Count - 1) {}
        instance.iconImage = New Byte(instance.iconDir.Count - 1)() {}
        Dim offset = Marshal.SizeOf(instance.iconDir)
        Dim iconDirEntryType = GetType(ICONDIRENTRY)
        Dim size = Marshal.SizeOf(iconDirEntryType)
        For i = 0 To instance.iconDir.Count - 1
            Dim entry = DirectCast(Marshal.PtrToStructure(New IntPtr(pinnedBytes.AddrOfPinnedObject.ToInt64 + offset), iconDirEntryType), ICONDIRENTRY)
            instance.iconEntry(i) = entry
            instance.iconImage(i) = New Byte(entry.BytesInRes - 1) {}
            Buffer.BlockCopy(fileBytes, entry.ImageOffset, instance.iconImage(i), 0, entry.BytesInRes)
            offset += size
        Next
        pinnedBytes.Free()
        Return instance
    End Function
    Public Function CreateIconGroupData(ByVal iconBaseID As UInteger) As Byte()
        Dim sizeOfIconGroupData As Integer = Marshal.SizeOf(GetType(ICONDIR)) + Marshal.SizeOf(GetType(GRPICONDIRENTRY)) * ImageCount
        Dim data(sizeOfIconGroupData - 1) As Byte
        Dim pinnedData = GCHandle.Alloc(data, GCHandleType.Pinned)
        Marshal.StructureToPtr(iconDir, pinnedData.AddrOfPinnedObject, False)
        Dim offset = Marshal.SizeOf(iconDir)
        For i = 0 To ImageCount - 1
            Dim grpEntry As New GRPICONDIRENTRY
            Dim bitmapheader As New BITMAPINFOHEADER
            Dim pinnedBitmapInfoHeader = GCHandle.Alloc(bitmapheader, GCHandleType.Pinned)
            Marshal.Copy(ImageData(i), 0, pinnedBitmapInfoHeader.AddrOfPinnedObject, Marshal.SizeOf(GetType(BITMAPINFOHEADER)))
            pinnedBitmapInfoHeader.Free()
            grpEntry.Width = iconEntry(i).Width
            grpEntry.Height = iconEntry(i).Height
            grpEntry.ColorCount = iconEntry(i).ColorCount
            grpEntry.Reserved = iconEntry(i).Reserved
            grpEntry.Planes = bitmapheader.Planes
            grpEntry.BitCount = bitmapheader.BitCount
            grpEntry.BytesInRes = iconEntry(i).BytesInRes
            grpEntry.ID = CType(iconBaseID + i, UShort)
            Marshal.StructureToPtr(grpEntry, New IntPtr(pinnedData.AddrOfPinnedObject.ToInt64 + offset), False)
            offset += Marshal.SizeOf(GetType(GRPICONDIRENTRY))
        Next
        pinnedData.Free()
        Return data
    End Function
End Class

Dim IC As New IconInjector
IC.InjectIcon("ПУТЬ_К_EXE_ФАЙЛУ", "ПУТЬ_К_ICO_ФАЙЛУ")

        Dim SupportTelegramDomain = "DosX_Plus" ' Представим, что это аккаунт поддержки
        Try
            System.Diagnostics.Process.Start("tg://" & "resolve?domain=" & SupportTelegramDomain) ' Пробуем открыть...
        Catch ex As Exception
            If IO.File.Exists(Environment.ExpandEnvironmentVariables("%AppData%/Telegram Desktop/Telegram.exe")) Then ' При ошибке проверяем: Установлен ли мессенджер в папке с программами...
                Dim ErrMsg As MsgBoxResult = MsgBox(ex.Message, 16, "Telegram") ' Если он установлен, но не удалось запустить, то выводим соответствующее сообщение об ошибке
            End If
            System.Diagnostics.Process.Start("https://" & "t.me/" & SupportTelegramDomain) ' Если не удалось запустить программу, то открываем нужную ссылку в браузере.
        End Try

Public Sub SetBackgroundColor(e As String)
    If e.Length < 3 Then
        Call Shell("cmd.exe" & " /c " & "Color " & e.ToUpper)
    ElseIf e.Length > 2 Then
        GoTo Err
    ElseIf e.Contains("?") Then
        GoTo Err
    End If
Err:
End Sub

SetBackgroundColor("FC") 'F - фон, C - текст

' Author: HACKER KAY (CyberForum.ru)
    Sub ShowMenu_OpenFileAs(FileName As String)
        Try
            If Not IO.File.Exists(FileName) Then
                Dim ErrMsg = Interaction.MsgBox("File '" & FileName & "' not found.", 16, "Error")
                If ErrMsg = MsgBoxResult.Ok Then
                    GoTo NF_Err_Point
                End If
            End If
            Dim WIN32_LIB = "SHELL32.DLL"
            Dim WIN32_METHOD = "OpenAs_RunDLL " & FileName
            Dim PSI As ProcessStartInfo = New ProcessStartInfo("RunDll32") With {
                        .RedirectStandardOutput = True,
                        .RedirectStandardError = True,
                        .UseShellExecute = False,
                        .Arguments = WIN32_LIB & "," & WIN32_METHOD
            }
            Dim Process As Process = Process.Start(PSI)
        Catch ex As Exception
            MsgBox(ex.ToString, 16, ex.Message)
        End Try
NF_Err_Point:
    End Sub

ShowMenu_OpenFileAs(Application.StartupPath & "\test.txt")

    '=============================================
    ' Включение по дням недели
    '---------------------------------------------
     TodayEnable = (DaysEnable And 2 ^ Now.ToUniversalTime.AddHours(-MyTimeZone).DayOfWeek) > 0
    '---------------------------------------------
    ' DaysEnable:
    ' 1 - Воскресенье
    ' 2 - Понедельник
    ' 4 - Вторник
    ' 8 - Среда
    '16 - Четверг
    '32 - Пятница
    '64 - Суббота
    '---------------------------------------------
    'Пример расчета значений для DaysEnable:
    '1 + 2 + 16 = 19 - Воскресенье, Понедельник, Четверг
    '1 + 4 + 32 = 37 - Воскресенье, Вторник, Пятница
    '1 + 8 + 64 = 73 - Воскресенье, Среда, Суббота
    '---------------------------------------------
    ' MyTimeZone = 3 - для Москвы
    '---------------------------------------------
    ' Результат:
    ' TodayEnable = True - включен
    ' TodayEnable = False - выключен
    '---------------------------------------------