Форум программистов, компьютерный форум, киберфорум
Наши страницы

Visual Basic .NET

Войти
Регистрация
Восстановить пароль
 
 
Рейтинг: Рейтинг темы: голосов - 8, средняя оценка - 5.00
Памирыч
Почетный модератор
20610 / 8650 / 1029
Регистрация: 11.04.2010
Сообщений: 11,008
#1

Visual Basic .NET FAQ. Готовые решения, полезные коды - Visual Basic .NET

18.08.2011, 22:44. Просмотров 245976. Ответов 194
Метки faq (Все метки)

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

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


Примечание: некоторые коды приведены без учета строгой типизации (Параметр Strict), поэтому для их использования необходимо выполнить приведение типов
47
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
18.08.2011, 22:44
Здравствуйте! Я подобрал для вас темы с ответами на вопрос Visual Basic .NET FAQ. Готовые решения, полезные коды (Visual Basic .NET):

Visual Basic .Net и Visual Basic 6.0 - В чём разница - Visual Basic .NET
В общем возник вопрос: Visual Bisic.Net и Visual Basic - это два разных языка, или же .NET версия это лишь его улучшение. Я так понимаю что...

Visual Basic.Net и Visual Studio 2013 - в чем разница? - Visual Basic .NET
Visual Basic.Net и Visual Studio 2013 - в чем разница? Или это одно и тоже, просто называются по другому. Планирую перейти с VB6.0...

Visual Basic .NET vs Visual FoxPro 9.0 в рамках задач реляционной модели данных - Visual Basic .NET
Очень хочется обсудить следующую тему. Поставлена задача - написать некоторую программу обработки данных. Все данные, обрабатываемые...

Исходники на Visual Basic .NET - Visual Basic .NET
Кто-то читает книжки. Кто-то ищет информацию в Google... А кто-то набирается знаний, разбирая чужие исходники. В этой теме предлагается...

Литература и ресурсы по Visual Basic .NET - Visual Basic .NET
Литература по Visual Basic.NET 1. Виктор Зиборов "Visual Basic 2010 на примерах" Издательство: БХВ-Петербург Год издания: 2010...

Хорошие учебники по Visual Basic Net - Visual Basic .NET
Подскажите пожалуйста хорошие учебники по visual basic net,спасибо

194
greg zakharov
1434 / 697 / 174
Регистрация: 07.05.2015
Сообщений: 1,347
Записей в блоге: 39
09.10.2016, 15:42 #181
Как получить список доступных системных устройств?

Такие софтины как, например, Everest или Speccy лишь частично используют WMI, добрая часть кода основана на вызове функций из setupapi.dll. Пример ниже показывает, как вывести список устройств системы, используя данную 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
Imports System.ComponentModel
Imports System.Runtime.InteropServices
 
Friend NotInheritable Class Program
  Private Const INVALID_HANDLE_VALUE As Int32  = -1
  Private Const ERROR_NO_MORE_ITEMS  As Int32  = 259
  Private Const SPDRP_DEVICEDESC     As UInt32 = 0
  
  Private Shared ReadOnly BUFFER_SIZE As UInt32 = CType( _
    Math.Pow(IntPtr.Size, 5), UInt32 _
  )
  
  Friend NotInheritable Class NativeMethods
    Private Sub New()
    End Sub
    
    <DllImport("setupapi.dll", SetLastError := True, CharSet := CharSet.Auto)> _
    Friend Shared Function SetupDiGetClassDevs( _
        ByVal ClassGuid As IntPtr, _
        <MarshalAs(UnmanagedType.LPTStr)> _
        ByVal Enumerators As String, _
        ByVal hwndParent As IntPtr, _
        ByVal Flags As SP_DEVICE_GET_FLAGS _
    ) As IntPtr
    End Function
    
    <DllImport("setupapi.dll", SetLastError := True)> _
    Friend Shared Function SetupDiEnumDeviceInfo( _
        ByVal DeviceInfoSet As IntPtr, _
        ByVal NumberIndex As UInt32, _
        ByRef DeviceInfoData As SP_DEVINFO_DATA _
    ) As <MarshalAs(UnmanagedType.Bool)> Boolean
    End Function
    
    <DllImport("setupapi.dll", SetLastError := True, CharSet := CharSet.Auto)> _
    Friend Shared Function SetupDiGetDeviceRegistryProperty( _
        ByVal DeviceInfoSet As IntPtr, _
        ByRef DeviceInfoData As SP_DEVINFO_DATA, _
        ByVal [Property] As UInt32, _
        ByRef PropertyRegDataType As UInt32, _
        ByVal PropertyBuffer As Byte(), _
        ByVal PropertyByfferSize As UInt32, _
        ByRef RequiredSize As UInt32 _
    ) As <MarshalAs(UnmanagedType.Bool)> Boolean
    End Function
    
    <DllImport("setupapi.dll", SetLastError := True)> _
    Friend Shared Function SetupDiDestroyDeviceInfoList( _
        ByVal DeviceInfoSet As IntPtr _
    ) As <MarshalAs(UnmanagedType.Bool)> Boolean
    End Function
  End Class
  
  <Flags> _
  Friend Enum SP_DEVICE_GET_FLAGS As UInteger
    DIGCF_DEFAULT         = &H1
    DIGCF_PRESENT         = &H2
    DIGCF_ALLCLASSES      = &H4
    DIGCF_PROFILE         = &H8
    DIGCF_DEVICEINTERFACE = &H10
  End Enum
  
  <StructLayout(LayoutKind.Sequential)> _
  Friend Structure SP_DEVINFO_DATA
    Friend cbSize    As UInt32
    Friend ClassGuid As Guid
    Friend DevInst   As UInt32
    Friend Reserved  As IntPtr
  End Structure
  
  Shared Sub Main()
    Dim devs  As IntPtr
    Dim [err] As Int32 = 0
    Dim i     As UInt32 = 0
    Dim ret   As Boolean = True
    
    devs = NativeMethods.SetupDiGetClassDevs( _
      IntPtr.Zero, Nothing, IntPtr.Zero, _
      SP_DEVICE_GET_FLAGS.DIGCF_PRESENT Or SP_DEVICE_GET_FLAGS.DIGCF_ALLCLASSES _
    )
    
    If devs = IntPtr.Zero Then
      Console.WriteLine( _
        New Win32Exception(Marshal.GetLastWin32Error) _
      )
      Return
    End If
    
    While [err] <> ERROR_NO_MORE_ITEMS
      Dim sdd As New SP_DEVINFO_DATA()
      sdd.cbSize = CType(Marshal.SizeOf(sdd), UInt32)
      
      ret = NativeMethods.SetupDiEnumDeviceInfo(devs, i, sdd)
      [err] = Marshal.GetLastWin32Error()
      If ret Then
        Dim buf(BUFFER_SIZE - 1) As Byte
        Dim reg As UInt32 = 0, rsz As UInt32 = 0
        
        If NativeMethods.SetupDiGetDeviceRegistryProperty( _
          devs, sdd, SPDRP_DEVICEDESC, reg, buf, BUFFER_SIZE, rsz _
        ) Then
          Dim gch As GCHandle = GCHandle.Alloc(buf, GCHandleType.Pinned)
          Console.WriteLine(Marshal.PtrToStringAuto(gch.AddrOfPinnedObject))
          gch.Free
        End If
      End If
      
      i += 1
    End While
    
    NativeMethods.SetupDiDestroyDeviceInfoList(devs)
  End Sub
