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

Памирыч · Регистрация: 11.04.2010

Студворк — интернет-сервис помощи студентам

Предлагаю в этой теме размещать ответы на часто задаваемые вопросы и просто делиться полезными кодами.
Обращаю внимание на некоторые моменты, которые являются дополнением к основным правилам

Запрещается копировать материалы с других сайтов или форумов
Решения должны быть написаны с использованием языка Visual Basic .NET
Запрещено создавать посты с уточнениями и замечаниями. Такие вопросы задавайте на форуме
Код, в котором присутствуют комментарии, читается и понимается намного легче и быстрее
Длинные коды и объемные вопросы одного содержания заключайте в теги [SPОILER]Большой код[/SPОILER]
При создании поста убедитесь, что этот вопрос не был освещен ранее
Код должен быть написан грамотно, большие и неэффективные коды будут удаляться
Список вопросов по конкретной теме нельзя "разрывать" на 2 и более поста

Просьба к постившим: не спешите постить решения "сгоряча", тщательно обдумайте список вопросов, их тематику и порядок
Если вы найдете информацию, которой можно было бы дополнить ваши предыдущие сообщения, что-то изменить или перегруппировать, пишите в л/с.

Комментарий модератора

Данные правила обязательны к исполнению в рамках темы

Примечание: некоторые коды приведены без учета строгой типизации (Параметр Strict), поэтому для их использования необходимо выполнить приведение типов

greg zakharov · 16.04.2020, 18:02

Переменные окружения процесса

Как правило, структуры Windows от версии к версии ОС меняются незначительно, и чаще всего эти изменения выражены добавлением новых полей структуры (обычно в окончание последней, реже - в начало или середину, очень редко структура изменяется до неузнаваемости). Смещения некотрых первых полей таких структур остаются неизменными на протяжении десятилетий (исключая обозначенные выше случаи). Введение новых полей с одной стороны вносит некую сумятицу в работу системного программиста, с другой - в разы может упростить извлечение каких-то данных. Например, структура PEB в Windows 10 выглядит уже очень привлекательно, из нее можно извлечь такие данные как детальные сведения о кучах без отладдочного буфера (RtlCreateQueryDebugBuffer) или, скажем, переменные окружения процесса (ниже представлени пример того, как это можно сделать).

VB.NET
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
Imports System.Text
Imports System.Reflection
Imports System.ComponentModel
Imports Microsoft.Win32.SAfeHandles
Imports System.Runtime.InteropServices
 
Friend NotInheritable Class Program
  Friend NotInheritable Class NativeMethods
    Private Sub New
    End Sub
 
    Friend Const STATUS_SUCCESS As Int32 = &H00000000
    Friend Const ProcessBasicInformation As UInt32 = 0
    Friend Const PROCESS_QUERY_INFORMATION = &H0400
    Friend Const PROCESS_VM_READ = &H0010
 
    <DllImport("kernel32.dll", SetLastError := True)> _
    Friend Shared Function OpenProcess( _
       ByVal dwDesiredAccess As UInt32, _
       <MarshalAs(UnmanagedType.Bool)> ByVal bInheritProcess As Boolean, _
       ByVal dwProcessId As UInt32 _
    ) As SafeProcessHandle
    End Function
 
    <DllImport("kernel32.dll", SetLastError := True)> _
    Friend Shared Function ReadProcessMemory( _
       ByVal hProcess As SafeProcessHandle, _
       ByVal lpBaseAddress As IntPtr, _
       ByVal lpBuffer As Byte(), _
       ByVal nSize As Int32, _
       ByVal lpNumberOfBytesRead As IntPtr _
    ) As <MarshalAs(UnmanagedType.Bool)> Boolean
    End Function
 
    <DllImport("ntdll.dll")> _
    Friend Shared Function NtQueryInformationProcess( _
       ByVal ProcessHandle As SafeProcessHandle, _
       ByVal ProcessInformationClass As UInt32, _
       ByRef ProcessInformation As PROCESS_BASIC_INFORMATION, _
       ByVal ProcessInformationLength As UInt32, _
       ByVal ReturnLength As IntPtr _
    ) As Int32 'NTSTATUS
    End Function
 
    <DllImport("ntdll.dll")> _
    Friend Shared Function RtlNtStatusToDosError( _
       ByVal Status As Int32 _
    ) As Int32
    End Function
  End Class
 
  <StructLayout(LayoutKind.Sequential)> _
  Friend Structure PROCESS_BASIC_INFORMATION
    Friend ExitStatus As Int32 'NTSTATUS
    Friend PebBaseAddress As IntPtr 'PPEB
    Friend AffinityMask As IntPtr
    Friend BasePriority As Int32 'KPRIORITY
    Friend UniqueProcessId As IntPtr
    Friend InheritedFromUniqueProcessId As IntPtr
  End Structure
 
  Friend NotInheritable Class Program
    Shared Function GetLastError(ByVal ntstatus As Int32) As String
      Return (New Win32Exception( _
        If(NativeMethods.STATUS_SUCCESS <> ntstatus, _
          NativeMethods.RtlNtStatusToDosError(ntstatus), Marshal.GetLastWin32Error) _
      )).Message
    End Function
 
    Shared Function GetPEBAddress(ByVal sph As SafeProcessHandle) As IntPtr
      Dim pbi As New PROCESS_BASIC_INFORMATION
      Dim nts As Int32 = NativeMethods.NtQueryInformationProcess( _
        sph, NativeMethods.ProcessBasicInformation, pbi, _
        Marshal.SizeOf(GetType(PROCESS_BASIC_INFORMATION)), IntPtr.Zero
      )
 
      If NativeMethods.STATUS_SUCCESS <> nts Then
        Throw New InvalidOperationException(GetLastError(nts))
      End If
 
      Return pbi.PebBaseAddress
    End Function
 
    Shared Sub Main(ByVal args As String())
      If 1 <> args.Length Then
        Console.WriteLine("Синтаксис: {0} <PID>", GetType(Program).Assembly.GetName.Name)
        Return
      End If
 
      Dim pid As UInt32 = 0
      If Not UInt32.TryParse(args(0), pid) Then
        Console.WriteLine("Внутренняя ошибка: PID имеет неверный формат.")
        Return
      End If
 
      Dim sph As New SafeProcessHandle(IntPtr.Zero, True)
      Try
        sph = NativeMethods.OpenProcess( _
          NativeMethods.PROCESS_QUERY_INFORMATION Or NativeMethods.PROCESS_VM_READ, _
          False, pid
        )
 
        If (sph.IsInvalid) Then 'сообщаем пользователю, что не так с отрытием процесса
          Throw New InvalidOperationException(GetLastError(0))
        End If
 
        Dim peb As IntPtr = GetPEBAddress(sph) 'указатель на PEB процесса
        'далее нужно получить указатель на структуру RTL_USER_PROCESS_PARAMETERS
        'для x86 архитертуры смещение будет равным &H10, для x64 - &H20
        Dim buf As Byte() = New Byte(IntPtr.Size - 1) {}
        If Not NativeMethods.ReadProcessMemory( _
          sph, CType(peb.ToInt64() + &H20, IntPtr), buf, buf.Length, IntPtr.Zero _
        ) Then
          Throw New InvalidOperationException(GetLastError(0))
        End If
        'размер структуры RTL_USER_PROCESS_PARAMETERS &H2BC и &H440 для x86 и x64 соответственно
        Dim ptr As IntPtr = CType(BitConverter.ToInt64(buf, 0), IntPtr)
        Array.Resize(buf, &H440)
        If Not NativeMethods.ReadProcessMemory(sph, ptr, buf, buf.Length, IntPtr.Zero) Then
          Throw New InvalidOperationException(GetLastError(0))
        End If
        'извлекаем данные полей Environment и EnvironmentSize
        Dim env As IntPtr
        Dim esz As Int64 'на x86 - Int32 (хотя вообще-то EnvironmentSize предствлено как ULONG_PTR)
        Dim gch As GCHandle = GCHandle.Alloc(buf, GCHandleType.Pinned)
        env = Marshal.ReadIntPtr(gch.AddrOfPinnedObject, &H80) 'на x86 смещение &H48
        esz = Marshal.ReadInt64(gch.AddrOfPinnedObject, &H3F0) 'на x86 смещение &H290
        gch.Free
        'снова меняем длину буфера
        Array.Resize(buf, esz)
        'читаем Environment
        If Not NativeMethods.ReadProcessMemory(sph, env, buf, buf.Length, IntPtr.Zero) Then
          Throw New InvalidOperationException(GetLastError(0))
        End If
        For Each i As String In Encoding.Unicode.GetString(buf).Split(New Char(){Chr(0)})
          Console.WriteLine(i)
        Next
      Catch e As Exception
        Console.WriteLine(e.Message)
      Finally
        sph.Dispose 'освобождаем ресурсы
      End Try
    End Sub
  End Class
End Class

greg zakharov · 17.04.2020, 00:52

Небезопасный код в VB.NET Core (на примере вычисления энтропии Шеннона)

