Форум программистов, компьютерный форум, киберфорум
Наши страницы
Visual Basic .NET
Войти
Регистрация
Восстановить пароль
 
 
Рейтинг: Рейтинг темы: голосов - 9, средняя оценка - 5.00
Памирыч
Почетный модератор
20840 / 8722 / 1079
Регистрация: 11.04.2010
Сообщений: 11,012
#1

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

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

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

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

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


Примечание: некоторые коды приведены без учета строгой типизации (Параметр Strict), поэтому для их использования необходимо выполнить приведение типов
48
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
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 Bisic.Net и Visual Basic - это два разных языка,...

Visual Basic.Net и Visual Studio 2013 - в чем разница?
Visual Basic.Net и Visual Studio 2013 - в чем разница? Или это одно и тоже,...

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

Исходники на Visual Basic .NET
Кто-то читает книжки. Кто-то ищет информацию в Google... А кто-то набирается...

Литература и ресурсы по Visual Basic .NET
Литература по Visual Basic.NET 1. Виктор Зиборов "Visual Basic 2010 на...

Аналог TStringList в Visual Basic.NET
Здравствуйте все! Помогите разобраться мне надо строки в текстовом файле...

194
greg zakharov
Покинул форум
1940 / 816 / 233
Регистрация: 07.05.2015
Сообщений: 1,640
13.11.2016, 20:36 #181
Как сделать курсор мыши [не]видимым в окне консоли?

Довольно распространенный вопрос, поэтому ниже приводится пример того, как это сделать с наименьшим количеством телодвижений.
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
Покинул форум
1940 / 816 / 233
Регистрация: 07.05.2015
Сообщений: 1,640
15.11.2016, 15:36 #182
Как программно вызвать одно из пунктов контекстного меню консоли?

Что-то очень много вопросов в ящике именно о консоли... На сей раз довольно много насчитал сообщений с вопросом о том, возможен ли скролл консоли без мыши, - как "Прокрутить" в меню по 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
Покинул форум
1940 / 816 / 233
Регистрация: 07.05.2015
Сообщений: 1,640
21.12.2016, 19:37 #183
Свойство 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
Покинул форум
1940 / 816 / 233
Регистрация: 07.05.2015
Сообщений: 1,640
29.12.2016, 11:26 #184
Как получить список альясов (макросов) консольных команд?

Заядлые консольщики обычно держат под рукой файл макросов команд, набор которых в консоли обычно занимает некоторое время; макросы же позволяют снизить это время за счет, например:
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
Покинул форум
1940 / 816 / 233
Регистрация: 07.05.2015
Сообщений: 1,640
08.03.2017, 22:06 #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
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
Покинул форум
1940 / 816 / 233
Регистрация: 07.05.2015
Сообщений: 1,640
21.03.2017, 20:08 #186
Вычисление энтропии строки

Энтропия по Шеннону, как оговорка по Фрейду. Но это так, к слову. Ниже пример реализации вычисления оной.
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
6349 / 3553 / 1458
Регистрация: 11.02.2013
Сообщений: 7,830
Завершенные тесты: 3
17.06.2017, 20:21 #187
Как сделать курсор из битмапа?

Точка клика в центре битмапа
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
6349 / 3553 / 1458
Регистрация: 11.02.2013
Сообщений: 7,830
Завершенные тесты: 3
25.07.2017, 16:53 #188
Экспорт содержимого контрола, в данном случае 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.
10
Изображения
 
Вложения
Тип файла: zip ExportListViewSolution.zip (49.5 Кб, 22 просмотров)
maks123123124
3 / 2 / 0
Регистрация: 25.06.2017
Сообщений: 34
Записей в блоге: 1
08.08.2017, 01:35 #189
Выключение или перезагрузка ПК

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

Закрыть окно
Кликните здесь для просмотра всего текста
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
Модератор
Эксперт .NET
2364 / 2169 / 346
Регистрация: 27.01.2014
Сообщений: 3,898
Завершенные тесты: 1
01.11.2017, 13:14 #191
В данном посте решил собрать различные приемы для запуска своей (и не только) программы от имени администратора.
(Вопрос часто поднимается многими начинающими программистами, поэтому решил вынести ответ на него здесь)