End Class
6
greg zakharov
1434 / 697 / 174
Регистрация: 07.05.2015
Сообщений: 1,347
Записей в блоге: 39
26.10.2016, 12:34 #182
Что такое shell-ключ и как его обработать?

Ковыряясь в недрах Windows, обнаружил довольно любопытную вещь: помимо так называемых shell-папок в системе есть еще и shell-ключи. Если с папками все ясно, то с ключами история темная, ибо они не документированы. В сущности shell-ключ это всего лишь указатель на некоторое значение в реестре, однако таких ключей отнюдь не шибко много и представлены они перечисленим SHELLKEY:
vb.net
1
2
3
4
5
6
7
8
9
10
  Friend Enum SHELLKEY As UInteger
    SHELLKEY_HKCU_EXPLORER    = &H1
    SHELLKEY_HKLM_EXPLORER    = &H2
    SHELLKEY_HKCU_SHELL       = &H11
    SHELLKEY_HKLM_SHELL       = &H12
    SHELLKEY_HKCU_SHELLNOROAM = &H21
    SHELLKEY_HKCULM_MUICACHE  = &H5021
    SHELLKEY_HKCU_FILEEXTS    = &H6001
    SHELLKEY_HKULS_SHELL      = &H1FFFF
  End Enum
По крайней мере для настроек и кое-чего другого достаточно. И вот, когда речь заходит о совместимости приложения с версиями Windows, то эти то ключи в некоторых случаях очень и очень выручают. Однако, для доступа к некоторому ключу данного перечисления доступ просто так не получить, требуется функция SHGetShellKey, скрывающаяся в shlwapi.dll, но не выводимая dumpbin'ом. В ходе исследований обнаружилось, что эта функция скрывается за ординалом 491, так что GetProcAddress в помощь.
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
' .NETFramework v4.X
Imports Microsoft.Win32
Imports System.ComponentModel
Imports Microsoft.Win32.SafeHandles
Imports System.Runtime.InteropServices
 
Friend NotInheritable Class Program
  Private Shared ReadOnly SHGetShellKeyOrdinal As New IntPtr(491)
  Private Shared m_SHGetShellKey As _SHGetShellKey
  
  Private Shared Property SHGetShellKey As _SHGetShellKey
    Get
      Return m_SHGetShellKey
    End Get
    Set
      m_SHGetShellKey = Value
    End Set
  End Property
  
  Friend NotInheritable Class NativeMethods
    Private Sub New()
    End Sub
    
    <DllImport("kernel32.dll", SetLastError := True)> _
    Friend Shared Function FreeLibrary( _
        ByVal hModule As IntPtr _
    ) As <MarshalAs(UnmanagedType.Bool)> Boolean
    End Function
    
    <DllImport("kernel32.dll", SetLastError := True)> _
    Friend Shared Function GetProcAddress( _
        ByVal hModule As IntPtr, _
        ByVal lpProcName As IntPtr _
    ) As IntPtr
    End Function
    
    <DllImport("kernel32.dll", CharSet := CharSet.Auto, _
                               SetLastError := True)> _
    Friend Shared Function LoadLibrary( _
        ByVal lpFileName As String _
    ) As IntPtr
    End Function
  End Class
  
  Friend Enum SHELLKEY As UInteger
    SHELLKEY_HKCU_EXPLORER    = &H1
    SHELLKEY_HKLM_EXPLORER    = &H2
    SHELLKEY_HKCU_SHELL       = &H11
    SHELLKEY_HKLM_SHELL       = &H12
    SHELLKEY_HKCU_SHELLNOROAM = &H21
    SHELLKEY_HKCULM_MUICACHE  = &H5021
    SHELLKEY_HKCU_FILEEXTS    = &H6001
    SHELLKEY_HKULS_SHELL      = &H1FFFF
  End Enum
  
  <UnmanagedFunctionPointer(CallingConvention.WinApi)> _
  Friend Delegate Function _SHGetShellKey( _
      ByVal nShellKey As SHELLKEY, _
      ByVal pszSubKey As String, _
      ByVal bCreate As Boolean _
  ) As SafeRegistryHandle
  
  Private Shared Sub PrintWin32Error()
    Console.WriteLine( _
      New Win32Exception( _
        Marshal.GetLastWin32Error() _
      ).Message
    )
  End Sub
  
  Shared Sub Main()
    Dim _mod As IntPtr = IntPtr.Zero
    Dim fun  As IntPtr
    Dim srh  As New SafeRegistryHandle(IntPtr.Zero, False)
    Dim vals As String()
    
    Try
      _mod = NativeMethods.LoadLibrary("shlwapi.dll")
      fun  = NativeMethods.GetProcAddress(_mod, SHGetShellKeyOrdinal)
      SHGetShellKey = Marshal.GetDelegateForFunctionPointer( _
        fun, GetType(_SHGetShellKey) _
      )
      
      ' читаемт значения HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer
      srh = SHGetShellKey(SHELLKEY.SHELLKEY_HKCU_EXPLORER, Nothing, False)
      Using rk As RegistryKey = RegistryKey.FromHandle(srh)
        vals = rk.GetValueNames()
        For Each v As String In vals
          Console.WriteLine(v)
        Next
      End Using
    Catch e As Exception
      Console.WriteLine(e.Message)
    Finally
      If Not srh.IsInvalid Then
        srh.Dispose
      End If
      
      If Not _mod = IntPtr.Zero Then
        If Not NativeMethods.FreeLibrary(_mod) Then
          PrintWin32Error
        End If
      End If
    End Try
  End Sub
End Class
3
greg zakharov
1434 / 697 / 174
Регистрация: 07.05.2015
Сообщений: 1,347
Записей в блоге: 39
28.10.2016, 16:11 #183
Как вывести графический примитив в консоль?

Пример ниже выводит зеленый круг в консоли.
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
Imports System.Drawing
Imports System.Runtime.InteropServices
 
Friend NotInheritable Class Program
  Friend NotInheritable Class NativeMethods
    Private Sub New()
    End Sub
    
    Friend Declare Function GetConsoleWindow _
    Lib "kernel32.dll" As IntPtr
  End Class
  
  Shared Sub Main()
    Using g As Graphics = Graphics.FromHwnd( _
      NativeMethods.GetConsoleWindow _
    )
      Using b As New Bitmap(217, 217)
        Using m As Graphics = Graphics.FromImage(b)
          Using sb As New SolidBrush(Color.Lime)
            m.Clear(Color.Black)
            m.FillEllipse(sb, 7, 7, 203, 203)
          End Using
        End Using 'bitmap graphics
        
        Using i As Image = Image.FromHbitmap(b.GetHBitmap)
          g.DrawImage(i, New Rectangle(0, 9, 230, 230))
        End Using 'image to draw
      End Using 'bitmap
    End Using 'console graphics
  End Sub