NET Core - боль, особенно для бывалых консольщиков. НО! Если в .NET Framework можно схлопотать леща в виде System.Security.VerificationException при создании динамического метода небезопасного (unsafe) кода, то NET Core в этом плане весьма либерален. Учитывая же, что поддержки unsafe в VB.NET нет и не предвиделось даже по мере развития .NET Framework, то NET Core в этом плане видится некоторым спасением. Хотя с какой стороны поглядеть... Ведь в VB.NET нет ни условной компиляции, ни макросов, ни прочих плюшек из мира приплюснутых Сей. Да и язык программирования в конечном счете не должен быть самоцелью, так как он лишь средство реализации идей. Правда иногда все же весьма любопытно просто поиграться с тем или иным ЯП.
От слов - к делу. Ниже пример вычисления энтропии файла (будет работать даже на больших файлах быстро). PoC был написан под NET Core, при попытке запустить код в .NET Framework получите леща описанного выше.

VB.NET
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
Imports System.IO
Imports System.Reflection
Imports System.Reflection.Emit
 
Friend NotInheritable Class Entropy
  'прототип нашей функции
  Friend Delegate Function GetEntropy(ByVal bytes As Byte()) As Double
 
  Shared Sub Main(ByVal args As String())
    If 1 <> args.Length Then
      Console.WriteLine("Синтаксис: {0} <файл>", _
           GetType(Entropy).Assembly.GetName.Name)
      Return
    End If
 
    Dim f_path As String 'полный путь до файла
    f_path = Path.GetFullPath(args(0))
    If Not File.Exists(f_path) Then
      Console.WriteLine( _
           "Внутреняя ошибка: файл не найден или не существует.")
      Return
    End If
 
    'файл найден, однако читать его не спешим, так как сперва
    'реализуем динамический метод для расчета энтропии
    Dim dm As New DynamicMethod("Entropy", GetType(Double), {GetType(Byte())})
    Dim il As ILGenerator = dm.GetILGenerator()
    'переменные; обратите внимание на типы переменых rng и pi
    Dim i   As LocalBuilder = il.DeclareLocal(GetType(Int32))
    Dim rng As LocalBuilder = il.DeclareLocal(Type.GetType("System.Int32*"))
    Dim pi  As LocalBuilder = il.DeclareLocal(Type.GetType("System.Int32*"))
    Dim ent As LocalBuilder = il.DeclareLocal(GetType(Double))
    Dim src As LocalBuilder = il.DeclareLocal(GetType(Double))
    'лейблы, всего четыре штуки
    Dim labels As Label() = New Label(3) {}
    For l As Int32 = 0 To labels.Length - 1
      labels(l) = il.DefineLabel
    Next
    'далее реализуется тело функции вычисления энтропии
    'если кому интересно за что отвечает тот или иной опкод, советую
    'обратиться за соответсвующей справкой
    il.Emit(OpCodes.ldc_i4, &H100)
    il.Emit(OpCodes.conv_u)
    il.Emit(OpCodes.ldc_i4_4)
    il.Emit(OpCodes.mul_ovf_un)
    il.Emit(OpCodes.localloc)
    il.Emit(OpCodes.stloc_1)
    il.Emit(OpCodes.ldloc_1)
    il.Emit(OpCodes.ldc_i4, &H400)
    il.Emit(OpCodes.conv_i)
    il.Emit(OpCodes.add)
    il.Emit(OpCodes.stloc_2)
    il.Emit(OpCodes.ldc_r8, 0.0)
    il.Emit(OpCodes.stloc_3)
    il.Emit(OpCodes.ldarg_0)
    il.Emit(OpCodes.ldlen)
    il.Emit(OpCodes.conv_i4)
    il.Emit(OpCodes.dup)
    il.Emit(OpCodes.stloc_0)
    il.Emit(OpCodes.conv_r8)
    il.Emit(OpCodes.stloc_s, src)
    il.Emit(OpCodes.br_s, labels(0))
    il.MarkLabel(labels(1))
    il.Emit(OpCodes.ldloc_1)
    il.Emit(OpCodes.ldarg_0)
    il.Emit(OpCodes.ldloc_0)
    il.Emit(OpCodes.ldelem_u1)
    il.Emit(OpCodes.conv_i)
    il.Emit(OpCodes.ldc_i4_4)
    il.Emit(OpCodes.mul)
    il.Emit(OpCodes.add)
    il.Emit(OpCodes.dup)
    il.Emit(OpCodes.ldind_i4)
    il.Emit(OpCodes.ldc_i4_1)
    il.Emit(OpCodes.add)
    il.Emit(OpCodes.stind_i4)
    il.MarkLabel(labels(0))
    il.Emit(OpCodes.ldloc_0)
    il.Emit(OpCodes.ldc_i4_1)
    il.Emit(OpCodes.sub)
    il.Emit(OpCodes.dup)
    il.Emit(OpCodes.stloc_0)
    il.Emit(OpCodes.ldc_i4_0)
    il.Emit(OpCodes.bge_s, labels(1))
    il.Emit(OpCodes.br_s, labels(2))
    il.MarkLabel(labels(3))
    il.Emit(OpCodes.ldloc_2)
    il.Emit(OpCodes.ldind_i4)
    il.Emit(OpCodes.ldc_i4_0)
    il.Emit(OpCodes.ble_s, labels(2))
    il.Emit(OpCodes.ldloc_3)
    il.Emit(OpCodes.ldloc_2)
    il.Emit(OpCodes.ldind_i4)
    il.Emit(OpCodes.conv_r8)
    il.Emit(OpCodes.ldloc_2)
    il.Emit(OpCodes.ldind_i4)
    il.Emit(OpCodes.conv_r8)
    il.Emit(OpCodes.ldloc_s, src)
    il.Emit(OpCodes.div)
    il.Emit(OpCodes.ldc_r8, 2.0R)
    il.Emit(OpCodes.call, GetType(Math).GetMethod( _
      "Log", New Type(){GetType(Double), GetType(Double)}))
    il.Emit(OpCodes.mul)
    il.Emit(OpCodes.add)
    il.Emit(OpCodes.stloc_3)
    il.MarkLabel(labels(2))
    il.Emit(OpCodes.ldloc_2)
    il.Emit(OpCodes.ldc_i4_4)
    il.Emit(OpCodes.conv_i)
    il.Emit(OpCodes.sub)
    il.Emit(OpCodes.dup)
    il.Emit(OpCodes.stloc_2)
    il.Emit(OpCodes.ldloc_1)
    il.Emit(OpCodes.bge_un_s, labels(3))
    il.Emit(OpCodes.ldloc_3)
    il.Emit(OpCodes.neg)
    il.Emit(OpCodes.ldloc_s, src)
    il.Emit(OpCodes.div)
    il.Emit(OpCodes.ret)
    'получаем делегата...
    Dim edg As GetEntropy = DirectCast( _
           dm.CreateDelegate(GetType(GetEntropy)), GetEntropy)
    '...и вызываем его
    Console.WriteLine("{0:F3}", edg(File.ReadAllBytes(f_path)))
  End Sub
End Class

greg zakharov · 30.04.2020, 21:30

Быстрый способ узнать доступна ли аппаратная виртуализация

Существует несколько способов узнать заявленное в заглавии, все они различаются по степени сложности своей реализации, а также позывом к рвоте у некоторых антивирусов. Первый - cpuid; требует машинных кодов и средств контрацепции от антивирусов, ибо у последних все чаще возникает околопоясничная боль в районе бедер при одном упомянании VirtualAlloc и иже с ним. Второй - IsProcessorFeaturePresent; антивирусы на оную функцию смотрят сквозь пальцы, однако есть способ быстрее и не требующий явных вызовов WinAPI. Ага, все та же структура KUSER_SHARED_DATA, конкретней - смещение 0x289, где хранится булево значение фичи PF_VIRT_FIRMWARE_ENABLED:

VB.NET
1
2
3
4
5
6
7
8
9
Imports System.Runtime.InteropServices
 
Module TestVirt
  Sub Main
    Console.WriteLine("PF_VIRT_FIRMWARE_ENABLED: {0}", _
      CType(Marshal.ReadByte(CType(&H7FFE0289, IntPtr)), Boolean)
    )
  End Sub
End Module

Вот такие ~~силиконовые сиськи~~ коврижки. Правда сама фича PF_VIRT_FIRMWARE_ENABLED была вроде введена как с Win8, так что...

greg zakharov · 18.05.2020, 23:01

Вывести список поставщиков учетных данных Windows

Если вы серьезно занимаетесь системным программированием, то обязаны знать о такой вещи как поставщики учетных данных (credential providers). Некоторые базовые сведения о них извлекаются из реестра.

VB.NET
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
Imports Microsoft.Win32
 