Корректировка манифеста исполняемого файла:
Кликните здесь для просмотра всего текста
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)
7
Yury Komar
Модератор
Эксперт .NET
2364 / 2169 / 346
Регистрация: 27.01.2014
Сообщений: 3,898
Завершенные тесты: 1
29.12.2017, 19:08 #192
DTL, EVT File Reader

По мотивам найденного кода в сети и его копии на данном форуме сваял методы чтения бинарных файло DTL и EVT.
На самом деле в сети нет никакой информации по формату данных файлов, ну или я не смог найти. Долго мучился с ними, так как есть проекты, которын грузят данные выборок с PLC в базу данных ПО и без ужасных костылей не обходилось, что очень тормозило процесс импорта данных в базу.

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

DTLreader.vb
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
'// This code helps programmer to retrive a data from *DTL files.
'// The author of this code is Yury, Komar.
'// Public Function ReadDTL retirns a DataTable.
Module DtlReader
    Enum ValueType
        Int16_BCD_Unsigned = 0
        Int16_BCD_Signed = 1
        Int16_Unsigned = 2
        Int16_Signed = 3
        Int32_Unsigned = 4
        Int32_Signed = 5
        Float32 = 6
        String_ = 7
    End Enum
    Structure DTLColumn
        Public Type As ValueType, Size As Integer, Name As String
    End Structure
    Structure DTLHeader
        Public Sign As Integer, Undef1 As Integer, Date2 As Integer, FieldsCount As Integer, Count2 As Integer
        Public Columns() As DTLColumn
    End Structure
    Structure DTLRow
        Public Date_ As DateTime, Cells() As Object
    End Structure
 
    Public Function ReadDTL(FileName As String) As DataTable
        Dim newDT As New DataTable
        Using BinReader = New IO.BinaryReader(New IO.FileStream(FileName, IO.FileMode.Open, IO.FileAccess.Read), System.Text.Encoding.Default)
            Dim Header As DTLHeader
            Dim Rows As New DTLRow()
 
            'Read Header------------------------------------------------------------------------------------------------
            Header.Sign = BinReader.ReadInt32 'Not using in this code
            Header.Undef1 = BinReader.ReadInt32 'Not using in this code
            Header.Date2 = BinReader.ReadInt32 'Not using in this code
            Header.FieldsCount = BinReader.ReadInt32 'Read Columns number (+4 bytes)
            Header.Count2 = BinReader.ReadInt32 * 2 'Not using in this code
            Header.Columns = New DTLColumn(Header.FieldsCount - 1) {} 'Create empty array of Columns
            For i = 0 To Header.Columns.Count - 1 'Read each column's Type and Size
                Header.Columns(i).Type = BinReader.ReadInt32
                Header.Columns(i).Size = BinReader.ReadInt32
            Next
            BinReader.BaseStream.Position += 4 'skip 4 bytes
            For i = 0 To Header.Columns.Count - 1
                Header.Columns(i).Name = System.Text.Encoding.UTF8.GetString(BinReader.ReadBytes(BinReader.ReadInt16))
                'MsgBox(Header.Columns(i).Name & vbCrLf & Header.Columns(i).Type) 'Check ColumnHeader Name and Type
            Next
 
            'Create DataTable Columns-------------------------------------------------------------------------------------
            newDT.Columns.Add("DateTime", GetType(System.DateTime))
            For Each f In Header.Columns
                If f.Type.ToString.Length > 0 Then newDT.Columns.Add(f.Name & StrDup(newDT.Columns.Count, vbNullChar))
            Next
 
            'ReadRowData ------------------------------------------------------------------------------------------------
            Do Until BinReader.BaseStream.Position = BinReader.BaseStream.Length
                Rows.Date_ = New DateTime(1970, 1, 1).AddSeconds(BinReader.ReadInt32).AddMilliseconds(BinReader.ReadByte)
                Rows.Cells = New Object(Header.Columns.Count - 1) {}
                For i = 0 To Header.Columns.Count - 1
                    Select Case Header.Columns(i).Type
                        Case ValueType.Int16_BCD_Unsigned
                            Rows.Cells(i) = BinReader.ReadInt16
                        Case ValueType.Int16_BCD_Signed
                            Rows.Cells(i) = BinReader.ReadInt16
                        Case ValueType.Int16_Signed
                            Rows.Cells(i) = BinReader.ReadInt16
                        Case ValueType.Int16_Unsigned
                            Rows.Cells(i) = BinReader.ReadInt16
                        Case ValueType.Int32_Signed
                            Rows.Cells(i) = BinReader.ReadInt32
                        Case ValueType.Int32_Unsigned
                            Rows.Cells(i) = BinReader.ReadInt32
                        Case ValueType.Float32
                            Rows.Cells(i) = BinReader.ReadSingle
                        Case ValueType.String_
                            Rows.Cells(i) = System.Text.Encoding.UTF8.GetString(BinReader.ReadBytes(Header.Columns(i).Size * 2))    'Read String with length * 2
                    End Select
                Next
 
                'Construct a new row and add it to the table-----------------------------------------------------------
                Dim Params As New List(Of Object)
                Params.Add(Rows.Date_)
                Params.AddRange((From r In Rows.Cells Where Not r Is Nothing).ToList)
                newDT.Rows.Add(Params.ToArray)
            Loop
        End Using
        Return newDT
        newDT.Dispose()
        GC.Collect()
    End Function