End Class
Вообще, дело графическими примитивами не ограничивается, можно по аналогии выводить в консоль фотографии, правда для этого уже не придется предварительно создавать объект Bitmap.
4
greg zakharov
1434 / 697 / 174
Регистрация: 07.05.2015
Сообщений: 1,347
Записей в блоге: 39
04.11.2016, 10:21 #184
Как узнать модель процессора (без использования реестра)?

Как известно, данные, описывающие характеристики процессора и хранящиеся в реестре, можно подделать, тем самым введя в заблуждение пользователя, но не программы вроде CpuId; прекрасно понимая это, в Microsoft почесали за ухом и решили пойти по пути наименьшего сопротивления: запихать сильно кастрированную версию cpuid в NtQuerySystemInformation. В перечислении SYSTEM_INFORMATION_CLASS сие значится как SystemProcessorBrandString (105) и доступно начиная с Vista SP1.
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
Imports System.Text
Imports System.Runtime.InteropServices
 
Friend NotInheritable Class Program
  Friend NotInheritable Class NativeMethods
    Private Sub New()
    End Sub
    
    Friend Declare Function NtQuerySystemInformation _
    Lib "ntdll.dll" ( _
       ByVal SystemInformationClass As Int32, _
       ByVal SystemInformation As IntPtr, _
       ByVal SystemInformationLength As Int32, _
       ByRef ReturnLength As Int32 _
    ) As Int32
  End Class
  
  Shared Sub Main()
    Dim ret As Int32
    Dim ptr As IntPtr = IntPtr.Zero
 
    Try
      ' мы не знаем истинный размер буфера, поэтому
      ' для начала выделим его равным размеру IntPtr
      ptr = Marshal.AllocHGlobal(IntPtr.Size)
      ' STATUS_INFO_LENGTH_MISMATCH = 0xC0000004
      If &HC0000004 = NativeMethods.NtQuerySystemInformation( _
         105, ptr, IntPtr.Size, ret _
      ) Then
        ptr = Marshal.ReAllocHGlobal(ptr, CType(ret, IntPtr))
        If Not &H0 = NativeMethods.NtQuerySystemInformation( _
           105, ptr, ret, ret _
        ) Then
          Throw New InvalidOperationException( _
            "Невозможно завершить указанную операцию." _
          )
        End If
      End If
      ' вытаскиваем строку из указателя
      Dim buf(ret) As Byte
      Marshal.Copy(ptr, buf, 0, buf.Length)
      ' выводим данные в консоль
      Console.WriteLine( _
         Encoding.Default.GetString(buf).Split( _
            New Char() {ControlChars.NullChar})(0)
      )
    Catch e As Exception
      Console.WriteLine(e.Message)
    Finally
      If Not ptr = IntPtr.Zero Then
        Marshal.FreeHGlobal(ptr)
      End If
    End Try
  End Sub
End Class
Наверное, стоило бы объявить структуру SYSTEM_PROCESSOR_BRAND_STRING, но так как первое поле последней представлено массивом типа Char, то смысл в этой структуре не шибко велик.
5
greg zakharov
1434 / 697 / 174
Регистрация: 07.05.2015
Сообщений: 1,347
Записей в блоге: 39
13.11.2016, 20:36 #185
Как сделать курсор мыши [не]видимым в окне консоли?

Довольно распространенный вопрос, поэтому ниже приводится пример того, как это сделать с наименьшим количеством телодвижений.
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
Imports System.Threading
Imports System.Runtime.InteropServices
 
Friend NotInheritable Class Program
  Friend NotInheritable Class NativeMethods
    Private Sub New()
    End Sub
    
    <DllImport("kernel32.dll", SetLastError := True)> _
    Friend Shared Function GetStdHandle( _
        ByVal nStdHandle As Int32 _
    ) As IntPtr
    End Function
    
    ' функция недокументирована, получена путем реверсинга
    <DllImport("kernel32.dll", SetLastError := True)> _
    Friend Shared Sub ShowConsoleCursor( _
        ByVal pStdHandle As IntPtr, _
        ByVal bShow As Boolean _
    )
    End Sub
  End Class
  
  Private Const STD_OUTPUT_HANDLE As Int32 = -11
  
  Shared Sub Main()
    ' скрываем курсор мыши в окне консоли
    NativeMethods.ShowConsoleCursor( _
      NativeMethods.GetStdHandle(STD_OUTPUT_HANDLE), False _
    )
    Thread.Sleep(3000)
    ' вновь делаем курсор видимым
    NativeMethods.ShowConsoleCursor( _
      NativeMethods.GetStdHandle(STD_OUTPUT_HANDLE), True _
    )
  End Sub
End Class
4
greg zakharov
1434 / 697 / 174
Регистрация: 07.05.2015
Сообщений: 1,347
Записей в блоге: 39
15.11.2016, 15:36 #186
Как программно вызвать одно из пунктов контекстного меню консоли?

Что-то очень много вопросов в ящике именно о консоли... На сей раз довольно много насчитал сообщений с вопросом о том, возможен ли скролл консоли без мыши, - как "Прокрутить" в меню по Alt+Space в пункте "Изменить".
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
Imports System.Runtime.InteropServices
 
Friend NotInheritable Class Program
  Friend NotInheritable Class NativeMethods
    Private Sub New()
    End Sub
    
    Friend Declare Function GetConsoleWindow _
    Lib "kernel32.dll" () As IntPtr
    
    Friend Declare Function SendMessageW _
    Lib "user32.dll" ( _
        ByVal hWnd As IntPtr, _
        ByVal Msg As UInt32, _
        ByVal wParam As IntPtr, _
        ByVal lParam As IntPtr _
    ) As IntPtr
  End Class
  
  Shared Sub Main
    NativeMethods.SendMessageW( _
      NativeMethods.GetConsoleWindow, _
      &H111, CType(&HFFF3, IntPtr), IntPtr.Zero
    )
  End Sub
End Class
Собственно это весь код. После компиляции и запуска вроде бы ничего не происходит, но стоит зажать клавишу со стрлкой вверх или вниз, как получим желаемую прокрутку. По аналогии "вызываются" прочие пункты контекстного меню, точнее достаточно в коде изменить значение &HFFF3 на одно из представленных ниже:
vb.net
1
2
3
4
5
&HFFF1 ' вставить
&HFFF2 ' пометить
&HFFF3 ' прокрутить
&HFFF4 ' найти
&HFFF5 ' выделить все
4
greg zakharov
1434 / 697 / 174
Регистрация: 07.05.2015
Сообщений: 1,347
Записей в блоге: 39
21.12.2016, 19:37 #187
Свойство OSVersion класса Environment возврвщает неверные данные о версии Windows, как это исправить?