Class CredProv
  Shared Sub Main
    Using rk As RegistryKey = Registry.LocalMachine.OpenSubKey( _
      "SOFTWARE\Microsoft\Windows\CurrentVersion\Authentication\Credential Providers")
      If rk Is Nothing Then
        Console.WriteLine("Данные о провайдерах отсутствуют.")
        Return
      End If
      ' имена провайдеров можно получить и на предыдущем шаге, прогулявшись по сабкеям
      ' однако делать этого не нужно дабы не плодить лишних циклов
      For Each clsid As String In rk.GetSubKeyNames
        ' как несложно догадаться - имя и путь до DLL провайдера
        Dim [name] As RegistryKey = Nothing
        Dim [path] As RegistryKey = Nothing
        Try
          [name] = Registry.LocalMachine.OpenSubKey( _
            "SOFTWARE\Classes\CLSID\" + clsid)
          [path] = Registry.LocalMachine.OpenSubKey( _
            "SOFTWARE\Classes\CLSID\" + clsid + "\InProcServer32")
          Console.WriteLine( _
            "CLSID: {0}" + vbCrLf + "Имя  : {1}" + vbCrLf + "Путь : {2}" + vbCrLf, _
                clsid, [name].GetValue(""), [path].GetValue(""))
        Catch e As Exception
          Console.WriteLine(e.Message)
        Finally
          If Not [path] Is Nothing Then
            [path].Dispose
          End If
 
          If Not [name] Is Nothing Then
            [name].Dispose
          End If
        End Try
      Next
    End Using
  End Sub
End Class

greg zakharov · 22.05.2020, 18:53

Получить версию GNU/Linux

Не так давно, при разработке приложения под Ubuntu пришлось столкнуться с рядом странностей в плане получения версии ОС. Дело в том, что System.Environment.OSVersion в Mono возвращает версию не ОС как таковую, а ядра. Спрашивается, ~~какого хрена~~ неужели разработчикам было влом использовать вызов uname из libc.so.6? Однако, забегая наперед, могу сказать что и здесь нас поджидает облом на вираже. Чтобы стало понятней, давайте посмотрим на следующий код:

VB.NET
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Imports System.IO
Imports System.Linq
Imports System.Text
Imports System.Text.RegularExpressions
Imports System.Runtime.InteropServices
 
Module UbuntuVersion
  Declare Function uname Lib "libc.so.6" (ByVal buf As Byte()) As Int32
 
  Sub Main
    Dim buf As Byte() = New Byte(255) {}
    If 0 <> uname(buf) Then
      Console.WriteLine("Внутренняя ошибка.")
      Return
    End If
    ' конвертируем полученный буфер в строку, бъем на сегменты по нуль-терминатору
    Dim ver As String = CType(Encoding.ASCII.GetString(buf).Split( _
      New Char() {vbNullChar} _
    ).Where(Function(s) s.StartsWith("#")).Select( _
      Function(s) s.Split(New Char() {"~", "-"})(1))(0), String)
    Console.WriteLine("uname: {0}", ver)
    ' uname берет данные из version псевдофайловой системы proc
    Console.WriteLine("/proc/version: {0}", Regex.Match( _
      File.ReadAllLines("/proc/version")(0), "(?<=#\d+\~).*(?=\-)").Value)
    ' а теперь ход конем: /etc/lsb-release
   Console.WriteLine("/etc/lsb-release: {0}", CType( _
      File.ReadAllLines("/etc/lsb-release").Where(Function(s) s.StartsWith( _
          "DISTRIB_D")).Select(Function(s) s.Split(" ")(1))(0), String))
  End Sub
End Module

Согласен, выглядит не очень кошерно, но для описания сути проблемы сойдет. Итогом работы кода в моем случае будет:

Code
1
2
3
4
5
6
7
8
greg@greg:~
[11]$ mono app.exe
uname: 18.04.1
/proc/version: 18.04.1
/etc/lsb-release: 18.04.4
 
greg@greg:~
[12]$

~~Вот это поворот!~~
Суть, полагаю, ясна.

greg zakharov · 25.05.2020, 13:30

[Де]кодирование ROT13

В Windows XP значения раздела реестра UserAssists были зашифрованы посредством ROT13, однако, это далеко не единственный пример использования этого шифра. Помимо прочего ROT13 используется некоторыми пыхокодерами, мессенджерами (с солью), словом, несмотря на всю свою примитивность, алгоритм еще в строю (наряду с ROT47). При реализации ROT13 каким-то догматичным стал подход использования диапазонов значений латинского алфавита, что вовсе не означает его исключительность. Тем более (личное) такой подход кажется избыточным. Проще все сделать в вызове Regex.Replace.

VB.NET
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Imports System.Linq
Imports System.Text.RegularExpressions
 
Module Rot13
  Friend Function ConvertToRot13(ByVal s As String) As String
    Return Regex.Replace(s, "(?i:[a-z])", _
      Function(m)
        Return Convert.ToChar( _
          If(Convert.ToByte((m.Value.ToUpper)(0)) < 78, 13, -13 _
        ) + Convert.ToByte((m.Value)(0)))
      End Function
    )
  End Function
 
  Sub Main
    Console.Writeline(ConvertToRot13("Hello, World!"))
    Console.Writeline(ConvertToRot13("Uryyb, Jbeyq!"))
  End Sub
End Module

@Yury Komar · 31.05.2020, 17:01

Добавить возможность отбрасывать НАТИВНУЮ тень от формы при выставленном свойстве BorderStyle = None

В дизайнер формы Form.Designer.vb (так проще, не загромождая основной класс формы) добавьте следующий регион кода:

#Region " Form Shadow"

VB.NET
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
#Region "  Form Shadow"
    Private m_aeroEnabled = False
    Private Const CS_DROPSHADOW = &H20000
    Private Const WM_NCPAINT = &H85
    <System.Runtime.InteropServices.DllImport("dwmapi.dll")>
    Public Shared Function DwmExtendFrameIntoClientArea(ByVal hWnd As IntPtr, ByRef pMarInset As MARGINS) As Integer
    End Function
    <System.Runtime.InteropServices.DllImport("dwmapi.dll")>
    Public Shared Function DwmSetWindowAttribute(ByVal hwnd As IntPtr, ByVal attr As Integer, ByRef attrValue As Integer, ByVal attrSize As Integer) As Integer
    End Function
    <System.Runtime.InteropServices.DllImport("dwmapi.dll")>
    Public Shared Function DwmIsCompositionEnabled(ByRef pfEnabled As Integer) As Integer
    End Function
    Public Structure MARGINS
        Public leftWidth As Integer
        Public rightWidth As Integer
        Public topHeight As Integer
        Public bottomHeight As Integer
    End Structure
    Private Function CheckAeroEnabled() As Boolean
        If Environment.OSVersion.Version.Major >= 6 Then
            Dim enabled = 0
            DwmIsCompositionEnabled(enabled)
            Return If(enabled = 1, True, False)
        End If
 
        Return False
    End Function
    Protected Overrides ReadOnly Property CreateParams As CreateParams
        Get
            m_aeroEnabled = CheckAeroEnabled()
            Dim cp = MyBase.CreateParams
            If Not m_aeroEnabled Then cp.ClassStyle = cp.ClassStyle Or CS_DROPSHADOW
            Return cp
        End Get
    End Property
    Protected Overrides Sub WndProc(ByRef m As Message)
        Select Case m.Msg
            Case WM_NCPAINT
 
                If m_aeroEnabled Then
                    Dim v = 2
                    DwmSetWindowAttribute(Handle, 2, v, 4)
                    Dim margins As MARGINS = New MARGINS() With {
                        .bottomHeight = 1,
                        .leftWidth = 0,
                        .rightWidth = 0,
                        .topHeight = 0
                    }
                    DwmExtendFrameIntoClientArea(Handle, margins)
                End If
 
            Case Else
        End Select
 
        MyBase.WndProc(m)
    End Sub
#End Region

Ну и результат на картинке (тем самым можно делать свой дизайн формочки добавляя нативную тень)

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

А так можно добавить возможность отбрасывать ПРОСТУЮ тень без сглаживания при выставленном свойстве BorderStyle = None

VB.NET
1
2
3
4
5
6
7
8
    Protected Overrides ReadOnly Property CreateParams() As CreateParams
        Get
            Const DROPSHADOW As Integer = &H20000
            Dim myparam As CreateParams = MyBase.CreateParams
            myparam.ClassStyle = myparam.ClassStyle Or DROPSHADOW
            Return myparam
        End Get
    End Property

Результат

@HACKER KAY · 02.06.2020, 10:50

Стиль формы как в Windows 10 (стиль Microsoft Store)

Состоит из кастомных элементов, разрешается добавлять новые Border-контроллы и не только.

@HACKER KAY · 25.07.2020, 11:20

Кнопка из Windows 10

Я создал копию "фирменной кнопки Microsoft" операционной системы Windows 10 на VB NET. Вот что получилось:

VB.NET
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
Public Class Win10Button
    Inherits Button
    Public Sub New()
        Me.BackColor = System.Drawing.Color.Gainsboro
        Me.FlatAppearance.BorderColor = System.Drawing.Color.Gray
        Me.FlatAppearance.BorderSize = 0
        Me.FlatAppearance.MouseDownBackColor = System.Drawing.Color.Silver
        Me.FlatAppearance.MouseOverBackColor = System.Drawing.Color.FromArgb(CType(CType(224, Byte), Integer), CType(CType(224, Byte), Integer), CType(CType(224, Byte), Integer))
        Me.FlatStyle = System.Windows.Forms.FlatStyle.Flat
        Me.Font = New System.Drawing.Font("Consolas", 11.25!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(204, Byte))
        Me.Name = "Win10_Button"
        Me.Size = New System.Drawing.Size(177, 30)
        Me.TabIndex = 3
        Me.UseVisualStyleBackColor = False
    End Sub
    Sub shw() Handles Me.MouseEnter
        Me.FlatAppearance.BorderSize = 2
    End Sub
    Sub cls() Handles Me.MouseLeave
        Me.FlatAppearance.BorderSize = 0
    End Sub
    Sub fwq() Handles Me.MouseDown
        Dim perf = Me.Size.Width - 2
        Dim perd = Me.Size.Height - 2
        Me.Size = New System.Drawing.Size(perf, perd)
        Me.FlatAppearance.BorderSize = 0
    End Sub
    Sub wef() Handles Me.Click
        Me.FlatAppearance.BorderSize = 0
    End Sub
    Sub fwe() Handles Me.MouseUp
        Me.FlatAppearance.BorderSize = 1
        Dim perf = Me.Size.Width + 2
        Dim perd = Me.Size.Height + 2
        Me.Size = New System.Drawing.Size(perf, perd)
    End Sub
End Class

@ovva · 23.08.2020, 15:32

UserControl сходный по назначению с TabControl

На мой взгляд возможная замена TabControl. Реализовано:
• Добавление кнопок
• Удаление кнопок
• Перемещение кнопок
При желании можно перекомпоновать под собственные критерии прекрасного, например разместить коллекцию кнопок вертикально (справа или слева) и т.д.

@PAnT0P · 14.09.2020, 18:27

Экспорт DataGridView в форматы ExcelXML (без установленного офиса) или HTML, а так же печать таблицы используя компонент нативный WebBrowser.

ExcelXML (не Excel XLS/XLSX):

VB.NET
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
    ' Это формат Excel XML, расширение файла должно быть .xml
    Public Sub ExportExcelXml(ByVal Table As DataGridView, ByVal FileName As String)
        Dim Column As DataGridViewColumn
        Dim Row As DataGridViewRow
        Dim Cell As DataGridViewCell
        Dim Index As Integer = 1
        Try
            Dim ExcelSheet As New IO.StreamWriter(FileName, False)
            ExcelSheet.WriteLine("<?xml version='1.0'?>")
            ExcelSheet.WriteLine("<?mso-application progid='Excel.Sheet'?>")
            ExcelSheet.WriteLine("<Workbook xmlns='urn:schemas-microsoft-com:office:spreadsheet' xmlns:ss='urn:schemas-microsoft-com:office:spreadsheet'>")
            ExcelSheet.WriteLine(Space(2) & "<Styles>")
            ExcelSheet.WriteLine(Space(4) & "<Style ss:ID='Header'>")
            ExcelSheet.WriteLine(Space(6) & "<Font ss:Bold='1' />")
            ExcelSheet.WriteLine(Space(6) & "<Alignment ss:Horizontal='Center' ss:Vertical='Center' ss:WrapText='1' />")
            ExcelSheet.WriteLine(Space(6) & "<Borders>")
            ExcelSheet.WriteLine(Space(8) & "<Border ss:Position='Bottom' ss:LineStyle='Continuous' ss:Weight='1' />")
            ExcelSheet.WriteLine(Space(8) & "<Border ss:Position='Left' ss:LineStyle='Continuous' ss:Weight='1' />")
            ExcelSheet.WriteLine(Space(8) & "<Border ss:Position='Right' ss:LineStyle='Continuous' ss:Weight='1' />")
            ExcelSheet.WriteLine(Space(8) & "<Border ss:Position='Top' ss:LineStyle='Continuous' ss:Weight='1' />")
            ExcelSheet.WriteLine(Space(6) & "</Borders>")
            ExcelSheet.WriteLine(Space(4) & "</Style>")
            ExcelSheet.WriteLine(Space(4) & "<Style ss:ID='1'>")
            ExcelSheet.WriteLine(Space(6) & "<Alignment ss:Horizontal='Left' ss:Vertical='Top' ss:WrapText='1' />")
            ExcelSheet.WriteLine(Space(6) & "<Borders>")
            ExcelSheet.WriteLine(Space(8) & "<Border ss:Position='Bottom' ss:LineStyle='Continuous' ss:Weight='1' />")
            ExcelSheet.WriteLine(Space(8) & "<Border ss:Position='Left' ss:LineStyle='Continuous' ss:Weight='1' />")
            ExcelSheet.WriteLine(Space(8) & "<Border ss:Position='Right' ss:LineStyle='Continuous' ss:Weight='1' />")
            ExcelSheet.WriteLine(Space(8) & "<Border ss:Position='Top' ss:LineStyle='Continuous' ss:Weight='1' />")
            ExcelSheet.WriteLine(Space(6) & "</Borders>")
            ExcelSheet.WriteLine(Space(4) & "</Style>")
            ExcelSheet.WriteLine(Space(4) & "<Style ss:ID='2'>")
            ExcelSheet.WriteLine(Space(6) & "<Alignment ss:Horizontal='Center' ss:Vertical='Top' ss:WrapText='1' />")
            ExcelSheet.WriteLine(Space(6) & "<Borders>")
            ExcelSheet.WriteLine(Space(8) & "<Border ss:Position='Bottom' ss:LineStyle='Continuous' ss:Weight='1' />")
            ExcelSheet.WriteLine(Space(8) & "<Border ss:Position='Left' ss:LineStyle='Continuous' ss:Weight='1' />")
            ExcelSheet.WriteLine(Space(8) & "<Border ss:Position='Right' ss:LineStyle='Continuous' ss:Weight='1' />")
            ExcelSheet.WriteLine(Space(8) & "<Border ss:Position='Top' ss:LineStyle='Continuous' ss:Weight='1' />")
            ExcelSheet.WriteLine(Space(6) & "</Borders>")
            ExcelSheet.WriteLine(Space(4) & "</Style>")
            ExcelSheet.WriteLine(Space(4) & "<Style ss:ID='4'>")
            ExcelSheet.WriteLine(Space(6) & "<Alignment ss:Horizontal='Right' ss:Vertical='Top' ss:WrapText='0' />")
            ExcelSheet.WriteLine(Space(6) & "<Borders>")
            ExcelSheet.WriteLine(Space(8) & "<Border ss:Position='Bottom' ss:LineStyle='Continuous' ss:Weight='1' />")
            ExcelSheet.WriteLine(Space(8) & "<Border ss:Position='Left' ss:LineStyle='Continuous' ss:Weight='1' />")
            ExcelSheet.WriteLine(Space(8) & "<Border ss:Position='Right' ss:LineStyle='Continuous' ss:Weight='1' />")
            ExcelSheet.WriteLine(Space(8) & "<Border ss:Position='Top' ss:LineStyle='Continuous' ss:Weight='1' />")
            ExcelSheet.WriteLine(Space(6) & "</Borders>")
            ExcelSheet.WriteLine(Space(4) & "</Style>")
            ExcelSheet.WriteLine(Space(4) & "<Style ss:ID='16'>")
            ExcelSheet.WriteLine(Space(6) & "<Alignment ss:Horizontal='Left' ss:Vertical='Center' ss:WrapText='1' />")
            ExcelSheet.WriteLine(Space(6) & "<Borders>")
            ExcelSheet.WriteLine(Space(8) & "<Border ss:Position='Bottom' ss:LineStyle='Continuous' ss:Weight='1' />")
            ExcelSheet.WriteLine(Space(8) & "<Border ss:Position='Left' ss:LineStyle='Continuous' ss:Weight='1' />")
            ExcelSheet.WriteLine(Space(8) & "<Border ss:Position='Right' ss:LineStyle='Continuous' ss:Weight='1' />")
            ExcelSheet.WriteLine(Space(8) & "<Border ss:Position='Top' ss:LineStyle='Continuous' ss:Weight='1' />")
            ExcelSheet.WriteLine(Space(6) & "</Borders>")
            ExcelSheet.WriteLine(Space(4) & "</Style>")
            ExcelSheet.WriteLine(Space(4) & "<Style ss:ID='32'>")
            ExcelSheet.WriteLine(Space(6) & "<Alignment ss:Horizontal='Center' ss:Vertical='Center' ss:WrapText='1' />")
            ExcelSheet.WriteLine(Space(6) & "<Borders>")
            ExcelSheet.WriteLine(Space(8) & "<Border ss:Position='Bottom' ss:LineStyle='Continuous' ss:Weight='1' />")
            ExcelSheet.WriteLine(Space(8) & "<Border ss:Position='Left' ss:LineStyle='Continuous' ss:Weight='1' />")
            ExcelSheet.WriteLine(Space(8) & "<Border ss:Position='Right' ss:LineStyle='Continuous' ss:Weight='1' />")
            ExcelSheet.WriteLine(Space(8) & "<Border ss:Position='Top' ss:LineStyle='Continuous' ss:Weight='1' />")
            ExcelSheet.WriteLine(Space(6) & "</Borders>")
            ExcelSheet.WriteLine(Space(4) & "</Style>")
            ExcelSheet.WriteLine(Space(4) & "<Style ss:ID='64'>")
            ExcelSheet.WriteLine(Space(6) & "<Alignment ss:Horizontal='Right' ss:Vertical='Center' ss:WrapText='0' />")
            ExcelSheet.WriteLine(Space(6) & "<Borders>")
            ExcelSheet.WriteLine(Space(8) & "<Border ss:Position='Bottom' ss:LineStyle='Continuous' ss:Weight='1' />")
            ExcelSheet.WriteLine(Space(8) & "<Border ss:Position='Left' ss:LineStyle='Continuous' ss:Weight='1' />")
            ExcelSheet.WriteLine(Space(8) & "<Border ss:Position='Right' ss:LineStyle='Continuous' ss:Weight='1' />")
            ExcelSheet.WriteLine(Space(8) & "<Border ss:Position='Top' ss:LineStyle='Continuous' ss:Weight='1' />")
            ExcelSheet.WriteLine(Space(6) & "</Borders>")
            ExcelSheet.WriteLine(Space(4) & "</Style>")
            ExcelSheet.WriteLine(Space(4) & "<Style ss:ID='256'>")
            ExcelSheet.WriteLine(Space(6) & "<Alignment ss:Horizontal='Left' ss:Vertical='Bottom' ss:WrapText='1' />")
            ExcelSheet.WriteLine(Space(6) & "<Borders>")
            ExcelSheet.WriteLine(Space(8) & "<Border ss:Position='Bottom' ss:LineStyle='Continuous' ss:Weight='1' />")
            ExcelSheet.WriteLine(Space(8) & "<Border ss:Position='Left' ss:LineStyle='Continuous' ss:Weight='1' />")
            ExcelSheet.WriteLine(Space(8) & "<Border ss:Position='Right' ss:LineStyle='Continuous' ss:Weight='1' />")
            ExcelSheet.WriteLine(Space(8) & "<Border ss:Position='Top' ss:LineStyle='Continuous' ss:Weight='1' />")
            ExcelSheet.WriteLine(Space(6) & "</Borders>")
            ExcelSheet.WriteLine(Space(4) & "</Style>")
            ExcelSheet.WriteLine(Space(4) & "<Style ss:ID='512'>")
            ExcelSheet.WriteLine(Space(6) & "<Alignment ss:Horizontal='Center' ss:Vertical='Bottom' ss:WrapText='1' />")
            ExcelSheet.WriteLine(Space(6) & "<Borders>")
            ExcelSheet.WriteLine(Space(8) & "<Border ss:Position='Bottom' ss:LineStyle='Continuous' ss:Weight='1' />")
            ExcelSheet.WriteLine(Space(8) & "<Border ss:Position='Left' ss:LineStyle='Continuous' ss:Weight='1' />")
            ExcelSheet.WriteLine(Space(8) & "<Border ss:Position='Right' ss:LineStyle='Continuous' ss:Weight='1' />")
            ExcelSheet.WriteLine(Space(8) & "<Border ss:Position='Top' ss:LineStyle='Continuous' ss:Weight='1' />")
            ExcelSheet.WriteLine(Space(6) & "</Borders>")
            ExcelSheet.WriteLine(Space(4) & "</Style>")
            ExcelSheet.WriteLine(Space(4) & "<Style ss:ID='1024'>")
            ExcelSheet.WriteLine(Space(6) & "<Alignment ss:Horizontal='Right' ss:Vertical='Bottom' ss:WrapText='0' />")
            ExcelSheet.WriteLine(Space(6) & "<Borders>")
            ExcelSheet.WriteLine(Space(8) & "<Border ss:Position='Bottom' ss:LineStyle='Continuous' ss:Weight='1' />")
            ExcelSheet.WriteLine(Space(8) & "<Border ss:Position='Left' ss:LineStyle='Continuous' ss:Weight='1' />")
            ExcelSheet.WriteLine(Space(8) & "<Border ss:Position='Right' ss:LineStyle='Continuous' ss:Weight='1' />")
            ExcelSheet.WriteLine(Space(8) & "<Border ss:Position='Top' ss:LineStyle='Continuous' ss:Weight='1' />")
            ExcelSheet.WriteLine(Space(6) & "</Borders>")
            ExcelSheet.WriteLine(Space(4) & "</Style>")
            ExcelSheet.WriteLine(Space(2) & "</Styles>")
            ExcelSheet.WriteLine(Space(2) & "<Worksheet ss:Name='Sheet1'>")
            ExcelSheet.WriteLine(Space(4) & "<Table>")
            ' Ширина столбцов
            For Each Column In Table.Columns
                If Column.Visible Then
                    ExcelSheet.WriteLine(Space(6) & "<Column ss:Width='" & Column.Width & "' />")
                End If
            Next
            ' пустая строка
            ExcelSheet.WriteLine(Space(6) & "<Row />")
            ' Заголовок таблицы
            ExcelSheet.WriteLine(Space(6) & "<Row>")
            ExcelSheet.WriteLine(Space(8) & "<Cell>")
            ExcelSheet.WriteLine(Space(10) & "<Data ss:Type='String'>1 строка заголовка</Data>")
            ExcelSheet.WriteLine(Space(8) & "</Cell>")
            ExcelSheet.WriteLine(Space(6) & "</Row>")
            ExcelSheet.WriteLine(Space(6) & "<Row>")
            ExcelSheet.WriteLine(Space(8) & "<Cell>")
            ExcelSheet.WriteLine(Space(10) & "<Data ss:Type='String'>2 строка заголовка</Data>")
            ExcelSheet.WriteLine(Space(8) & "</Cell>")
            ExcelSheet.WriteLine(Space(6) & "</Row>")
            ' пустая строка
            ExcelSheet.WriteLine(Space(6) & "<Row />")
            ' Шапка таблицы
            ExcelSheet.WriteLine(Space(6) & "<Row ss:Height='" & Table.ColumnHeadersHeight & "'>")
            For Each Column In Table.Columns
                If Column.Visible Then
                    ExcelSheet.WriteLine(Space(8) & "<Cell ss:StyleID='Header'>")
                    ExcelSheet.WriteLine(Space(10) & "<Data ss:Type='String'>" & Column.HeaderText & "</Data>")
                    ExcelSheet.WriteLine(Space(8) & "</Cell>")
                End If
            Next
            ExcelSheet.WriteLine(Space(6) & "</Row>")
            ExcelSheet.WriteLine(Space(6) & "<Row>")
            ' Нумерация столбцов
            For Each Column In Table.Columns
                If Column.Visible Then
                    ExcelSheet.WriteLine(Space(8) & "<Cell ss:StyleID='Header'>")
                    ExcelSheet.WriteLine(Space(10) & "<Data ss:Type='String'>" & Index & "</Data>")
                    ExcelSheet.WriteLine(Space(8) & "</Cell>")
                    Index = Index + 1
                End If
            Next
            ExcelSheet.WriteLine(Space(6) & "</Row>")
            ' Строки данных
            For Each Row In Table.Rows
                ExcelSheet.WriteLine(Space(6) & "<Row ss:Height='" & Row.Height & "'>")
                ' Ячейки данных
                For Each Cell In Row.Cells
                    If Cell.Visible Then
                        ' Установка стиля ячейки по стилю столбца
                        ExcelSheet.WriteLine(Space(8) & "<Cell ss:StyleID='" & Table.Columns(Cell.ColumnIndex).DefaultCellStyle.Alignment & "'>")
                        ' Запись данных в ячейку
                        ExcelSheet.WriteLine(Space(10) & "<Data ss:Type='String'>" & Cell.Value & "</Data>")
                        ExcelSheet.WriteLine(Space(8) & "</Cell>")
                    End If
                Next
                ExcelSheet.WriteLine(Space(6) & "</Row>")
                '=== Отображение прогресса сохранения ===
                'Call frmMain.ShowProgress(Row.Index + 1, Table.RowCount)
                '========================================
            Next
            ExcelSheet.WriteLine(Space(4) & "</Table>")
            ExcelSheet.WriteLine(Space(2) & "</Worksheet>")
            ExcelSheet.WriteLine("</Workbook>")
            ExcelSheet.Close()
        Catch ex As Exception
            Call MsgBox("Файл заблокирован другой программой!", MsgBoxStyle.Exclamation + vbOKOnly, "Ошибка записи!")
        End Try
    End Sub

Вэб документ:

VB.NET
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
    Public Sub ExportHtml(ByVal Table As DataGridView, ByVal FileName As String)
        Dim Column As DataGridViewColumn
        Dim Row As DataGridViewRow
        Dim Cell As DataGridViewCell
        Dim Index As Integer = 1
        Try
            Dim wbDocument As New IO.StreamWriter(FileName, False)
            wbDocument.WriteLine("<html>")
            wbDocument.WriteLine(Space(2) & "<head>")
            wbDocument.WriteLine(Space(4) & "<title>" & Application.ProductName & "</title>")
            wbDocument.WriteLine(Space(4) & "<meta http-equiv='content-type' content='text/html; charset=utf-8' />")
            wbDocument.WriteLine(Space(4) & "<style type='text/css'>")
            wbDocument.WriteLine(Space(6) & "table {")
            wbDocument.WriteLine(Space(8) & "border-collapse: collapse;")
            wbDocument.WriteLine(Space(8) & "border: 2px solid black;")
            wbDocument.WriteLine(Space(6) & "}")
            wbDocument.WriteLine(Space(6) & "th {")
            wbDocument.WriteLine(Space(8) & "border: 1px solid black;")
            wbDocument.WriteLine(Space(6) & "}")
            wbDocument.WriteLine(Space(6) & "td {")
            wbDocument.WriteLine(Space(8) & "border-collapse: collapse;")
            wbDocument.WriteLine(Space(8) & "border: 1px solid black;")
            wbDocument.WriteLine(Space(6) & "}")
            wbDocument.WriteLine(Space(6) & ".Id1 {")
            wbDocument.WriteLine(Space(8) & "height: 10px;")
            wbDocument.WriteLine(Space(8) & "Vertical-align: top;")
            wbDocument.WriteLine(Space(8) & "text-align: left;")
            wbDocument.WriteLine(Space(6) & "}")
            wbDocument.WriteLine(Space(6) & ".Id2 {")
            wbDocument.WriteLine(Space(8) & "height: 10px;")
            wbDocument.WriteLine(Space(8) & "Vertical-align: top;")
            wbDocument.WriteLine(Space(8) & "text-align: center;")
            wbDocument.WriteLine(Space(6) & "}")
            wbDocument.WriteLine(Space(6) & ".Id4 {")
            wbDocument.WriteLine(Space(8) & "height: 10px;")
            wbDocument.WriteLine(Space(8) & "Vertical-align: top;")
            wbDocument.WriteLine(Space(8) & "text-align: right;")
            wbDocument.WriteLine(Space(6) & "}")
            wbDocument.WriteLine(Space(6) & ".Id16 {")
            wbDocument.WriteLine(Space(8) & "height: 10px;")
            wbDocument.WriteLine(Space(8) & "Vertical-align: center;")
            wbDocument.WriteLine(Space(8) & "text-align: left;")
            wbDocument.WriteLine(Space(6) & "}")
            wbDocument.WriteLine(Space(6) & ".Id32 {")
            wbDocument.WriteLine(Space(8) & "height: 10px;")
            wbDocument.WriteLine(Space(8) & "Vertical-align: center;")
            wbDocument.WriteLine(Space(8) & "text-align: center;")
            wbDocument.WriteLine(Space(6) & "}")
            wbDocument.WriteLine(Space(6) & ".Id64 {")
            wbDocument.WriteLine(Space(8) & "height: 10px;")
            wbDocument.WriteLine(Space(8) & "Vertical-align: center;")
            wbDocument.WriteLine(Space(8) & "text-align: right;")
            wbDocument.WriteLine(Space(6) & "}")
            wbDocument.WriteLine(Space(6) & ".Id256 {")
            wbDocument.WriteLine(Space(8) & "height: 10px;")
            wbDocument.WriteLine(Space(8) & "Vertical-align: bottom;")
            wbDocument.WriteLine(Space(8) & "text-align: left;")
            wbDocument.WriteLine(Space(6) & "}")
            wbDocument.WriteLine(Space(6) & ".Id512 {")
            wbDocument.WriteLine(Space(8) & "height: 10px;")
            wbDocument.WriteLine(Space(8) & "Vertical-align: bottom;")
            wbDocument.WriteLine(Space(8) & "text-align: center;")
            wbDocument.WriteLine(Space(6) & "}")
            wbDocument.WriteLine(Space(6) & ".Id1024 {")
            wbDocument.WriteLine(Space(8) & "height: 10px;")
            wbDocument.WriteLine(Space(8) & "Vertical-align: bottom;")
            wbDocument.WriteLine(Space(8) & "text-align: right;")
            wbDocument.WriteLine(Space(6) & "}")
            wbDocument.WriteLine(Space(4) & "</style>")
            wbDocument.WriteLine(Space(2) & "</head>")
            wbDocument.WriteLine(Space(2) & "<body>")
            wbDocument.WriteLine(Space(4) & "<table cellspacing='0' align='center'>")
            wbDocument.WriteLine(Space(6) & "<caption>")
            wbDocument.WriteLine(Space(8) & "1 строка заголовка<br>")
            wbDocument.WriteLine(Space(8) & "2 строка заголовка<br>")
            wbDocument.WriteLine(Space(6) & "</caption>")
            wbDocument.WriteLine(Space(6) & "<tr>")
            For Each Column In Table.Columns
                If Column.Visible Then
                    wbDocument.WriteLine(Space(8) & "<th align='center'>" & Column.HeaderText & "</th>")
                End If
            Next
            wbDocument.WriteLine(Space(6) & "</tr>")
            wbDocument.WriteLine(Space(6) & "<tr>")
            For Each Column In Table.Columns
                If Column.Visible Then
                    wbDocument.WriteLine(Space(8) & "<th align='center'>" & Index & "</th>")
                    Index = Index + 1
                End If
            Next
            wbDocument.WriteLine(Space(6) & "</tr>")
            For Each Row In Table.Rows
                wbDocument.WriteLine(Space(6) & "<tr>")
                For Each Cell In Row.Cells
                    If Cell.Visible Then
                        wbDocument.WriteLine(Space(8) & "<td class='Id" & Table.Columns(Cell.ColumnIndex).DefaultCellStyle.Alignment & "'>" & IIf(Cell.Value.ToString.Length > 0, Cell.Value, "&nbsp") & "</td>")
                    End If
                Next
                wbDocument.WriteLine(Space(6) & "</tr>")
                '=== Отображение прогресса сохранения ===
                ' Call frmMain.ShowProgress(Row.Index + 1, Table.RowCount)
                '========================================
            Next
            wbDocument.WriteLine(Space(4) & "</table>")
            wbDocument.WriteLine(Space(2) & "</body>")
            wbDocument.WriteLine("</html>")
            wbDocument.Close()
        Catch ex As Exception
            Call MsgBox("Файл заблокирован другой программой!", MsgBoxStyle.Exclamation + vbOKOnly, "Ошибка записи!")
        End Try
    End Sub

Или на печать:

VB.NET
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
    Public Sub Print(ByVal Table As DataGridView)
        Dim wbPreview As New WebBrowser
        Dim wbDocument As HtmlDocument
        Dim Column As DataGridViewColumn
        Dim Row As DataGridViewRow
        Dim Cell As DataGridViewCell
        Dim Index As Integer = 1
        wbPreview.Navigate("About:blank")
        wbDocument = wbPreview.Document.OpenNew(True)
        wbDocument.Write("<html>")
        wbDocument.Write("<head>")
        wbDocument.Write("<title>" & Application.ProductName & "</title>")
        wbDocument.Write("<meta http-equiv='content-type' content='text/html; charset=utf-8' />")
        wbDocument.Write("<style type='text/css'>")
        wbDocument.Write("table {")
        wbDocument.Write("border-collapse: collapse;")
        wbDocument.Write("border: 2px solid black;")
        wbDocument.Write("}")
        wbDocument.Write("th {")
        wbDocument.Write("border: 1px solid black;")
        wbDocument.Write("}")
        wbDocument.Write("td {")
        wbDocument.Write("border-collapse: collapse;")
        wbDocument.Write("border: 1px solid black;")
        wbDocument.Write("}")
        wbDocument.Write(".Id1 {")
        wbDocument.Write("height: 10px;")
        wbDocument.Write("Vertical-align: top;")
        wbDocument.Write("text-align: left;")
        wbDocument.Write("}")
        wbDocument.Write(".Id2 {")
        wbDocument.Write("height: 10px;")
        wbDocument.Write("Vertical-align: top;")
        wbDocument.Write("text-align: center;")
        wbDocument.Write("}")
        wbDocument.Write(".Id4 {")
        wbDocument.Write("height: 10px;")
        wbDocument.Write("Vertical-align: top;")
        wbDocument.Write("text-align: right;")
        wbDocument.Write("}")
        wbDocument.Write(".Id16 {")
        wbDocument.Write("height: 10px;")
        wbDocument.Write("Vertical-align: center;")
        wbDocument.Write("text-align: left;")
        wbDocument.Write("}")
        wbDocument.Write(".Id32 {")
        wbDocument.Write("height: 10px;")
        wbDocument.Write("Vertical-align: center;")
        wbDocument.Write("text-align: center;")
        wbDocument.Write("}")
        wbDocument.Write(".Id64 {")
        wbDocument.Write("height: 10px;")
        wbDocument.Write("Vertical-align: center;")
        wbDocument.Write("text-align: right;")
        wbDocument.Write("}")
        wbDocument.Write(".Id256 {")
        wbDocument.Write("height: 10px;")
        wbDocument.Write("Vertical-align: bottom;")
        wbDocument.Write("text-align: left;")
        wbDocument.Write("}")
        wbDocument.Write(".Id512 {")
        wbDocument.Write("height: 10px;")
        wbDocument.Write("Vertical-align: bottom;")
        wbDocument.Write("text-align: center;")
        wbDocument.Write("}")
        wbDocument.Write(".Id1024 {")
        wbDocument.Write("height: 10px;")
        wbDocument.Write("Vertical-align: bottom;")
        wbDocument.Write("text-align: right;")
        wbDocument.Write("}")
        wbDocument.Write("</style>")
        wbDocument.Write("</head>")
        wbDocument.Write("<body>")
        wbDocument.Write("<table cellspacing='0' align='center'>")
        wbDocument.Write("<caption>")
        wbDocument.Write("1 строка заголовка таблицы<br>")
        wbDocument.Write("2 строка заголовка таблицы<br>")
        wbDocument.Write("</caption>")
        wbDocument.Write("<tr>")
        For Each Column In Table.Columns
            If Column.Visible Then
                wbDocument.Write("<th align='center'>" & Column.HeaderText & "</th>")
            End If
        Next
        wbDocument.Write("</tr>")
        wbDocument.Write("<tr>")
        For Each Column In Table.Columns
            If Column.Visible Then
                wbDocument.Write("<th align='center'>" & Index & "</th>")
                Index = Index + 1
            End If
        Next
        wbDocument.Write("</tr>")
        For Each Row In Table.Rows
            wbDocument.Write("<tr>")
            For Each Cell In Row.Cells
                If Cell.Visible Then
                    wbDocument.Write("<td class='Id" & Table.Columns(Cell.ColumnIndex).DefaultCellStyle.Alignment & "'>" & IIf(Cell.Value.ToString.Length > 0, Cell.Value, "&nbsp") & "</td>")
                End If
            Next
            wbDocument.Write("</tr>")
            '=== Отображение прогресса сохранения ===
            ' Call frmMain.ShowProgress(Row.Index + 1, Table.RowCount)
            '========================================
        Next
        wbDocument.Write("</table>")
        wbDocument.Write("</body>")
        wbDocument.Write("</html>")
        wbPreview.Parent = Table.Parent
        wbPreview.ShowPrintPreviewDialog()
    End Sub

@Yury Komar · 06.11.2020, 13:46

Галерея элементов на основе FlowLayoutPanel

VB.NET
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
 Public Class Form1
    Private Sub BtnClick(sender As Object, e As EventArgs)
        If MsgBox($"Удалить {sender.Name}?", MsgBoxStyle.YesNo) = MsgBoxResult.Yes Then
            FlowLayoutPanel1.Controls.Remove(sender)
        End If
    End Sub
 
    Private Sub Add_Click(sender As Object, e As EventArgs) Handles btnAddNEwPanel.Click
        Dim Btn As New Panel With {.Name = "Panel" & FlowLayoutPanel1.Controls.Count, .BackColor = Color.Red, .Height = 70, .Width = 50}
        AddHandler Btn.Click, AddressOf BtnClick
        FlowLayoutPanel1.Controls.Add(Btn)
        FlowLayoutPanel1.Controls.Add(sender)
        FlowLayoutPanel1.Refresh()
    End Sub
End Class

Название: GIFKA 12.gif
Просмотров: 1911

Размер: 1.03 Мб

@Yury Komar · 06.01.2021, 12:48

Вариант получения результата запроса в базу данных и вывода полученных данных без использования DataAdapter'a.. Так же, будет выдано исключение, если в качестве имени таблицы было передано что-то иное.
Можно так же дополнить код проверкой на наличие самой таблицы в базе данных.

VB.NET
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Public Function GetDataTable(table As String) As DataTable
    If Not table.IsTableName() Then
        Throw New ArgumentException("Must be valid SQL identifier", NameOf(table))
    End If
    
    Dim query As String = "SELECT * FROM " & table
    Using sqlConn As New SqlConnection(conSTR)
        Using cmd As New SqlCommand(query, sqlConn)
            sqlConn.Open()
            Dim DT As New DataTable()
            Using dataReader As SqlDataReader = cmd.ExecuteReader()
                DT.Load(dataReader)
            End Using
            Return DT
        End Using
    End Using
End Function

Вспомогательная фунция как Extension, для проверки ралидности переданного имени таблицы:

VB.NET
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Public Module StringExtensions
 
    Private Const REGEX_ID As String = "^(?:\w+|\[\w[\w ]{0,}\])$"
 
    Private Function IsId(s As String)
        Return Regex.IsMatch(s, REGEX_ID)
    End Function
 
    <Extension()>
    Public Function IsTableName(s As String) As Boolean
        Dim dotIdx As Integer = s.IndexOf("."c)
        If dotIdx = -1 Then Return IsId(s)
 
        Return IsId(s.Substring(0, dotIdx)) _
            AndAlso IsId(s.Substring(dotIdx+1))
    End Function
 
End Module

@Yury Komar · 12.01.2021, 19:36

Запретить своей форме принимать и держать фокус. Полезно при написании виртуальной клавиатуры или же в других моментах, когда активирование своего окна очень нежелательно

Для работы кода нужно задекларировать две WinAPI: SetWindowLong и GetWindowLong. Как это сделать, кто не знает, в сети много примеров.

VB.NET
1
2
3
4
5
6
7
8
9
    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        RemoveWindowFocus()
    End Sub
    Private Sub Form1_Activated(sender As Object, e As EventArgs) Handles Me.Activated
        RemoveWindowFocus()
    End Sub
    Private Sub RemoveWindowFocus()
        SetWindowLong(Me.Handle, -20, GetWindowLong(Me.Handle, -20) Or &H8000000)
    End Sub

Единственное, что заметил, то что при сворачивании окна и затем разворачивании, фокус возвращается, но стоит форме потерять фокус снова - больше не вернется до следующего свернуть\развернуть.

@Sklifosofsky · 12.01.2021, 21:41

Обертка методов FlashWindow, FlashWindowEx из user32.dll
В зависимости от переданных параметров заставляет мерцать окно и/или кнопки на панели задач для привлечения внимания пользователя

Код (параметры подписаны)

Кликните здесь для просмотра всего текста

VB.NET
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
Imports System.Runtime.InteropServices
 
Public NotInheritable Class Tools
    Public Enum FlashWInfoFlags As UInt32
        ''' <summary>
        ''' Остановить мерцание формы. Сброс на системные установки окна
        ''' </summary>
        ''' <remarks></remarks>
        FLASHW_STOP = &H0
        ''' <summary>
        ''' Мерцание заголовка
        ''' </summary>
        ''' <remarks></remarks>
        FLASHW_CAPTION = &H1
        ''' <summary>
        ''' Мерцание кнопки на панели задач
        ''' </summary>
        ''' <remarks></remarks>
        FLASHW_TRAY = &H2
        ''' <summary>
        ''' Мерцание заголовка окна и кнопки на панели задач. (Равносильно комбинации параметров FLASHW_CAPTION Or FLASHW_TRAY)
        ''' </summary>
        ''' <remarks></remarks>
        FLASHW_ALL = FLASHW_CAPTION Or FLASHW_TRAY
        ''' <summary>
        ''' Непрерывное мерцание, пока не будет передан параметр FLASHW_STOP. Количество мерцаний (Count) должно быть равным 0
        ''' </summary>
        ''' <remarks></remarks>
        FLASHW_TIMER = &H4
        ''' <summary>
        ''' Непрерывное мерцание пока форма находится не в фокусе. Количество мерцаний (Count) должно быть равным 0
        ''' </summary>
        ''' <remarks></remarks>
        FLASHW_TIMERNOFG = &HC
    End Enum
 
    Private NotInheritable Class NativeMethods
 
        Protected Sub New()
        End Sub
 
        ''' <summary>
        ''' Структура для передачи свойств в FlashWindowEx
        ''' </summary>
        ''' <remarks></remarks>
        <System.Runtime.InteropServices.StructLayout(Runtime.InteropServices.LayoutKind.Sequential)>
        Public Structure FLASHWINFO
            ''' <summary>
            ''' Размер структуры
            ''' </summary>
            ''' <remarks>CUInt(Marshal.SizeOf(GetType(FLASHWINFO)))</remarks>
            Public cbSize As UInt32
            ''' <summary>
            ''' Указатель окна
            ''' </summary>
            ''' <remarks></remarks>
            Public hWnd As IntPtr
            ''' <summary>
            ''' Параметры
            ''' </summary>
            ''' <remarks></remarks>
            Public dwFlags As FlashWInfoFlags
            ''' <summary>
            ''' Количество мерцаний
            ''' </summary>
            ''' <remarks></remarks>
            Public uCount As UInt32
            ''' <summary>
            ''' Интервал мерцания
            ''' </summary>
            ''' <remarks></remarks>
            Public dwTimeout As UInt32
        End Structure
 
        Public Declare Auto Function FlashWindow Lib "User32.dll" (ByVal hWnd As IntPtr, <MarshalAs(UnmanagedType.Bool)> ByVal bInvert As Boolean) As Boolean
        Public Declare Auto Function FlashWindowEx Lib "User32.dll" (ByRef pwfi As FLASHWINFO) As Boolean
 
    End Class
 
    ''' <summary>
    ''' Мерцание окна 
    ''' </summary>
    ''' <param name="hWnd">Указатель на окно</param>
    ''' <param name="Inverted">Если параметр true, то окно и кнопка в панели задач будет мерцать один раз. 
    ''' Если false, то мерцание не производится. При этом если окно не активно, то по завершении операции, 
    ''' кнопка в панели задач будет подсвечена до активации окна</param>
    ''' <returns>Возвращает true при успешной операции</returns>
    ''' <remarks></remarks>
    Public Shared Function FlashWindow(ByVal hWnd As IntPtr, ByVal Inverted As Boolean) As Boolean
        Try
            Return NativeMethods.FlashWindow(hWnd, Inverted)
        Catch
            Return False
        End Try
    End Function
 
    ''' <summary>
    ''' Мерцание окна (Расширенное)
    ''' </summary>
    ''' <param name="hWnd">Указатель окна</param>
    ''' <param name="Flags">Параметры (Комбинируемые флаги)</param>
    ''' <param name="Count">Количество мерцаний</param>
    ''' <param name="Timeout">Интервал мерцания (мс). Если параметр равен 0, то будет использоваться интервал по умолчанию</param>
    ''' <returns>Возвращает true при успешной операции</returns>
    ''' <remarks></remarks>
    Public Shared Function FlashWindowEx(ByVal hWnd As IntPtr, ByVal Flags As FlashWInfoFlags, ByVal Count As Int32, ByVal Timeout As Int32) As Boolean
        If Count < 0 Or Timeout < 0 Then Return False
 
        Dim pwfi As New NativeMethods.FLASHWINFO()
        pwfi.cbSize = CUInt(Marshal.SizeOf(pwfi))
        pwfi.hWnd = hWnd
        pwfi.dwFlags = Flags
        pwfi.uCount = CUInt(Count)
        pwfi.dwTimeout = CUInt(Timeout)
        Try
            Return NativeMethods.FlashWindowEx(pwfi)
        Catch
            Return False
        End Try
    End Function
End Class

Примеры использования

Для WinForms

VB.NET
1
        Tools.FlashWindowEx([Form].Handle, Tools.FlashWInfoFlags.FLASHW_ALL, 10, 0)

Для WPF

VB.NET
1
        Tools.FlashWindowEx(New System.Windows.Interop.WindowInteropHelper([Window]).Handle, Tools.FlashWInfoFlags.FLASHW_ALL, 10, 0)

@HACKER KAY · 09.02.2021, 16:48

Вбиваем запрос в интернете, используя браузер по умолчанию

Сам код:

VB.NET
1
2
3
4
5
6
7
8
9
10
11
12
13
14
Imports System
Imports System.Text
Imports System.Web
 
    Public Sub SearchWithInternet(Site, Text)
        Dim Search As String = Nothing
        Dim SearchUrlText = HttpUtility.UrlEncode(Text)
        Try
            Search = Replace(Site, "%s", SearchUrlText)
            Process.Start(Search)
        Catch ex As Exception
            MsgBox(ex.Message, 16)
        End Try
    End Sub

Использование:

VB.NET
1
2
'Строку поиска обозначаем как %s (сюда будет вбиваться отформатированный запрос в виде текста)
SearchWithInternet("https://www.поисковик.com/search?q=%s", "Пример запроса")

Вот парочка примеров:

VB.NET
1
2
3
4
SearchWithInternet("https://www.google.com/search?q=%s", "Пример запроса в Гугле из VB.NET!")
SearchWithInternet("https://www.yandex.com/search/?text=%s", "Пример запроса в Яндексе из VB.NET!")
SearchWithInternet("https://www.bing.com/search?q=%s", "Пример запроса в Бинг из VB.NET!")
SearchWithInternet("https://www.duckduckgo.com/?q=%s", "Пример запроса в ДакДакГоу из VB.NET!")

Внимание! Если пишет, что HttpUtility не найден, то просто добавьте ссылку System.Web в свойствах проекта.

Очень надеюсь, что кому-нибудь да пригодится. Код написан для CyberForum.

@HACKER KAY · 10.02.2021, 22:25

Решение линейных математических выражений

VB.NET
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Imports System.CodeDom.Compiler
Imports System.Reflection
 
Public Function Решить(ByVal выражение As String) As String
        Try
            Dim myCode As CodeDomProvider = CodeDomProvider.CreateProvider("VB")
            Dim myPar As New CompilerParameters()
            'формируем виртуальный класс, в котором будет производиться расчет
            Dim myCodeBody As New System.Text.StringBuilder()
            myCodeBody.AppendLine("Public Class MyCalculator")
            myCodeBody.AppendLine("Public Function Calc() As Double")
            '.Replace(«,», «.») — меняем запятые на точки, т.к. в VB в качестве десятичного разделителя используются точки
            myCodeBody.AppendLine(String.Format("Return {0}", выражение))
           myCodeBody.AppendLine("End Function")
            myCodeBody.AppendLine("End Class")
            'компилируем
            Dim myResult As CompilerResults = myCode.CompileAssemblyFromSource(myPar, myCodeBody.ToString())
            If myResult.Errors.HasErrors Then
                'какие-то ошибки
                For i As Integer = 0 To myResult.Errors.Count - 1
                    If myResult.Errors(i).ErrorText = "Ожидалось выражение." Then
                        MsgBox(myResult.Errors(i).ErrorText, MsgBoxStyle.Critical, "Ошибка")
                    End If
                Next
            Return "Ошибка!"
        End If
        'Если ошибок нет, выдергиваем наш класс
        Dim myAsm As Assembly = myResult.CompiledAssembly()
        Dim myCls As Object = myAsm.CreateInstance("MyCalculator", True)
        'Результат
        Return myCls.Calc().ToString
    Catch ex As Exception
        MsgBox(ex.Message)
    End Try
    End Function
End Class

Использование:

VB.NET
1
MsgBox(Решить(TextBox1.Text)) 'на форме TextBox1 для записи примера

@HACKER KAY · 12.02.2021, 11:55

Держим дисплей (монитор) выключенным, пока пользователь не взаимодействует с компьютером

VB.NET
1
2
3
4
5
Dim DisplayOff As New Process
        DisplayOff.StartInfo.FileName = "cmd.exe"
        DisplayOff.StartInfo.Arguments = "/c ""@PowerShell (Add-Type '[DllImport(\""user32.dll\"")]^public static extern int SendMessage(int hWnd, int hMsg, int wParam, int lParam);' -Name a -Pas)::SendMessage(-1,0x0112,0xF170,2) && exit"""
        DisplayOff.StartInfo.WindowStyle = ProcessWindowStyle.Hidden
        DisplayOff.Start()