End Module

EVTreader.vb
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
'// This code helps programmer to retrive a data from *EVT files.
'// The author of this code is Yury, Komar.
'// Public Function ReadEVT retirns a DataTable.
Module EVTreader
    Structure EVTHeader
        Public Sign, Undef1, Date2, Count As Integer
    End Structure
    Structure EVTRow
        Public Date_ As DateTime, Evnt As Byte, Catgry As Byte, Msg As String
    End Structure
 
    Public Function ReadEVT(FileName As String) As DataTable
        Dim newDT As New DataTable
        Using BinReader = New IO.BinaryReader(New IO.FileStream(FileName, IO.FileMode.Open, IO.FileAccess.Read), System.Text.Encoding.Default)
            Dim Header As EVTHeader
            Dim Rows As New EVTRow()
 
            'Read Header------------------------------------------------------------------------------------------------
            Header.Sign = BinReader.ReadInt32 'Not using in this code
            Header.Undef1 = BinReader.ReadInt32 'Not using in this code
            Header.Date2 = BinReader.ReadInt32 'Not using in this code
            Header.Count = BinReader.ReadInt32 '* 2 'Not using in this code
 
            'Create DataTable Columns-------------------------------------------------------------------------------------
            newDT.Columns.Add("DateTime", GetType(System.DateTime))
            newDT.Columns.Add("Event") ', GetType(System.DateTime))
            newDT.Columns.Add("Category") ', GetType(System.DateTime))
            newDT.Columns.Add("Message", GetType(System.String))
 
            'ReadRowData ------------------------------------------------------------------------------------------------
            Do Until BinReader.BaseStream.Position = BinReader.BaseStream.Length
                Rows.Date_ = New DateTime(1970, 1, 1).AddSeconds(BinReader.ReadInt32)
                Rows.Evnt = BinReader.ReadByte
                Rows.Catgry = BinReader.ReadByte
                Rows.Msg = System.Text.Encoding.UTF8.GetString(BinReader.ReadBytes(BinReader.ReadByte))
 
                'Construct a new row and add it to the table-----------------------------------------------------------
                Dim Params As New List(Of Object)
                Params.Add(Rows.Date_)
                Params.Add(Rows.Evnt)
                Params.Add(Rows.Catgry)
                Params.Add(Rows.Msg)
                newDT.Rows.Add(Params.ToArray)
            Loop
        End Using
        Return newDT
        newDT.Dispose()
        GC.Collect()
    End Function