Свойство OSVersion помечено M$ как deprecated, что в свою очередь указывает на нежелательное использование данного свойства, а оно, свойство, в свою очередь реализуется за счет вызовов API'шных функций с той же "черной меткой", что и OSVersion. (И как после этого не послать M$ в /dev/null?!) Однако, есть единственный (на данный момент) надежный способ извлечения версии системы - RtlGetNtVersionNumbers.
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
Imports System.Runtime.InteropServices
 
Friend NotInheritable Class Program
  Friend NotInheritable Class NativeMethods
    Private Sub New()
    End Sub
    
    Friend Declare Sub RtlGetNtVersionNumbers _
    Lib "ntdll.dll" ( _
        ByRef Major As UInt32, _
        ByRef Minor As UInt32, _
        ByRef Build As UInt32 _
    )
  End Class
  
  Shared Sub Main()
    Dim major As UInt32 = 0
    Dim minor As UInt32 = 0
    Dim build As UInt32 = 0
    
    NativeMethods.RtlGetNtVersionNumbers( _
       major, minor, build _
    )
    Console.WriteLine("{0}.{1}.{2}", _
       major, minor, build And &HFFFF
    )
  End Sub
End Class
2
greg zakharov
1434 / 697 / 174
Регистрация: 07.05.2015
Сообщений: 1,347
Записей в блоге: 39
29.12.2016, 11:26 #188
Как получить список альясов (макросов) консольных команд?

Заядлые консольщики обычно держат под рукой файл макросов команд, набор которых в консоли обычно занимает некоторое время; макросы же позволяют снизить это время за счет, например:
Windows Batch file
1
C:\> doskey which=for %i in (%pathext%) do @for %j in ($1%i) do @if exist "%~$PATH:j" @echo:%~$PATH:j
В итоге:
Windows Batch file
1
2
C:\> which reg
C:\Windows\System32\reg.exe
Так вот, подобные альясы (или все же макросы?!) имеют более высокий приоритет перед существуюшими командами. Допустим, задав такой макрос:
Windows Batch file
1
C:\> doskey ping=ping -n 10000 $1 | findstr /irc:"ttl"
При вызове ping будет выполняться именно команда выше, а не команда ping в ее обычном представлении. Как раз для того, чтобы избежать подобных недоразумений, полезно иногда поглядывать а был ли задан макрос. В самой консоли для этого имеется все тот же doskey, а вот программно это можно сделать так:
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
Imports System.Text
Imports System.Reflection
Imports System.ComponentModel
Imports System.Runtime.InteropServices
 
Friend NotInheritable Class Program
  Friend NotInheritable Class NativeMethods
    Private Sub New()
    End Sub
    
    <DllImport("kernel32.dll", CharSet := CharSet.Unicode)> _
    Friend Shared Function GetConsoleAliases( _
        ByVal lpAliasBuffer As Byte(), _
        ByVal dwAliaseBufferLength As UInt32, _
        ByVal lpExeName As String _
    ) As UInt32
    End Function
 
    <DllImport("kernel32.dll", CharSet := CharSet.Unicode)> _
    Friend Shared Function GetConsoleAliasesLength( _
        ByVal lpExeName As String _
    ) As UInt32
    End Function
  End Class
 
  Shared Sub Main(ByVal args As String())
    If args.Length <> 1 Then
      Console.WriteLine( _
        "Usage: {0} [conapp]" & vbLf & ".e.g.: {0} cmd.exe", _
        GetType(Program).Assembly.GetName().Name
      )
      Return
    End If
 
    Dim sz As UInt32
    If (InlineAssignHelper( _
      sz, NativeMethods.GetConsoleAliasesLength(args(0)) _
    )) <= 0 Then
      Console.WriteLine("It seems that there are no aliases.")
      Return
    End If
 
    Dim buf As Byte() = New Byte(sz - 1) {}
    If NativeMethods.GetConsoleAliases(buf, sz, args(0)) = 0 Then
      Console.WriteLine(New Win32Exception( _
        Marshal.GetLastWin32Error() _
      ).Message)
      Return
    End If
 
    Console.WriteLine("[{0}]", args(0))
    Dim aliases As String() = Encoding.Unicode.GetString( _
      buf _
    ).Split(New Char() {ControlChars.NullChar})
    For Each [alias] As String In aliases
      Console.WriteLine("    {0}", [alias])
    Next
  End Sub
  
  Private Shared Function InlineAssignHelper(Of T)( _
      ByRef target As T, value As T _
  ) As T
    target = value
    Return value
  End Function
End Class

Существуют ли альтернативы свойству Is64BitOperatingSystem класса Environment?

Например, WMI (Win32_OperatingSystem), однако если у пользователя не окажется достаточно прав, узнать является ли система 64 битной или нет можно путем вызова GetNativeSystemInfo:
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.Runtime.InteropServices
 
Friend NotInheritable Class Program
  Friend NotInheritable Class NativeMethods
    Private Sub New()
    End Sub
    
    Friend Declare Sub GetNativeSystemInfo _
    Lib "kernel32.dll" ( _
        ByRef lpSystemInfo As SYSTEM_INFO _
    )
  End Class
  
  <StructLayout(LayoutKind.Sequential)> _
  Friend Structure SYSTEM_INFO
    Friend wProcessorArchitecture As UInt16
    Friend wReserved As UInt16
    Friend dwPageSize As UInt32
    Friend lpMinimumApplicationAddress As IntPtr
    Friend lpMaximumApplicationAddress As IntPtr
    Friend dwActiveProcessorMask As UIntPtr
    Friend dwNumberOfProcessors As UInt32
    Friend dwProcessorType As UInt32
    Friend dwAllocationGranularity As UInt32
    Friend wProcessorLevel As UInt16
    Friend wProcessorRevision As UInt16
  End Structure
  
  Shared Sub Main()
    Dim si As New SYSTEM_INFO()
    NativeMethods.GetNativeSystemInfo(si)
    Console.WriteLine( _
      If (si.wProcessorArchitecture = 9, "64-bit", "32-bit")
    )
  End Sub
End Class
Согласно MSDN поле wProcessorArchitecture указывает на архитектуру процессора установленной системы. Альтернаивой же этому способу может быть вызов RtlGetNativeSystemInformation из ntdll, однако код будет несколько длинней, да и GetNativeSystemInfo по сути является оберткой для ее вызова.
2
greg zakharov
1434 / 697 / 174
Регистрация: 07.05.2015
Сообщений: 1,347
Записей в блоге: 39
08.03.2017, 22:06 #189
Как узнать тип охлаждения на текущий момент?
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
Imports System.ComponentModel
Imports System.Runtime.InteropServices
 