Единственный минус - на компьютерах с производительностью уровня картошки код будет исполняться заметно дольше (больше секунды на 2 максимум)

--

Второй способ

DisplayOff - кнопка System.Windows.Forms.Button

VB.NET
1
2
3
4
5
6
7
8
9
10
11
12
13
14
Public Class Main
    <Runtime.InteropServices.DllImport("user32.dll", SetLastError:=True, CharSet:=Runtime.InteropServices.CharSet.Auto)> _
    Private Shared Function SendMessage(ByVal hWnd As IntPtr, ByVal Msg As UInteger, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As IntPtr
    End Function
    Private Const MONITOR_ON = -1&
    Private Const MONITOR_LOWPOWER = 1&
    Private Const MONITOR_OFF = 2&
    Private Const SC_MONITORPOWER = &HF170 '&
    Private Const WM_SYSCOMMAND = &H112
 
    Private Sub DisplayOff_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles DisplayOff_Click.Click
        SendMessage(Me.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, MONITOR_OFF)
    End Sub
End Class

@HACKER KAY · 12.02.2021, 19:50

Запускаем EXE-файл без расширения в папке с нашей программой

Немного благодарности Jungl

VB.NET
1
2
3
4
5
6
7
Dim FileTarget = "файл_без_расширения" 'Указывает имя файла. Можно ему присвоить любое расширение, хоть DLL - запустится как EXE :D
Dim PSI As ProcessStartInfo = New ProcessStartInfo(Application.StartupPath & "\" & FileTarget) With {
                    .RedirectStandardInput = True,
                    .RedirectStandardOutput = True,
                    .RedirectStandardError = True,
                    .UseShellExecute = False}
            Dim Process As Process = Process.Start(PSI)

@HACKER KAY · 23.02.2021, 18:56

Добавляем водяной, описывающий текст TextBox

Для реализации используем Windows API, соответственно. Немногие знают, но TextBox от нас скрывает удивительное свойство - содержать в себе описывающий текст (ну или "водяной", кому как). Только вот, Microsoft от нас это утаили. Публикую код для добавления подобной фичи в свой проект.

Код модуля:

VB.NET
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Imports System.Runtime.CompilerServices
Imports System.Runtime.InteropServices
 
Module TextBoxWatermarkExtensionMethod
    Private Const ECM_FIRST As UInteger = &H1500
    Private Const EM_SETCUEBANNER As UInteger = ECM_FIRST + 1
    <DllImport("user32.dll", CharSet:=CharSet.Auto, SetLastError:=False)>
    Private Function SendMessage(ByVal hWnd As IntPtr, ByVal Msg As UInteger, ByVal wParam As UInteger,
    <MarshalAs(UnmanagedType.LPWStr)> ByVal lParam As String) As IntPtr
    End Function
    <Extension()>
    Sub SetWatermark(ByVal TXT As TextBox, ByVal WaterMarkTextString As String)
        SendMessage(TXT.Handle, EM_SETCUEBANNER, 0, WaterMarkTextString)
    End Sub
End Module

Использование:

VB.NET
1
TextBoxExample.SetWatermark("Здесь можно писать :3")

Новые блоги и статьи Все статьи Все блоги /
Генератор паролей (вариант №4) Maks 01.11.2026 После публикации 3-го варианта генератора паролей, разослал его своим коллегам (с целью оценки), в итоге были получены следующие рекомендации: 1. Вернуть возможность использования знаков \| 1 l I;. . .	Генератор паролей (вариант №3) Maks 30.10.2026 Финальная версия генератора паролей 1С. Доработка решения в этот раз коснулась только визуальной части, а именно, добавлен реквизит ДопПараметры (тип Булево), который скрывает/ отображает реквизиты:. . .	Магическое мышление и магия, современная наука не отличима от магии (говорит ИИ Джемени) zorxor 30.10.2026 Джемени, расскажи, пожалуйста, что такое магическое мышление, что такое магия, почему современная наука чем-то напоминает магию? Фраза «Любая достаточно развитая технология неотличима от магии». . .	За какое время ИИ может подобрать пароль по хешу (рассказывает Джемени ИИ) zorxor 30.10.2026 Расскажи, Джемени, если известен хэш МД5, например, за сколько ИИ сможет подобрать соответствующий пароль? Искусственный интеллект (ИИ) может подобрать простой или средний по сложности пароль по. . .
Кто убил Suno? Почему наше солнышко погасло? (диалог с ИИ Джемени) zorxor 30.10.2026 Как убивали Suno. Хронология. «Убийство» музыкальной нейросети Suno — это затяжной процесс, в котором технологический хайп стартапа разбился о жесткую реальность судебных исков от гигантов. . .	Генератор паролей (вариант №2) Maks 30.10.2026 Обновленная версия ранее созданной обработки. Добавлены следующие реквизиты типа Булево: - Буквы; - Цифры; - Символы. Изменена логика команды "Сгенерировать" и процедуры "ПриОткрытии":. . .	Генератор паролей (вариант №1) Maks 29.10.2026 Реализация из решения ниже выполнена исключительно по моей инициативе, дабы облегчить себе работу в создании паролей для администрируемых мною сервисов и пользователей. Самым главным критерием для. . .	Установка ChatGPT (Codex) на Windows без использования Microsoft Store Fabien159 28.10.2026 Здравствуйте всем читающим! Опишу процесс установки ChatGPT (Codex) на Windows, если по каким-то причинам у вас не получается устанавить его через Microsoft Store. И так: 1. Скачиваем с. . .