End Module
8
Вложения
Тип файла: zip DTL Reader 1.0.1.zip (631.9 Кб, 7 просмотров)
GSXL
160 / 164 / 26
Регистрация: 26.11.2011
Сообщений: 380
Записей в блоге: 1
06.04.2018, 17:07 #193
SQLite, создание базы данных, установка, изменение и удаления пароля.

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
Imports System.Data.SQLite
Public Class Form1
 
    Dim PASSW As String
 
    Private Sub Button1_Click() Handles Button1.Click
 
 
        Dim sqConnection As New SQLiteConnection("Data Source=" & My.Computer.FileSystem.SpecialDirectories.Desktop & "\my_SQLite_DB.sqlite;Version=3;")
 
        sqConnection.Open()
 
        Dim sqCommand As New SQLiteCommand()
        sqCommand.Connection = sqConnection
        Dim myTrans As SQLiteTransaction
        myTrans = sqConnection.BeginTransaction()
        sqCommand.Transaction = myTrans
 
        Try
            sqCommand.CommandText = "CREATE TABLE 'Dept2' ('id' INTEGER PRIMARY KEY AUTOINCREMENT, 'rand' TEXT);"
            sqCommand.ExecuteNonQuery()
 
            For i = 1 To 1000
                sqCommand.CommandText = "INSERT INTO 'Dept2' ('rand') Values ('" & "Запись № " & i & "');"
                sqCommand.ExecuteNonQuery()
            Next
 
            myTrans.Commit()
            MsgBox("Ок")
        Catch e As Exception
            myTrans.Rollback()
            MsgBox(e.Message, MsgBoxStyle.Critical, "Ошибка")
        Finally
            sqConnection.Close()
        End Try
 
    End Sub
 
    Private Sub Button2_Click() Handles Button2.Click
        On Error Resume Next
        Dim SQL_COM As String
        Dim con As New SQLiteConnection("Data Source=" & My.Computer.FileSystem.SpecialDirectories.Desktop & "\my_SQLite_DB.sqlite; Version=3" & "; Password=" & PASSW & ";")
 
        SQL_COM = "SELECT * FROM Dept2 WHERE `id` = '160';"
 
        Dim sqlCom As New SQLiteCommand(SQL_COM, con)
        con.Open()
        'con.ChangePassword("")
        Dim SQLreader As SQLiteDataReader = sqlCom.ExecuteReader()
 
        If Err.Number <> 0 Then
            MsgBox("Ошибка " & Err.Number & ". " & Err.Description, MsgBoxStyle.Critical, "")
        Else
 
            While SQLreader.Read()
                MsgBox(SQLreader("rand"))
            End While
 
        End If
        con.Close()
    End Sub
 
    Private Sub Button3_Click() Handles Button3.Click
        On Error Resume Next
        Dim SQL_COM As String
        Dim con As New SQLiteConnection("Data Source=" & My.Computer.FileSystem.SpecialDirectories.Desktop & "\my_SQLite_DB.sqlite; Version=3" & "; Password=" & PASSW & ";")
 
        con.Open()
        PASSW = InputBox("Введите новый пароль для БД или оставьте пустым если пароль не нужен.", "")
        con.ChangePassword(PASSW)
 
        con.Close()
    End Sub
 
    Private Sub Button4_Click() Handles Button4.Click
        On Error Resume Next
        Dim SQL_COM As String
        Dim con As New SQLiteConnection("Data Source=" & My.Computer.FileSystem.SpecialDirectories.Desktop & "\my_SQLite_DB.sqlite; Version=3" & "; Password=" & PASSW & ";")
 
        con.Open()
 
        con.ChangePassword("")
 
        con.Close()
    End Sub
 
    Private Sub Button5_Click() Handles Button5.Click
        On Error Resume Next
        Dim SQL_COM As String
        Dim con As New SQLiteConnection("Data Source=" & My.Computer.FileSystem.SpecialDirectories.Desktop & "\my_SQLite_DB.sqlite; Version=3;")
 
        PASSW = InputBox("Введите пароль для БД или оставьте пустым если пароль не нужен.", "")
 
        con.Open()
        con.ChangePassword(PASSW)
        con.Close()
    End Sub
 