Friend NotInheritable Class Program
  Friend NotInheritable Class NativeMethods
    Private Sub New()
    End Sub
 
    Friend Declare Function NtPowerInformation Lib "ntdll.dll" ( _
        ByVal InformationLevel As UInt32, _
        ByVal InputBuffer As IntPtr, _
        ByVal InputBufferLength As UInt32, _
        ByRef OutputBuffer As SYSTEM_POWER_INFORMATION, _
        ByVal OutputBufferLength As UInt32 _
    ) As Int32
 
    Friend Declare Function RtlNtStatusToDosError Lib "ntdll.dll" ( _
        ByVal NtStatus As Int32 _
    ) As Int32
  End Class
 
  Friend Enum COOLING_MODE As Byte
    PO_TZ_ACTIVE
    PO_TZ_PASSIVE
    PO_TZ_INVALID_MODE
  End Enum
 
  <StructLayout(LayoutKind.Sequential)> _
  Friend Structure SYSTEM_POWER_INFORMATION
    Friend MaxIdlenessAllowed As UInt32
    Friend Idleness As UInt32
    Friend TimeRemaining As UInt32
    Friend _CoolingMode As COOLING_MODE
 
    Friend ReadOnly Property CoolingMode As String
      Get
        Return [Enum].GetName(GetType(COOLING_MODE), Me._CoolingMode)
      End Get
    End Property
  End Structure
 
  Private Const STATUS_SUCCESS As Int32 = 0
  Private Const SystemPowerInformation As UInt32 = 12
 
  Shared Sub Main()
    Dim spi As New SYSTEM_POWER_INFORMATION()
    Dim sz As UInt32 = Marshal.SizeOf(GetType(SYSTEM_POWER_INFORMATION))
    Dim nts As Int32
 
    nts = NativeMethods.NtPowerInformation( _
      SystemPowerInformation, IntPtr.Zero, 0, spi, sz _
    )
    If STATUS_SUCCESS <> nts Then
      Console.WriteLine(New Win32Exception( _
        NativeMethods.RtlNtStatusToDosError(nts) _
      ).Message)
      Return
    End If
 
    Console.WriteLine(spi.CoolingMode)
  End Sub
End Class
3
greg zakharov
1434 / 697 / 174
Регистрация: 07.05.2015
Сообщений: 1,347
Записей в блоге: 39
21.03.2017, 20:08 #190
Вычисление энтропии строки

Энтропия по Шеннону, как оговорка по Фрейду. Но это так, к слову. Ниже пример реализации вычисления оной.
vb.net
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Imports System.IO
Imports System.Linq
 
Module Entropy
  Sub Main(ByVal args As String())
    If args.Length <> 1 Then
      Console.WriteLine("Синтаксис: {0} <строка>", _
        Path.GetFileName(Environment.GetCommandLineArgs()(0)) _
      )
      Return
    End If
 
    Dim arr As Char() = args(0).ToCharArray()
    Dim ent = arr.Distinct().Select( _
      Function(c) CType(arr.Count(Function(i) i = c), Double) / arr.Length _
    ).Select(Function(x) -(x) * Math.Log(x, 2)).Sum()
 
    Console.WriteLine("{0}", ent)
  End Sub
End Module
0
ViterAlex
5860 / 3080 / 924
Регистрация: 11.02.2013
Сообщений: 6,728
Завершенные тесты: 3
17.06.2017, 20:21 #191
Как сделать курсор из битмапа?

Точка клика в центре битмапа
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
Imports System.Runtime.InteropServices
Module CursorModule
 
    <DllImport("user32.dll")>
    Private Function GetIconInfo(ByVal hIcon As IntPtr, ByRef piconinfo As IconInfo) As <MarshalAs(UnmanagedType.Bool)> Boolean : End Function
    <DllImport("user32.dll")>
    Private Function CreateIconIndirect(ByRef piconinfo As IconInfo) As IntPtr : End Function
    <DllImport("gdi32.dll")>
    Private Function DeleteObject(ByVal ptr As IntPtr) As <MarshalAs(UnmanagedType.Bool)> Boolean : End Function
 
    <StructLayout(LayoutKind.Sequential)>
    Private Structure IconInfo
        Public IsIcon As Boolean
        Public xHotspot As Integer
        Public yHotspot As Integer
        Public MaskBitmap As IntPtr
        Public ColorBitmap As IntPtr
    End Structure
 
    Public Function GetCursor(ByVal [bitmap] As Bitmap) As Cursor
        Dim hIcon = bitmap.GetHicon()
        Dim info = New IconInfo()
        GetIconInfo(hIcon, info)
 
        info.xHotspot = bitmap.Width / 2
        info.yHotspot = bitmap.Height / 2
        info.IsIcon = False
 
        hIcon = CreateIconIndirect(info)
        Dim result = New Cursor(hIcon)
        DeleteObject(hIcon)
        Return result
    End Function
End Module
4
ViterAlex
5860 / 3080 / 924
Регистрация: 11.02.2013
Сообщений: 6,728
Завершенные тесты: 3
25.07.2017, 16:53 #192
Экспорт содержимого контрола, в данном случае ListView, в файлы различных типов. Например, txt, csv, html, docx, xlsx.
Какими инструментами пользоваться? С txt и csv всё понятно — обычный текст, пишем через поток. html тоже можно так писать, но лучше использовать XmlTextWriter — результат гораздо лучше выглядит.
Для офисных файлов можно пользоваться механизмом Interop: там довольно понятная объектная модель, однако очень низкая скорость и требуется установленный офис. Но главный минус — скорость. Поэтому я предлагаю использовать OpenXml. Объектная модель там посложнее, но получаемая скорость оправдывает затраченное время.
Для начала сделаем интерфейс экспортёра IExport:
vb.net
1
2
3
4
5
6
7
Imports System.Windows.Forms
 
Public Interface IExport
    Sub Save(path As String, lvw As ListView, Optional exportHeaders As Boolean = False)
    Property Extension() As String
    Property Description() As String
End Interface
Один метод и два свойства. Свойства не обязательны: они помогают упростить взаимодействие с экспортёром. Метод принимает в себя путь, ListView, который нужно сохранить и булевый параметр, нужно ли сохранять заголовки. Под заголовками имеются ввиду заголовки столбцов.
Реализацию интерфейса сделаем в абстрактном классе ExporterBase:
vb.net
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Imports System.Windows.Forms
 
Public MustInherit Class ExporterBase
    Implements IExport
    Friend _listView As ListView
    Friend _exportHeaders As Boolean
 
    Public Property Extension() As String Implements IExport.Extension
 
    Public Property Description() As String Implements IExport.Description
 
 
    Public Sub Save(path As String, lvw As ListView, Optional exportHeaders As Boolean = False) Implements IExport.Save
        _listView = lvw
        _exportHeaders = exportHeaders
        CreateFile(path)
    End Sub
 
    Friend MustOverride Sub CreateFile(path As String)
End Class
В этом классе пишем реализацию метода Save и объявляем абстрактный метод CreateFile, в котором наследники будут реализовывать конкрентный механизм экспорта.
Осталось написать реализацию пять классов для экспорта: TxtExporter, CsvExpoter, HtmlExporter, WordExporter, ExcelExporter. Приведу код HtmlExporter и WordExporter
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
Imports System.IO
Imports System.Windows.Forms
Imports System.Xml
 