End Class
2
Миниатюры
Visual Basic .NET FAQ. Готовые решения, полезные коды  
Вложения
Тип файла: zip SQLite password.zip (1.37 Мб, 19 просмотров)
Sklifosofsky
749 / 685 / 171
Регистрация: 29.09.2015
Сообщений: 833
09.05.2018, 19:46 #194
Как открыть через оболочку Windows папку (и выделить в ней требуемые элементы)
Метод Shell.OpenFolderAndSelectItems(String, String[])

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
Module Shell
    Private Declare Auto Function _SHOpenFolderAndSelectItems Lib "Shell32.dll" Alias "SHOpenFolderAndSelectItems" _
        (pidlFolder As IntPtr, cidl As UInt32, <MarshalAs(UnmanagedType.LPArray)> apidl() As IntPtr, dwFlags As UInt32) As Int32
 
    Private Declare Auto Function _SHParseDisplayName Lib "Shell32.dll" Alias "SHParseDisplayName" _
        (<MarshalAs(UnmanagedType.LPWStr)> pszName As String, pbc As IntPtr, ByRef ppidl As IntPtr, sfgaoIn As UInt32, ByRef psfgaoOut As UInt32) As Int32
 
    ''' <summary>
    ''' Открывает через оболочку Windows указанный путь и выделяет элементы из коллекции имен
    ''' </summary>
    ''' <param name="Path">Путь к папке или файлу</param>
    ''' <param name="ItemNames">Коллекция имен выделяемых элементов в папке (Path)</param>
    ''' <remarks>Если указан только Path, то откроется родительская папка в которой находится этот элемент</remarks>
    Public Sub OpenFolderAndSelectItems(Path As String, ParamArray ItemNames() As String)
        Dim hResulut As Int32
        Dim pidlFolder As IntPtr
 
        hResulut = _SHParseDisplayName(Path, IntPtr.Zero, pidlFolder, 0, 0)
        Marshal.ThrowExceptionForHR(hResulut)
 
        Dim count As Int32 = CInt(If(ItemNames IsNot Nothing, ItemNames.Length, 0))
 
        Dim pidlCollection() As IntPtr = New IntPtr(count - 1) {}
 
        For i As Integer = 0 To count - 1
            hResulut = _SHParseDisplayName(IO.Path.Combine(Path, ItemNames(i)), IntPtr.Zero, pidlCollection(i), 0, 0)
            Marshal.ThrowExceptionForHR(hResulut)
        Next
 
        hResulut = _SHOpenFolderAndSelectItems(pidlFolder, CUInt(count), pidlCollection, 0)
        Marshal.ThrowExceptionForHR(hResulut)
    End Sub
End Module
3
ViterAlex
6349 / 3553 / 1458
Регистрация: 11.02.2013
Сообщений: 7,830
Завершенные тесты: 3
21.06.2018, 23:44 #195
Экспорт данных в документ Word
Ещё один вариант переноса значений в Word. Используется шаблон документа с закладками. Работает через OpenXml, поэтому только с форматом .docx. Не требует установленного Word.
Закладки могут иметь форматирование, но единое в пределах всей закладки. В противном случае, форматирование пропадёт.
В конечном документе закладки остаются.
Кликните здесь для просмотра всего текста
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 DocumentFormat.OpenXml.Packaging
Imports DocumentFormat.OpenXml.Wordprocessing
 
Public Class DocumentFilling
    ''' <summary>
    ''' Заполнение документа на основе шаблона с закладками
    ''' </summary>
    ''' <param name="filename">Имя конечного документа.</param>
    ''' <param name="templatePath">Путь к шаблону.</param>
    ''' <param name="data">Словарь изменяемых закладок. Key — имя закладки, Value — новое значение.</param>
    Public Shared Sub Fill(filename As String, templatePath As String, data As IDictionary(Of String, String))
        Using doc = WordprocessingDocument.CreateFromTemplate(templatePath)
            ChangeBookmarks(doc, data)
            doc.SaveAs(filename)
        End Using
    End Sub
 
    Private Shared Sub ChangeBookmarks(doc As WordprocessingDocument, data As IDictionary(Of String, String))
        'Извлечение всех закладок в словарь с ключём по имени закладки
        Dim bm = doc.MainDocumentPart.RootElement.Descendants(Of BookmarkStart) _
            .ToDictionary(Function(bms)
                              Return bms.Name.ToString()
                          End Function)
 
        For Each item In data
            'Находим у закладки текстовую часть
            Dim r = bm(item.Key).NextSibling(Of Run)()
            If r IsNot Nothing Then
                'Удаляем текст закладки
                r.RemoveAllChildren(Of Text)()
                'Добавляем новый текст
                r.AppendChild(New Text(item.Value))
            End If
        Next
    End Sub
 
End Class

В приложенном файле проект библиотеки, пример использования в WinForms и тесты. После открытия решения нужно восстановить пакеты NuGet
2
Вложения
Тип файла: zip DocumentFilling.zip (48.5 Кб, 4 просмотров)
21.06.2018, 23:44
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
21.06.2018, 23:44
Привет! Вот еще темы с решениями:

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

Как в Visual Basic .NET использовать CentimetersToPoints
В Visual Basic 6 можно было перевести сантиметры в пункты подобным образом...

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

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


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

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

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