Public Class HtmlExporter
    Inherits ExporterBase
 
    Friend Overrides Sub CreateFile(path As String)
        Using writer As New StreamWriter(path)
            Using xmlWr As New XmlTextWriter(writer) With {
                .Formatting = Formatting.Indented
                }
                xmlWr.WriteStartElement("html")
                xmlWr.WriteStartElement("head")
                xmlWr.WriteStartElement("style")
                xmlWr.WriteString(
                    "table{" +
                    "  border: 3px solid;" +
                    "  border-collapse: collapse;" +
                    "}" +
                    "th{" +
                    "  background-color: #888888;" +
                    "  border-left: 2px solid;" +
                    "}" +
                    "td{" +
                    "  border-left: 2px solid;" +
                    "}" +
                    "tr{" +
                    "  border-top: 1px solid;" +
                    "}")
                xmlWr.WriteEndElement() 'style
                xmlWr.WriteEndElement() 'head
                xmlWr.WriteStartElement("body")
                xmlWr.WriteStartElement("table")
                If _exportHeaders Then
                    AddHeader(xmlWr)
                End If
                For Each lvi As ListViewItem In _listView.Items
                    xmlWr.WriteStartElement("tr")
                    For Each lvsi As ListViewItem.ListViewSubItem In lvi.SubItems
                        xmlWr.WriteStartElement("td")
                        xmlWr.WriteString(lvsi.Text)
                        xmlWr.WriteEndElement() 'td
                    Next
                    xmlWr.WriteEndElement() 'tr
                Next
                xmlWr.WriteEndElement() 'table
                xmlWr.WriteEndElement() 'body
                xmlWr.WriteEndElement() 'html
            End Using
        End Using
    End Sub
 
    Private Sub AddHeader(writer As XmlTextWriter)
        writer.WriteStartElement("tr")
        For Each ch As ColumnHeader In _listView.Columns
            writer.WriteStartElement("th")
            writer.WriteString(ch.Text)
            writer.WriteEndElement() 'th
        Next
        writer.WriteEndElement() 'tr
    End Sub
End Class
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
Imports System.Windows.Forms
Imports DocumentFormat.OpenXml
Imports DocumentFormat.OpenXml.Packaging
Imports DocumentFormat.OpenXml.Wordprocessing
 
Public Class WordExporter
    Inherits ExporterBase
    'Границы таблицы
    Private ReadOnly _tableBorders As BorderType() =
    {
        New TopBorder() With {
            .Val = BorderValues.Single,
            .Color = "auto",
            .Size = 12,
            .Space = 0
        },
        New LeftBorder() With {
            .Val = BorderValues.Single,
            .Color = "auto",
            .Size = 12,
            .Space = 0
        },
        New BottomBorder() With {
            .Val = BorderValues.Single,
            .Color = "auto",
            .Size = 12,
            .Space = 0
        },
        New RightBorder() With {
            .Val = BorderValues.Single,
            .Color = "auto",
            .Size = 12,
            .Space = 0
        },
        New InsideHorizontalBorder With {
            .Val = BorderValues.Single,
            .Color = "auto",
            .Size = 6,
            .Space = 0
        },
        New InsideVerticalBorder With {
            .Val = BorderValues.Single,
            .Color = "auto",
            .Size = 6,
            .Space = 0
        }
    }
 
    Friend Overrides Sub CreateFile(path As String)
        Using package As WordprocessingDocument = WordprocessingDocument.Create(path, WordprocessingDocumentType.Document)
            CreateParts(package)
        End Using
    End Sub
 
 
    Private Sub CreateParts(document As WordprocessingDocument)
        Dim documentPart As MainDocumentPart = document.AddMainDocumentPart()
        GenerateMainDocumentPartContent(documentPart)
    End Sub
 
    'Генерирование содержимого документа
    Private Sub GenerateMainDocumentPartContent(documentPart As MainDocumentPart)
#Region " Минимальный набор данных для документа"
 
        Dim doc = New Document() With
        {
            .MCAttributes = New MarkupCompatibilityAttributes() With
            {
                .Ignorable = "w14 w15 w16se wp14"
            }
        }
        doc.AddNamespaceDeclaration("wp14", "http://schemas.microsoft.com/office/word/2010/wordprocessingDrawing")
        doc.AddNamespaceDeclaration("w", "http://schemas.openxmlformats.org/wordprocessingml/2006/main")
        doc.AddNamespaceDeclaration("w14", "http://schemas.microsoft.com/office/word/2010/wordml")
        doc.AddNamespaceDeclaration("w15", "http://schemas.microsoft.com/office/word/2012/wordml")
        doc.AddNamespaceDeclaration("w16se", "http://schemas.microsoft.com/office/word/2015/wordml/symex")
#End Region
        'К документу добавляем тело, к телу таблицу
        Dim tbl = doc.AppendChild(New Body()).AppendChild(New Table())
 
        With tbl.AppendChild(New TableProperties())
            'Добавляем границы таблицы
            .Append(New TableBorders(_tableBorders))
 
            'Добавляем отступы по умолчанию в ячейках таблицы 
            .Append(New TableCellMarginDefault With
            {
                .TableCellLeftMargin = New TableCellLeftMargin With {
                    .Width = CentimetersToPoints(0.2F),
                    .Type = TableWidthValues.Dxa
                },
                .TableCellRightMargin = New TableCellRightMargin With {
                    .Width = CentimetersToPoints(0.2F),
                    .Type = TableWidthValues.Dxa
                }
            })
        End With
 
        'Столбцы таблицы
        With tbl.AppendChild(New TableGrid())
            For i = 0 To _listView.Columns.Count - 1
                .Append(New GridColumn())
            Next
        End With
 
        'Если нужно — добавляем в таблицу первую строку с названиями столбцов ListView
        If _exportHeaders Then
            tbl.Append(GetHeader)
        End If
 
        'Заполнение таблицы
        For Each lvi As ListViewItem In _listView.Items
            With tbl.AppendChild(New TableRow())
                For Each lvsi As ListViewItem.ListViewSubItem In lvi.SubItems
                    'в строку добавляем ячейку, в ячейку — абзац, в абзац — фрагмент, во фрагмент — текст
                    .AppendChild(New TableCell()) _
                    .AppendChild(New Paragraph()) _
                    .AppendChild(New Run()) _
                    .Append(New Text() With {
                        .Text = lvsi.Text
                    })
                Next
            End With
        Next
        'Формирование документа
 
        documentPart.Document = doc
 
    End Sub
 
    'Создание строки-заголовка таблицы
    Private Function GetHeader() As TableRow
        Dim result As New TableRow()
        For Each ch As ColumnHeader In _listView.Columns
            'в строку добаляем ячейку
            With result.AppendChild(New TableCell()).AppendChild(New Paragraph())
                'в абзац добавляем выравнивание по центру
                .Append(New ParagraphProperties With {
                    .Justification = New Justification With {
                        .Val = JustificationValues.Center
                    }
                })
                'И фрагмент с текстом
                .AppendChild(New Run()).Append(New Text With {.Text = ch.Text})
            End With
        Next
        Return result
    End Function
 
    'Перевод сантиметров в точки
    Private Function CentimetersToPoints(centimeters As Single) As String
        Return CInt(centimeters * 28.34646F).ToString()
    End Function
End Class
На скриншоте примерное время выполнения тестов. Буква H в названии теста означает экспорт с заголовками.
В архиве решение с 3-мя проектами: библиотека exporters.dll, приложение WinForms для демонстрации и юнит тесты библиотеки exporters.
8
Изображения
 
Вложения
Тип файла: zip ExportListViewSolution.zip (49.5 Кб, 7 просмотров)
maks123123124
3 / 2 / 0
Регистрация: 25.06.2017
Сообщений: 27
Записей в блоге: 1
08.08.2017, 01:35 #193
Выключение или перезагрузка ПК

Выключение ПК:
vb.net
1
Shell("shutdown -s -t 0", vbHide)
Перезагрузка ПК:
vb.net
1
Shell("shutdown -r -t 0", vbHide)
3
17Vasya17
73 / 67 / 5
Регистрация: 05.01.2016
Сообщений: 258
24.09.2017, 10:33 #194
Работа с формой

Закрыть окно
Кликните здесь для просмотра всего текста
vb.net
1
Me.Close()


Свернуть окно
Кликните здесь для просмотра всего текста
vb.net
1
Me.WindowState = FormWindowState.Minimized


Развернуть свернуть на весь экран окно
Кликните здесь для просмотра всего текста
vb.net
1
2
3
4
5
      If Me.WindowState = FormWindowState.Normal Then
        Me.WindowState = FormWindowState.Maximized
      Else
        Me.WindowState = FormWindowState.Normal
      End If


Кликните здесь для просмотра всего текста
vb.net
1
2
3
4
    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        Me.AcceptButton = Button1 'кнопка срабатывает при нажатии ENTER (OK)
        Me.CancelButton = Button2 'кнопка срабатывает при нажатии ESC (ОТМЕНА)
    End Sub


Тень для формы
Кликните здесь для просмотра всего текста
vb.net
1
2
3
4
5
6
7
8
 Private Const DROPSHADOW As Integer = &H20000
    Protected Overrides ReadOnly Property CreateParams() As CreateParams
        Get
            Dim myparam As CreateParams = MyBase.CreateParams
            myparam.ClassStyle = myparam.ClassStyle Or DROPSHADOW
            Return myparam 
        End Get
    End Property


Анимация Windows Form

Кликните здесь для просмотра всего текста
vb.net
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
    Private Declare Function AnimateWindow Lib "user32" (ByVal hwnd As Long, ByVal dwTime As Long, ByVal dwFlags As Long) As Boolean
    Const AW_HOR_POSITIVE = &H1 'Анимация окна слева направо.
    'Этот флаг используется совместно с эффектами развёртывания и соскальзывания.
    Const AW_HOR_NEGATIVE = &H2 'Анимация окна справа налево.
    'Этот флаг используется совместно с эффектами развёртывания и соскальзывания.
    Const AW_VER_POSITIVE = &H4 'Анимация окна сверху вниз.
    'Этот флаг используется совместно с эффектами развёртывания и соскальзывания.
    Const AW_VER_NEGATIVE = &H8 'Анимация окна снизу вверх.
    'Этот флаг используется совместно с эффектами развёртывания и соскальзывания.
    Const AW_CENTER = &H10 'Окно сворачивается внутрь себя если
    'установлен флаг AW_HIDE, иначе разворачивается
    Const AW_HIDE = &H10000 'Скрывает окно, по умолчанию окно появляется.
    Const AW_ACTIVATE = &H20000 'Активизирует окно.
    Const AW_SLIDE = &H40000 'Устанавливает эффект соскальзывания.
    'По умолчанию эффект развёртывания.
    Const AW_BLEND = &H80000 'Эффект постепенного появления.
    'Применяется только к окнам верхнего уровня.


Пример:

Кликните здесь для просмотра всего текста
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
'Плавный запуск формы
Imports System
Public Class Form1
 
    <Flags> _
    Enum AnimateWindowFlags
        AW_HOR_POSITIVE = &H1
        AW_HOR_NEGATIVE = &H2
        AW_VER_POSITIVE = &H4
        AW_VER_NEGATIVE = &H8
        AW_CENTER = &H10
        AW_HIDE = &H10000
        AW_ACTIVATE = &H20000
        AW_SLIDE = &H40000
        AW_BLEND = &H80000
    End Enum
    <System.Runtime.InteropServices.DllImport("user32.dll")> _
    Shared Function AnimateWindow(hWnd As IntPtr, time As Integer, flags As AnimateWindowFlags) As Boolean
    End Function
 
    Private Sub Form1_FormClosing(sender As Object, e As FormClosingEventArgs) Handles Me.FormClosing
        AnimateWindow(Me.Handle, 1000, AnimateWindowFlags.AW_BLEND Or AnimateWindowFlags.AW_HIDE)
    End Sub
 
    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        AnimateWindow(Me.Handle, 1000, AnimateWindowFlags.AW_BLEND Or AnimateWindowFlags.AW_VER_POSITIVE)
    End Sub
3
Yury Komar
Модератор
2214 / 2019 / 321
Регистрация: 27.01.2014
Сообщений: 3,583
Завершенные тесты: 1
01.11.2017, 13:14 #195
В данном посте решил собрать различные приемы для запуска своей (и не только) программы от имени администратора.
(Вопрос часто поднимается многими начинающими программистами, поэтому решил вынести ответ на него здесь)

Корректировка манифеста исполняемого файла:
Кликните здесь для просмотра всего текста
1) Переходим в настройки проекта [Обозреватель решений -> My Project]
2) Нажимаем на кнопку "Посмотреть параметры Windows", откроется файл манифеста приложения
3) Первое что необходимо сделать, это во второй строке в открывающем теге добавить атрибут
XML
1
xmlns:asmv3="urn:schemas-microsoft-com:asm.v3"
Полная строка будет выглядеть так:
XML
1
<asmv1:assembly manifestVersion="1.0" xmlns="urn:schemas-microsoft-com:asm.v1" xmlns:asmv1="urn:schemas-microsoft-com:asm.v1" xmlns:asmv2="urn:schemas-microsoft-com:asm.v2" xmlns:asmv3="urn:schemas-microsoft-com:asm.v3" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance">
4) Далее находим строку
XML
1
<requestedExecutionLevel level="asInvoker" uiAccess="false" />
и заменяем данную строку на
XML
1
<requestedExecutionLevel  level="requireAdministrator" uiAccess="false" />
5) Для того, чтобы пользователю не выскакивало сообщение о том, что данное ПО требует прав администратора, нужно в конец маниваеста, перед закрывающим тегом </asmv1:assembly>, добавить следующее (это позволит приложению молча, не спрашивая пользователя, применить права админа):
XML
1
2
3
4
5
  <asmv3:application>
    <asmv3:windowsSettings xmlns="http://schemas.microsoft.com/SMI/2005/WindowsSettings">
      <autoElevate>true</autoElevate>
    </asmv3:windowsSettings>
  </asmv3:application>
После всего этого нужно сохранить проект и запустить ваш Visual Studio с правами администратора, либо при первом запуске она сама предложит вам это делать.
Вот и все, программа теперь будет запускаться с правами администратора, что без проблем позволит вам сохранить файлы на системном диске и так далее.

PS: На иконке исполняемого файла появится значок желто-синего щита.


Запуск какого-то файла с правами администратора
Кликните здесь для просмотра всего текста
vb.net
1
2
3
4
5
    Sub RunAsAdmin(FullPath As String, Optional Args As String = "", Optional WindowStyle As ProcessWindowStyle = ProcessWindowStyle.Normal, Optional UseShellExecute As Boolean = False)
        Dim pStartInfo As New ProcessStartInfo With {.FileName = FullPath, .Arguments = Args, .WindowStyle = WindowStyle, .UseShellExecute = UseShellExecute}
        If Environment.OSVersion.Version.Major >= 6 Then pStartInfo.Verb = "runas" 'Здесь проверяем, если ОС версия выше чем Vista, то применяем права администратора при запуске, до этой версии таких прав не нужно
        Process.Start(pStartInfo)
    End Sub


Через реестр установить у файла "галочку" на "Запускать от имени администратора"
Кликните здесь для просмотра всего текста
1) Рабочий раздел реестра: "HKEY_CURRENT_USER\Software\Microsoft\Windows NT\CurrentVersion\AppCompatFlags\Layers"
2) Смотрим, есть ли в нем строковой параметр "REG_SZ" с именем равным "полному пути к EXE файлу"
3) Если нету, то создаешь новый параметр типа "REG_SZ" со значением "~ RUNASADMIN" (начало строки должно начинаться с символа "~", но и без него работает)
4) Если параметр с полным путем к нашему файлу уже существует, то нужно проверить нет ли у него в значении того, что мы хотим добавить.
5) Если того параметра в значении нет, то добавляем (через пробел) необходимое.
6) Если мы хотим отключить визуальные темы Windows у окна, то добавляем параметр DISABLETHEMES
7) Если мы хотим запускать программу в режиме совместимости с другой ОС, то добавляем ее короткое название (смотри ниже)

Режимы совместимости с различными ОС
WIN95 Windows 95
WIN98 Windows 98/Millenium
WINXPSP2 Windos XP Service Pack 2
WINXPSP3 Windos XP Service Pack 3
VISTARTM Windows Vista
VISTASP1 Windows Vista Service Pack 1
VISTASP2 Windows Vista Service Pack 2
WIN7RTM Windows 7
WIN8RTM Windows 8

Пример:
Имя параметра(путь к файлу): C:\MyApplication.exe
Значение параметра: ~ RUNASADMIN DISABLETHEMES WIN98
Описание: Запускает программу с правами администратора, отключает визуальные стили окна и работает в режиме совместимости с Win98


Узнать, запущена ли программа с правами администратора или нет
Кликните здесь для просмотра всего текста
vb.net
1
2
3
    Function IsAdministrator() As Boolean
        Return New Security.Principal.WindowsPrincipal(Security.Principal.WindowsIdentity.GetCurrent()).IsInRole(Security.Principal.WindowsBuiltInRole.Administrator)
    End Function


Узнать, входит ли тeкущий пользователь в группу Администраторов или другую нужную нам группу
Кликните здесь для просмотра всего текста
vb.net
1
2
3
4
5
6
7
8
9
10
    Public Function IsInGroup(ByVal GroupName As String) As Boolean
        Dim MyIdentity As System.Security.Principal.WindowsIdentity = System.Security.Principal.WindowsIdentity.GetCurrent()
        Dim MyPrincipal As System.Security.Principal.WindowsPrincipal = New System.Security.Principal.WindowsPrincipal(MyIdentity)
        Return MyPrincipal.IsInRole(GroupName)
    End Function
 
'Получить список групп можно таким образом:
    For Each groupName As String In System.Security.Principal.WindowsIdentity.GetCurrent.Groups.Select(Function(grp) grp.Translate(GetType(System.Security.Principal.NTAccount)).Value)
        ListBox1.Items.Add(groupName)
    Next





И еще немного полезностей:

Отловить событие MouseDown по заголовке кнопкам заголовка формы
Кликните здесь для просмотра всего текста
vb.net
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
    Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
        If m.Msg = &HA1 Then
            Select Case m.WParam
                Case 2
                    MsgBox("Form Title MouseDown")
                Case 3
                    MsgBox("Form Icon MouseDown. Called System Menu")
                Case 8
                    MsgBox("Minimize Button MouseDown")
                Case 9
                    MsgBox("Maximize Button MouseDown")
                Case 20
                    MsgBox("Form Close Button MouseDown")
            End Select
        End If
        MyBase.WndProc(m)
    End Sub






Заблокировать действия кнопок управления формой
Кликните здесь для просмотра всего текста
vb.net
1
2
3
4
5
6
7
8
9
10
11
12
    Declare Function GetSystemMenu Lib "user32" (ByVal hWnd As Integer, ByVal bRevert As Integer) As Integer
    Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Integer, ByVal nPosition As Integer, ByVal wFlags As wFlag) As Integer
    
    Enum wFlag
        MinButton = 3
        MaxButton = 4
        CloseButton = 6
    End Enum
 
    Public Sub KillingMenu(hWnd As Long, wFlag As wFlag)
        RemoveMenu(GetSystemMenu(hWnd, 0), wFlag, &H400&)
    End Sub

Пример (блокируем нажатие кнопки Развернуть на весь экран, тем самым блокируя и двойной клик по заголовку формы)
vb.net
1
KillingMenu(Me.Handle, wFlag.MaxButton)
6
01.11.2017, 13:14
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
01.11.2017, 13:14
Привет! Вот еще темы с ответами:

Вопросы к экзамену по курсу Visual Basic .NET - Visual Basic .NET
Помогите ответить на вопросы по Visual Basic. Завтра зачет. Пропускал лекции т.к все время уезжал. Помогите. Желательно развернутый ответ....

Перевести код с VBA на Visual Basic.NET - Visual Basic .NET
Здравствуйте! Прошу помощи. Переведите, пожалуйста, код ниже с VBA (Эксель) на Visual Basic.NET. Обращаюсь вынужденно, поскольку не...

Популярные программы, написанные на Visual basic.NET - Visual Basic .NET
Сейчас есть множество популярных программ, написанных на разных языках программирования. А есть ли популярные или известные программы,...

Для чего нужен Visual Basic.Net? - Visual Basic .NET
Здравствуйте. Объясните пожалуйста для какой деятельности нужен Visual Basic и Visual Basic.Net? То есть для чего там делают программы? И...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
195
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2017, vBulletin Solutions, Inc.
Рейтинг@Mail.ru