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

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

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

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

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

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


Примечание: некоторые коды приведены без учета строгой типизации (Параметр Strict), поэтому для их использования необходимо выполнить приведение типов
52
QA
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
18.08.2011, 22:44
Ответы с готовыми решениями:

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

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

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

Арктангенс в Visual Basic .NET?
Здравствуйте всем! Как? Как его получить? В классе Math его нет......

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

211
Маршинин
52 / 52 / 1
Регистрация: 05.12.2012
Сообщений: 167
Записей в блоге: 1
16.03.2015, 23:29 141
Как запустить программу в скрытом режиме (Без Hide, и мигания формы при запуске программы)

И так для того что бы сделать запуск программы не видимым для пользователя нам нужно:
1) Перейти в свойства программы -> Нажать на вкладку: Приложение -> Поставить галочку: Создать приложение, допускающее одновременное выполнения только одной своей копии
2) Нажать на кнопку: Просмотреть события приложения
3) Вставить данный код

Пояснение:
Form1 - название моей первой формы при запуске
"-hide" - аргумент командной строки

vb.net
1
2
3
4
5
6
7
8
9
 Private Sub MyApplication_Startup(ByVal sender As Object,ByVal e As Microsoft.VisualBasic.ApplicationServices.StartupEventArgs) Handles Me.Startup
            If Not Command$() = Nothing Then
                If Command$() = "-hide" Then
                    Form1.WindowState = FormWindowState.Minimized
                    Form1.ShowInTaskbar = False
                    Form1.NotifyIcon1.Visible = True
                End If
 
            End If
Примечание: как вы будете запускать программу при запуске Windows это ваши проблемы =)
9
Yury Komar
Модератор
Эксперт .NET
2956 / 2681 / 431
Регистрация: 27.01.2014
Сообщений: 4,952
26.03.2015, 14:50 142
Скрыть\Показать Вкладку в TabControl.

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

И тут я изобрел метод который проверяет наличие вкладки в TabContol коллекции, и либо показывает ее либо скрывает, избегая ошибок если вкладка вдруг уже присутствует а мы еще раз ее добавлять пытаемся и так же при удалении, если нет вкладки то и удалять не станем, если есть, то удаляем.
Очень даже неплохо получилось, вынес все в отдельный метод.

vb.net
1
2
3
4
5
6
7
8
9
10
11
Public Sub TabManager(ByVal TabControlName As TabControl, ByVal TabPageName As Control, ByVal ShowHide_True_False As Boolean, ByVal Index As Integer)
        If ShowHide_True_False = True Then
            If Not TabControlName.Contains(TabPageName) Then
                TabControlName.TabPages.Insert(Index, TabPageName)
            End If
        ElseIf ShowHide_True_False = False Then
            If TabControlName.Contains(TabPageName) Then
                TabControlName.TabPages.Remove(TabPageName)
            End If
        End If
    End Sub
Пример того, как пользоваться данным методом:
vb.net
1
2
TabManager(TabControl1, TabPage1, False, 0) 'Скрывает вкладку
TabManager(TabControl1, TabPage1, True, 0) 'Показывает вкладку
12
klioff
Заблокирован
05.05.2015, 09:10 143
Расширение для Internet Explorer

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

Как устроены расширения в браузерах и как они устроены в IE?


В нормальных браузерах (Chrome, Firefox, Opera) логика расширений пишется на JS, интерфейс (например, тулбары) - на HTML+CSS. При этом используются особые API данного браузера.
Создание расширений к этим браузерам подробно описано в моей старой статье

В IE все через жкардинально отличается. Расширение к IE (так называемый Browser Helper Object) - это DLL. Написать эту DLL, в принципе, можно на любом компилируемом языке, и VB.NET не исключение. Естественно, DLL будет требовать .NET Framework и сможет использовать любые классы .NET, как и обычная библиотека классов .NET.

Чтобы иметь доступ к IE, эта DLL должна содержать COM-класс, унаследованный от стандартного COM-интерфейса IObjectWithSite, и содержащий имплементации определенных его методов - GetSite и SetSite.
В методе SetSite мы получаем объект браузера, который можем привести к типу WebBrowser (не к обычному System.Windows.Forms.WebBrowser, но к похожему на него SHDocVw.WebBrowser). Далее с этим WebBrowser можно взаимодействовать, как будто бы мы его сами создали в своем приложении.
Чтобы библиотека работала, ее еще сперва надо зарегистрировать как COM-сборку (нужны права админа). И прописать в особой ветке реестра, иначе IE о ней не узнает. Но обо все по порядку.



Предупреждение
Объем дальнейшей статьи вас "приятно" удивит, особенно если ранее писали расширения для нормальных браузерах.
Помимо того, что в IE все так долго и нудно, он еще и не умеет толком сообщать о различных ошибках, как мы привыкли видеть это в .NET и в норм браузерах. Если вы что-то сделаете не так, то в лучшем случае расширение просто не запустится или не сработает, а в худшем - все это убожество тупо упадет с окошком "Прекращена работа программы".
Не занимайтесь профессиональной разработкой расширений (фриланс и т.д.), пока не приобретете должный опыт в COM вообще и в BHO в частности.
На фрилансе не стесняйтесь брать хорошие бабки (тысячи, а то и десятки тысяч руб), а также дедик, если у вас мало компов для тестирования. И сроки тоже должны быть большими. Месяц для новичка в BHO, 1-2 недели для профи.
Короче - IE - это надолго!

Создание DLL

1. Запустите Visual Studio. Создайте проект типа "Библиотека классов". Назовите его, скажем, MyFirstBHO.
2. Сперва нужно "импортировать" стандартный интерфейс IObjectWithSite. Для этого файл Class1.vb переименуйте в IObjectWithSite.vb и замените его содержимое на такой код:
vb.net
1
2
3
4
5
6
7
8
9
10
11
12
13
14
Imports System.Runtime.InteropServices
 
<ComVisible(True), _
InterfaceType(ComInterfaceType.InterfaceIsIUnknown), _
Guid("FC4801A3-2BA9-11CF-A229-00AA003D7352")> _
Public Interface IObjectWithSite
 
  <PreserveSig()> _
  Function SetSite(<MarshalAs(UnmanagedType.IUnknown)> ByVal site As Object) As Integer
 
  <PreserveSig()> _
  Function GetSite(ByRef guid As Guid, ByRef ppvSite As IntPtr) As Integer
 
End Interface
GUID "FC4801A3-2BA9-11CF-A229-00AA003D7352" - стандартный. Именно по нему осуществляется "импорт" того или иного интерфейса
3. Теперь от данного интерфейса нужно унаследовать COM-видимый класс, в котором обязательно реализовать оба метода интерфейса, и задать этому классу уникальный GUID, который можно сгенерировать, например, здесь: https://www.guidgenerator.com/online-guid-generator.aspx
У нас это будет 6af768d9-6c98-4fb9-8b2f-05fb4c44f983
Имя класса - неважно. Пусть будет MyBHO. Содержимое файла MyBHO.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
Imports System.Runtime.InteropServices
 
<ComVisible(True), _
ClassInterface(ClassInterfaceType.None), _
Guid("6af768d9-6c98-4fb9-8b2f-05fb4c44f983")> _
Public Class MyBHO
  Implements IObjectWithSite
 
  Private wb As SHDocVw.WebBrowser ' !!! ВНИМАНИЕ - ДОБАВЬТЕ ССЫЛКУ НА 
                                   ' !!! C:\windows\system32\mshtml.tlb (или *.dll - если получится)
                                   ' и на C:\windows\system32\shdocwv.dll !!!
 
  Public Sub OnBeforeNavigate2(ByVal pDisp As Object, ByRef URL As Object, _
   ByRef Flags As Object, ByRef TargetFrameName As Object, ByRef PostData As Object, ByRef Headers As Object, _
   ByRef Cancel As Boolean)
    ' покажем месседжбокс с URLом загруженной страницы
    MsgBox("URL: " + URL.ToString(), , "Ура, работает!")
 
    ' также можно сделать так
    ' Dim doc = DirectCast(wb.Document, mshtml.HTMLDocument)
    ' и далее через doc взаимодействовать с HTML, см. статью
    ' [url]https://www.cyberforum.ru/post6375281.html[/url]
    ' но это лучше делать в DocumentComplete
  End Sub
 
  Public Function SetSite(ByVal site As Object) As Integer Implements IObjectWithSite.SetSite
 
    If site IsNot Nothing Then
 
      wb = DirectCast(site, SHDocVw.WebBrowser)
 
      AddHandler wb.BeforeNavigate2, New SHDocVw.DWebBrowserEvents2_BeforeNavigate2EventHandler(AddressOf Me.OnBeforeNavigate2)
 
    Else
 
      RemoveHandler wb.BeforeNavigate2, New SHDocVw.DWebBrowserEvents2_BeforeNavigate2EventHandler(AddressOf Me.OnBeforeNavigate2)
      wb = Nothing
 
    End If
 
    Return 0
  End Function
 
  Public Function GetSite(ByRef guid As Guid, ByRef ppvSite As IntPtr) As Integer Implements IObjectWithSite.GetSite
    Dim punk As IntPtr = Marshal.GetIUnknownForObject(wb)
    Dim hr As Integer = Marshal.QueryInterface(punk, guid, ppvSite)
    Marshal.Release(punk)
    Return hr
  End Function
 
  <ComRegisterFunction()> _
  Public Shared Sub RegisterBHO(ByVal type As Type)
    ' Это обработчик события регистрации нашей библиотеки (об этом ниже)
    MsgBox("Наше COM-сборка успешно зарегистрирована!")
  End Sub
 
  <ComUnregisterFunction()> _
  Public Shared Sub UnregisterBHO(ByVal type As Type)
    ' Это обработчик события де-регистрации нашей библиотеки (об этом тоже ниже)
    ' Можно сюда написать какой-нибудь код
  End Sub
End Class
Метод SetSite - это своего рода обработчик некоего события. Когда расширение, установленное в IE, загрузится - для каждой вкладки браузера будет вызываться этот метод, и через аргумент site в него будет передаваться объект нативного интерфейса SHDocVw::IWebBrowser2, находящийся в данной вкладке IE. Таким образом мы и сможем взаимодействовать с IE.
4. Построим библиотеку. Разрядность библиотеки должна быть Any CPU или x86. IE имеет 2 версии - x86 и x64. Да и винда как бы тоже И x86 совместим с x64, но не наоборот. Поэтому делать x64 не советую.
5. Внимание: далее качаем Microsoft.mshtml.dll и кладем эту библиотеку рядом с нашей DLL. Там же должна лежать и Interop.SHDocVw.dll (если ее там нет - кладем ее туда). Иначе может не работать на компах, где нет Visual Studio!


Установка DLL в IE

1. Сперва надо зарегистрировать библиотеку как COM-сборку. Это делается утилитой RegAsm, которая входит в .NET Framework.
Для этого создадим такой батник:
[BAT]C:\Windows\Microsoft.NET\Framework\v4.0.30319\regasm.exe /codebase "D:\MyFirstBHO.dll"
pause[/BAT]
Внимание:
1.1. Путь к RegAsm.exe должен быть путем к фреймворку не ниже, чем фреймворк, под который написана библиотека.
1.2. Путь к DLL ("D:\MyFirstBHO.dll") должен быть абсолютным и не содержать кириллицы. Не случайно я ее закинул на диск D.
1.3. Рядом с этой DLL обязательно должны лежать библиотеки Microsoft.mshtml.dll и Interop.SHDocVw.dll (см. выше), иначе COM-сборка зарегистрируется успешно, но в IE может не работать!
1.4. Если вы все же скомпилировали DLL в x64, то и RegAsm нужен тоже x64, т.е. "Framework64", вместо "Framework".
2. Запустим батник от имени администратора.
3. Если появился MsgBox "Наша COM-сборка успешно зарегистрировано!", а текст в консоли содержит строчку "Типы зарегистрированы успешно" и warning про "регистрацию неподписанной сборки", то библиотека успешно зарегистрирована как COM. Идем далее.
4. Теперь надо установить DLL в IE. Если у нас x86, то идем по пути HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer, если x64 - то по пути HKEY_LOCAL_MACHINE\SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Explorer
Короче, если присутствует второй путь, то идем по нему, если нет - то по первому.
5. Заходим в папку (раздел) Browser Helper Objects. Если такого раздела нет, то создаем его.
6. В этой папке создаем подпапку. Имя подпапки - это GUID из класса MyBHO (не путать с интерфейсом!), заключенный в фигурные скобки. В моем случае - {6af768d9-6c98-4fb9-8b2f-05fb4c44f983}
7. Наконец, запускаем IE.
Если появится окошко "включить ли такую-то надстройку" (у меня появилось на другом компе), жмем "Включить".
Заходим на какую-нибудь страницу или просто открываем пустую вкладку - видим обещанный MsgBox.


Если мы изменили DLL, то нужно ли ее заново регистрировать и устанавливать в IE?

Нет, ничего этого не нужно. Ну разве что если изменили GUID. Или добавили новый COM-класс. Или еще типа такого.


На закуску

Домашнее задание
Напишите инсталлятор, позволяющий автоматизировать всю эту нудятину с регистрацией и установкой.
1
Вложения
Тип файла: zip MyFirstBHO.zip (3.39 Мб, 55 просмотров)
Yury Komar
Модератор
Эксперт .NET
2956 / 2681 / 431
Регистрация: 27.01.2014
Сообщений: 4,952
12.05.2015, 06:18 144
Определение Медианы одномерного массива чисел

Пишу программу по статистике и вот возник вопрос определения медианы массива. Своей функции VB.NET увы не имеет, но есть отличный вариант решения этого вопроса:

vb.net
1
2
3
4
5
6
7
8
9
10
11
12
    Public Function Median(ByVal MyArray As Double()) As Double
        Dim size As Integer = MyArray.Length
        If size = 0 Then Return 0
 
        Array.Sort(MyArray) 'обязательная сортировка массива
 
        If size Mod 2 = 0 Then
            Return (MyArray(CInt(size / 2) - 1) + MyArray(CInt(size / 2))) / 2
        Else
            Return MyArray(CInt(Math.Floor(size / 2)))
        End If
    End Function

Либо то же самое, но через LINQ (кому как нравится, но результат тот же):

vb.net
1
2
3
4
5
6
7
8
9
10
11
12
Dim numbers() As Integer = {4, 4, 4, 4, 3, 2, 2, 2, 1}
Dim numberCount As Integer = numbers.Count 
Dim halfIndex As Integer = numbers.Count \ 2 
Dim sortedNumbers = numbers.OrderBy(Function(n) n) 
Dim median As Double 
If (numberCount Mod 2 = 0) Then 
    median = (sortedNumbers.ElementAt(halfIndex) + sortedNumbers.ElementAt(halfIndex – 1)) / 2 
Else 
    median = sortedNumbers.ElementAt(halfIndex) 
End If 
 
Debug.WriteLine("Median is: " & median)
6
diadiavova
4195 / 1562 / 472
Регистрация: 11.04.2015
Сообщений: 2,848
Записей в блоге: 36
21.05.2015, 11:24 145
Перекодирование текста, напечатанного в неправильной раскладке

Собственно суть вопроса в том, как текст, набранный правильно, но при неправильной раскладке клавиатуры перекодировать в нужную раскладку. По сути то же самое, что делает PuntoSwitcher, но только более универсально, для любых раскладок. То что "накопал" по этому вопросу постараюсь предельно просто изложить.

Каждая раскладка имеет собственное уникальное имя. Имя раскладки представляет из себя строку, состоящую из набора цифр. Например для английской раскладки (основной в Windows) это имя - 00000409, для русской - 00000419. С ними мы пока и будем проводить проверку.

Каждая клавиша на клавиатуре имеет свой уникальный код, причем она выдает именно этот код, независимо от раскладок и чего бы то ни было. Клавиатура вообще "не знает" ровным счетом ничего о раскладках или любых других настройках компьютера. Но получив код от клавиатуры, операционная система уже сама интерпретирует его в соответствии с активной раскладкой клавиатуры и таким образом в текстовое поле могут вводиться разные символы, реагируя на одну и ту же клавишу.

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

Нам надо импортировать пространства имен
vb.net
1
2
Imports System.Runtime.InteropServices
Imports System.Text
Для получения кодов клавиш по символам и раскладке нам понадобится следующая функция
vb.net
1
2
3
    <DllImport("user32.dll")> _
    Private Function VkKeyScanEx(ch As Char, dwhkl As IntPtr) As Short
    End Function
Она принимает символ и указатель раскладки. Но у нас раскладки даны не в указателях, а в именах, поэтому для получения указателя по имени нам нужна еще такая функция
vb.net
1
2
3
    <DllImport("user32")>
    Function LoadKeyboardLayout(pwszKLID As String, Flags As UInteger) As IntPtr
    End Function
Первый ее параметр - это как раз имя раскладки, вторму можно передавать ноль.
Еще, для того, чтобы получить символ Юникода из кода клавиши и раскладки нам потребуется импортировать еще одну функцию из библиотеки user32
vb.net
1
2
3
4
5
6
7
8
9
10
    Public Declare Function ToUnicodeEx Lib "user32" (
        wVirtKey As UInteger,
        wScanCode As UInteger,
        lpKeyState As Byte(),
        <Out()>
        <MarshalAs(UnmanagedType.LPWStr, SizeConst:=64)>
        ByVal lpChar As System.Text.StringBuilder,
        cchBuff As Integer,
        wFlags As UInteger,
        dwhkl As IntPtr) As Integer
С импортом пока все. Теперь можно писать основной код. Главная функция, в которой будет происходить вся магия, будет принимать три аргумента: собственно строку для перекодирования, а так же исходную и целевую раскладки в виде указателей.
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
    Function ConvertStringByKeyboardLayout(srcStr As String, LayoutFrom As IntPtr, LayoutTo As IntPtr) As String
        Dim result As New StringBuilder
        For Each c As Char In srcStr
            Dim keyScan = VkKeyScanEx(c, LayoutFrom)
            If keyScan = -1 Then
                result.Append(c)
                Continue For
            End If
            Dim keydead = BitConverter.GetBytes(keyScan)(1)
            Dim keyState(255) As Byte
            If keydead And 1 Then
                keyState(16) = 255
            End If
            If keydead And 2 Then
                keyState(17) = 255
            End If
            If keydead And 4 Then
                keyState(18) = 255
            End If
            Dim sbstring As New StringBuilder
            ToUnicodeEx(keyScan, 0, keyState, sbstring, 5, 0, LayoutTo)
            result.Append(sbstring.ToString)
        Next
        Return result.ToString
    End Function
Поясню, что здесь происходит. Поскольку встроенные механизмы операционной системы обрабатывают сигналы с клавиатуры по одному, у нас есть инструменты для обработки отдельных символов, а не всей строки целиком. Таким образом, полученную строку мы обходим посимвольно в цикле, перекодируем каждый символ и добавляем результат в объект StringBuilder под названием result. Сначала нам надо получить код символа и мы для этой цели применяем VkKeyScanEx, передавая ей символ и исходную раскладку клавиатуры. Функция может возвратить либо код символа, либо -1. Последнее означает, что такого символа в данной раскладке нет. Мы проверяем keyScan на равенство -1 и далее можно поступить по-разному, я просто добавляю символ без обработки в выходную коллекцию и перехожу к следующей итерации. Надо сказать, что у такого подхода есть недостатки, поскольку неизвестно, был ли символ перекодирован, а кроме того, многие символы есть в разных раскладках(например знаки препинания) но расположены они в них на разных клавишах, а это может привести к некорректной замене символа. Можно сделать так, чтобы в этом случае выбрасывалось исключение или возвращалась пустая строка. Можно добавить в функцию еще один параметр, который будет определять, как функция должна вести себя в подобных случаях. Тут уже кому как удобнее.
Относительно переменной keyDead. Здесь опять-таки нужно небольшое пояснение. Код любой клавиши на клавиатуре - это один байт. Этого вполне достаточно, поскольку на любой клавиатуре клавиш чуть больше ста, а байт дает 256 комбинаций. Тем не менее скан клавиши имеет тип Short, а не байт и занимает такое число два байта вместо одного. При этом первый байт - это собственно код клавиши, а второй - это флаги клавиш-модификаторов. И в этом втором байте первый бит, установленный в 1 означает, что нажата клавиша Shift (в принципе нас в основном это и интересует, поскольку от этого зависит регистр символа). Второй - Ctrl. Третий - Alt. Четвертый - Hankaku(что-то нужное для ввода символов азиатских алфавитов). Остальные зарезервированы и из назначение зависит от конкретных драйверов.
Таким образом переменная keydead - это как раз байт, с интересующими нас модификаторами.
Байтовый массив keyState служит практически тем же целям, что и keydead только уже для перевода кода клавиши в в символ юникода в новой раскладке. В этом массиве 256 элементов, каждый соответствует конкретной клавише, по коду клавиши находится индекс элемента. Если клавиша зажата, то соответствующий ей байт будет равен 255, в противном случае - 0. Нам нужно указать состояние Shift, Ctrl и Alt, то есть инициировать элементы 16, 17 и 18 соответственно, но только если соответсвующие флажки установлены в keydead.
Далее создаем StringBuilder для получения результата и вызываем ToUnicodeEx, который передает результат в этот StringBuilder, а из него символ записывается в result.

Теперь у нас есть функция для перекодирования строк, но она не очень удобна, поскольку требует передавать указатели на раскладки. Немного упростим вызов, создав функцию, которая будет загружать раскладки по имени.
vb.net
1
2
3
4
5
    Function ConvertStringByKeyboardLayoutName(srcStr As String, strLayoutFrom As String, strLayoutTo As String) As String
        Dim layoutFrom = LoadKeyboardLayout(strLayoutFrom, 0)
        Dim layoutTo = LoadKeyboardLayout(strLayoutTo, 0)
        Return ConvertStringByKeyboardLayout(srcStr, layoutFrom, layoutTo)
    End Function
Ну и теперь можно создать две готовые функции для перекодирования с русской раскладки на английскую и обратно. Зная имена раскладок это сделать совсем несложно.
vb.net
1
2
3
4
5
6
7
    Function ConvertEnToRuByKBL(srcStr As String) As String
        Return ConvertStringByKeyboardLayoutName(srcStr, "00000409", "00000419")
    End Function
 
    Function ConvertRuToEnByKBL(srcStr As String) As String
        Return ConvertStringByKeyboardLayoutName(srcStr, "00000419", "00000409")
    End Function
Вот таким кодом теперь можно протестировать перевод с английской на русскую раскладку
vb.net
1
2
        Console.WriteLine(ConvertEnToRuByKBL(Console.ReadLine()))
        Console.ReadKey()
В дополнение еще следует сказать о том, как можно получить имя активной раскладки клавиатуры.
vb.net
1
2
3
4
5
6
7
8
9
10
11
12
13
    <DllImport("user32")>
    Function GetKeyboardLayoutName(<Out> pwszKLID As StringBuilder) As Boolean
    End Function
 
    Function GetKeyboardLayoutName() As String
        Dim sb As New StringBuilder
        Dim result = GetKeyboardLayoutName(sb)
        If result Then
            Return sb.ToString
        Else
            Return ""
        End If
    End Function
Вторая функция - просто удобная оболочка для первой. Она возвращает имя текущей раскладки. Правда в консольном приложении она будет возвращать имя раскладки, в которой было запущено приложение, так что в консольном приложении ее лучше не использовать.
Можно так же сразу загрузить текущую раскладку с помощью
vb.net
1
    Public Declare Function GetKeyboardLayout Lib "user32" (ByVal idThread As UInteger) As IntPtr
Она принимает ид потока, для активного потока надо передать 0. Но в консольном приложении результат будет тем же, что и для предыдущей функции.
Есть еще функция, возвращающая все активные раскладки системы.
vb.net
1
2
3
    <DllImport("user32.dll")>
    Function GetKeyboardLayoutList(nBuff As Integer, <Out> lpList As IntPtr()) As UInteger
    End Function
Примерный вариант использования
vb.net
1
2
3
4
        Dim len = GetKeyboardLayoutList(0, Nothing)
        Dim lll(len - 1) As IntPtr
        GetKeyboardLayoutList(len, lll)
        Array.ForEach(lll, AddressOf Console.WriteLine)
PS
Функции, определенные с помощью атрибута DllImport (а не с помощью Declare) должны быть статическими, следовательно в таком виде, как они представлены здесь из можно использовать только в модуле. В классе они должны объявляться как Shared.

13
Пшик
Заблокирован
15.08.2015, 21:46 146
Как писать ботов. API VK. Задаем свой собственный статус VK с помощью VB.NET. Для начинающих


Помнится, осенью 2014 решил я создать бота для VK.
А знал я тогда только банальный WebBrowser. На нем и начал городить бота.
Но набрела коса на камень. То была загрузка фото на сервер VK, которую и должен был эмулировать бот.
Ни декстопная версия VK с засилием JS, ни мобильная с input type=file, этому WebBrowser'у были явно не по зубам.
Вот тогда-то и пришлось взяться за VK API.

И вот, буквально не прошло и года, как я решил создать этот пост.
Почему? Да потому что фигово что-то на душе очень. А значит, нужно делать что? Полезное нужно делать, вот что. Глядишь, полегчает.
Бот был на C#, но для этого поста я переписал часть его исходника на VB.NET, + реализовал собственно работу со статусом, а так же написал небольшой гайд для начинающего VK-API-кодера.
Исходник - в аттаче, а гайд - под спойлером.


Гайд

Сперва нашего бота нужно зарегистрировать как приложение VK. Что это значит - узнаете по ходу дела.
Первым делом идем на свою страницу VK.
В списке слева выбираем "Приложения". Затем справа-вверху выбираем вкладку "Управление".
Нажимаем "Создать приложение".
Теперь нужно ввести некоторое Название для приложения, допустим MyTestBot, и в Типе выставить Stand-alone (десктопное приложение, не связанное с магазином VK).
И нажать Подключить приложение.
Далее вы должны будете пройти СМС-подтверждение, в лучших традициях сообщества анонимных алкоголиков параноиков.
После чего можем ввести описание, выбрать группу, иконку, а можем и не ввести и не выбрать, ну и т.д.

Главное, что мы теперь получили приложение.
Теперь, если мы зайдем: главная страница VK -> Приложения -> Управление -> MyTestBot Редактировать -> Настройки, то там будет ID приложения - 6-значное число.
С помощью этого id наш бот сможет получить access_token, который уже передавать в запросах к VK API. Время действия токена ограничено - лучше каждый раз заново получать.
Как сделать приложение доступным для установки другими пользователями, я не разбирался. Если нужно передать бота заказчику, то пусть он сам создаст приложение, а id введет в специальный текстбокс у бота.

Перейдем сразу к получению токена.
Итак, чтобы получить токен, надо в адресной строке выполнить запрос:
Код
https://oauth.vk.com/authorize?client_id=xxxxxx&scope=1024&display=page&response_type=token
где:
xxxxxx - id приложения
scope - запрашиваемые разрешения для доступа к разным API, работающим с разными данными пользователя. Например, 1024 - это статус, 4 - это фотографии.
Подробнее - тут: http://vk.com/dev/permissions

Выполнив запрос в адресной строке, увидим окошко "Приложение *** требует доступ к вашему аккаунту".
Нажмем Разрешить - и увидим в адресной строке URL такого вида:
Код
https://oauth.vk.com/blank.html#access_token=какаятохреньдлинная&expires_in=86400&user_id=XXXXXXXXX
где user_id - id нашего аккаунта
access_token - и есть искомый токен

Как автоматизировать этот процесс авторизации?
Я НЕ советую делать "тихую" авторизацию, т.е. без вмешательства пользователя. Во всяком случае, VK старается ставить этому разные препоны.
Нужно просто открывать окошко с WebBrowser'ом, в котором и будет открываться URL. Подробнее - см. исходник в аттаче.
А здесь перейдем сразу к работе с API.

Все методы API, о которых есть информация в докуметации, "лежат" в папке
https://api.vk.com/method/
Чтобы метод сработал, к нему делают GET-запрос, передавая access_token + нужные данному методу параметры.
Метод может возвращать значение в JSON или XML.
В нашем случае нужен такой запрос (можно сделать в адресной строке)
https://api.vk.com/method/status.set?access_token=токен&text=Hello World
text - это собственно содержимое статуса.
Если все ОК, метод вернет такой JSON:
JSON
1
{"response":1}
Если нужен XML-вариант, то так:
https://api.vk.com/method/status.set.xml?access_token=токен&text=Hello World
и вернет XML-документ такого содержания:
XML
1
<response>1</response>
Вот собственно и все.
Подумайте, как реализовать на VB.NET программно.
Или просто воспользуйтесь исходником в аттаче.
2
Вложения
Тип файла: zip VK Status Bot.zip (76.9 Кб, 59 просмотров)
_Лёша_
386 / 375 / 22
Регистрация: 08.02.2011
Сообщений: 1,078
20.10.2015, 18:58 147
Подключение и работа с БД MySQL на локальном компьютере

1. Установить Mysql Connector/NET.
2. Добавить ссылку в проекте на MySql.Data. (Нажимаем добавить (add), выбираем вкладку Browser и ищем библиотеку. Находится она по следующему пути: путь_куда_вы_ставили_mysql_connector/Assemblies/версия .net/MySql.Data.dll)
3.После добавления библиотеки в проект обязательно измените параметр копировать локально (в Окне Свойств, Properties, при выделенном пункте списка) на true, иначе при запуске ПО на компьютере без MySQL Connector/NET приложение будет вываливаться с ошибкой dll.
4. Импортируем пространство имен (Imports MySql.Data.MySqlClient).
5.Для создания подключения необходимо создать объект типа MySqlConnection и задать ей ConnectionString (строка подключения — описывает необходимые параметры для подключения к серверу). Например:
vb.net
1
 Dim conn As New MySqlConnection("Server=127.0.0.1;User id=test_user;password=test_pwd;database=test_db")
6.Выполнение запроса:
vb.net
1
2
3
4
5
6
Dim conn As New MySqlConnection("Server=127.0.0.1;User id=test_user;password=test_pwd;database=test_db")
Dim cmd As New MySqlCommand
cmd.CommandText = "текст запроса"
cmd.Connection = conn
cmd.ExecuteNonQuery()
conn.close()
4
BatyrbekAl
22 / 22 / 4
Регистрация: 09.09.2015
Сообщений: 116
24.10.2015, 12:45 148
Исправление работы функций UPPER() и LOWER() для SQLite

vb.net
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Imports System.Data.SQLite
 
<SQLiteFunction(Name:="lower", Arguments:=1, FuncType:=FunctionType.Scalar)>
Public Class LCase : Inherits SQLiteFunction
    Public Overrides Function Invoke(ByVal args() As Object) As Object
        If (args.Length = 0) OrElse (args(0) Is Nothing) Then Return Nothing
        Return TryCast(args(0), String).ToLower
    End Function
End Class
<SQLiteFunction(Name:="upper", Arguments:=1, FuncType:=FunctionType.Scalar)>
Public Class UCase : Inherits SQLiteFunction
    Public Overrides Function Invoke(ByVal args() As Object) As Object
        If (args.Length = 0) OrElse (args(0) Is Nothing) Then Return Nothing
        Return TryCast(args(0), String).ToUpper
    End Function
End Class
Добавлено через 15 минут
решение для LIKE :
SQL
1
SELECT * FROM tab1 WHERE LOWER(s2) LIKE LOWER('%ЯбЛоКо%')
4
Yury Komar
Модератор
Эксперт .NET
2956 / 2681 / 431
Регистрация: 27.01.2014
Сообщений: 4,952
30.10.2015, 20:32 149
Получение списка поддерживаемых разрешений видеокартой

Модуль:
Кликните здесь для просмотра всего текста
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
Module GetDispResolutions
    Private Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As Integer, ByVal iModeNum As Integer, ByRef lpdmode As DEVMODE) As Boolean
    Const ENUM_CURRENT_SETTINGS As Integer = -1
    Const CDS_UPDATEREGISTRY As Integer = &H1
    Const CDS_TEST As Long = &H2
    Const CCDEVICENAME As Integer = 32
    Const CCFORMNAME As Integer = 32
    Const DISP_CHANGE_SUCCESSFUL As Integer = 0
    Const DISP_CHANGE_RESTART As Integer = 1
    Const DISP_CHANGE_FAILED As Integer = -1
 
    <Runtime.InteropServices.StructLayout(Runtime.InteropServices.LayoutKind.Sequential)> Public Structure DEVMODE
        <Runtime.InteropServices.MarshalAsAttribute(Runtime.InteropServices.UnmanagedType.ByValTStr, SizeConst:=CCDEVICENAME)> Public dmDeviceName As String
        Public dmSpecVersion As Short
        Public dmDriverVersion As Short
        Public dmSize As Short
        Public dmDriverExtra As Short
        Public dmFields As Integer
 
        Public dmOrientation As Short
        Public dmPaperSize As Short
        Public dmPaperLength As Short
        Public dmPaperWidth As Short
 
        Public dmScale As Short
        Public dmCopies As Short
        Public dmDefaultSource As Short
        Public dmPrintQuality As Short
        Public dmColor As Short
        Public dmDuplex As Short
        Public dmYResolution As Short
        Public dmTTOption As Short
        Public dmCollate As Short
        <Runtime.InteropServices.MarshalAsAttribute(Runtime.InteropServices.UnmanagedType.ByValTStr, SizeConst:=CCFORMNAME)> Public dmFormName As String
        Public dmUnusedPadding As Short
        Public dmBitsPerPel As Short
        Public dmPelsWidth As Integer
        Public dmPelsHeight As Integer
 
        Public dmDisplayFlags As Integer
        Public dmDisplayFrequency As Integer
    End Structure
 
    Dim intX As Integer = Screen.PrimaryScreen.Bounds.Width
    Dim intY As Integer = Screen.PrimaryScreen.Bounds.Height
 
    Public Function GetDisplayResolutions_Array() As Array
        Dim ENUM_CURRENT_SETTINGS As Integer = -1
        Dim CDS_UPDATEREGISTRY As Integer = &H1
        Dim CDS_TEST As Long = &H2
        Dim CCDEVICENAME As Integer = 32
        Dim CCFORMNAME As Integer = 32
        Dim DISP_CHANGE_SUCCESSFUL As Integer = 0
        Dim DISP_CHANGE_RESTART As Integer = 1
        Dim DISP_CHANGE_FAILED As Integer = -1
 
        Dim currres As String = ""
        Dim ListOfRes As New ArrayList
 
        Dim DevM As DEVMODE
        DevM.dmDeviceName = New [String](New Char(32) {})
        DevM.dmFormName = New [String](New Char(32) {})
        DevM.dmSize = CShort(Runtime.InteropServices.Marshal.SizeOf(GetType(DEVMODE)))
 
        Dim dMode = -1
        Do While EnumDisplaySettings(Nothing, dMode, DevM) = True
            If DevM.dmPelsWidth > 640 Then
                If DevM.dmPelsHeight = intX And DevM.dmPelsWidth = intY Then
                    currres = "Monitor Resolution"
                Else
                    currres = ""
                End If
                If ListOfRes.Count <> 0 Then
                    If ListOfRes.Item(ListOfRes.Count - 1).ToString <> CStr(DevM.dmPelsWidth) & " X " & CStr(DevM.dmPelsHeight) & CStr(currres) Then
                        ListOfRes.Add(CStr(DevM.dmPelsWidth) & " X " & CStr(DevM.dmPelsHeight) & CStr(currres))
 
                    End If
                Else
                    ListOfRes.Add(CStr(DevM.dmPelsWidth) & " X " & CStr(DevM.dmPelsHeight) & CStr(currres))
                End If
            End If
            dMode += 1
        Loop
        ListOfRes.RemoveAt(0) 'Добавил так как вылезал дубликат моего текущего расширения
        Return ListOfRes.ToArray
    End Function
End Module


Использование:
vb.net
1
2
3
    Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
        ListBox1.Items.AddRange(GetDisplayResolutions_Array)
    End Sub
7
Изображения
 
_Лёша_
386 / 375 / 22
Регистрация: 08.02.2011
Сообщений: 1,078
14.11.2015, 13:33 150
Подключение библиотеки LibZplay в проект

1.Создаем проект, назовем его zplay.
2.Жмем "Проект"->"Добавить"->"Существующий элемент" выбираем libZPlay.vb из папки Vb.net данной библиотеки.
3.В папку сборки проекта (debug или release) кладем libzplay.dll.
4.Нужно импортировать пространство имен libZPlay из libZPlay.vb, но через имя нашего проекта. Проект мы назвали zplay, поэтому соответственно:
vb.net
1
Imports zplay.libZPlay
5.Создатели также рекомендуют подключить:
vb.net
1
Imports System.Drawing
6.Создаем объект:
vb.net
1
Dim player As New libZPlay.ZPlay()
Все, дальше вам карты в руки.
3
Вложения
Тип файла: 7z libzplay-2.02-sdk.7z (2.13 Мб, 50 просмотров)
greg zakharov
Покинул форум
2401 / 991 / 281
Регистрация: 07.05.2015
Сообщений: 1,991
22.01.2016, 13:09 151
Список загруженных драйверов
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
Imports System
Imports System.Reflection
Imports System.Text.RegularExpressions
Imports System.Runtime.InteropServices
 
Friend NotInheritable Class Program
  Private Const SystemModuleInformation As Int32 = 11
  
  Private Shared ReadOnly Property NtQuerySystemInformation() As MethodInfo
    Get
      Return Assembly.GetAssembly( _
        GetType(Regex) _
      ).GetType( _
        "Microsoft.Win32.NativeMethods" _
      ).GetMethod( _
        "NtQuerySystemInformation" _
      )
    End Get
  End Property
  
  <StructLayout(LayoutKind.Sequential)> _
  Friend Structure SYSTEM_MODULE_INFORMATION
    <MarshalAs(UnmanagedType.ByValArray, SizeConst := 2)> _
    Friend Reserved As UInt32()
    Friend BaseAddress As IntPtr
    Friend Size As UInt32
    Friend Flags As UInt32
    Friend Index As UInt16
    Friend Unknown As UInt16
    Friend LoadCount As UInt16
    Friend ModuleNameOffset As UInt16
    <MarshalAs(UnmanagedType.ByValArray, SizeConst := 256)> _
    Friend _ImageName As Char()
    
    Friend ReadOnly Property ImageName() As String
      Get
        Return New String(_ImageName).Split(New Char() {ControlChars.NullChar})(0)
      End Get
    End Property
  End Structure
  
  Shared Sub Main()
    Dim ptr As IntPtr = IntPtr.Zero
    Dim buf As Int32  = 1024 'ориентировочный размер буфера
    Dim ret As Int32  = 0    'сюда будет записан действительный размер буфера
    Dim nts As Int32, tot As Int32
    
    Try
      ptr = Marshal.AllocHGlobal(buf)
      Dim par As Object() = New Object(3) {SystemModuleInformation, ptr, buf, ret}
      
      nts = CType(NtQuerySystemInformation.Invoke(Nothing, par), Int32)
      If nts <> 0 Then
        ptr = Marshal.ReAllocHGlobal(ptr, CType(CType(par(3), Int32), IntPtr))
        nts = CType(NtQuerySystemInformation.Invoke(Nothing, new Object(3) { _
            SystemModuleInformation, ptr, par(3), 0 _
        }), Int32)
        If nts <> 0 Then
          Throw New InvalidOperationException("Could not get correct buffer length.")
        End If
      End If
      
      tot = Marshal.ReadInt32(ptr) 'общее количество драйверов
      Dim smi As SYSTEM_MODULE_INFORMATION() = New SYSTEM_MODULE_INFORMATION(tot - 1) {}
      
      Console.WriteLine("Address           Size Path" & vbLf & "-------          ----- ----")
      For i As Int32 = 0 To smi.Length - 1
        smi(i) = CType(Marshal.PtrToStructure(CType( _
          ptr.ToInt32() + Len(New UInt32) + i * Marshal.SizeOf(GetType(SYSTEM_MODULE_INFORMATION)), IntPtr _
        ), GetType(SYSTEM_MODULE_INFORMATION)), SYSTEM_MODULE_INFORMATION)
        Console.WriteLine("0x{0:x} {1,11} {2}", smi(i).BaseAddress.ToInt32(), smi(i).Size, smi(i).ImageName)
      Next
    Catch e As Exception
      Console.WriteLine(e.Message)
    Finally
      Marshal.FreeHGlobal(ptr)
    End Try
  End Sub
End Class
6
greg zakharov
Покинул форум
2401 / 991 / 281
Регистрация: 07.05.2015
Сообщений: 1,991
24.01.2016, 14:00 152
Как получить uptime системы?
Прежде несколько замечаний. Число 48 - это размер структуры SYSTEM_TIMEOFDAY_INFORMATION, которую в общем-то можно не объявлять, так как из нее нужно только первое значение - BootTime, представленное значением LARGE_INTEGER; собственно, Marshal.ReadInt64(ptr) это значение и извлекает из указателя, приводя к типу DateTime, которое в свою очередь отнимается от текущей даты.
Кликните здесь для просмотра всего текста
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
Imports System
Imports System.Reflection
Imports System.Text.RegularExpressions
Imports System.Runtime.InteropServices
 
Friend NotInheritable Class Program
  Private Const SystemTimeOfDayInformation = 3
  
  Private Shared ReadOnly Property _
  NtQuerySystemInformation As MethodInfo
    Get
      Return Assembly.GetAssembly( _
        GetType(Regex) _
      ).GetType( _
        "Microsoft.Win32.NativeMethods" _
      ).GetMethod( _
        "NtQuerySystemInformation" _
      )
    End Get
  End Property
  
  Shared Sub Main()
    Dim ptr As IntPtr = IntPtr.Zero
    Dim nts As Int32
    Dim ts  As TimeSpan
    
    Try
      ptr = Marshal.AllocHGlobal(48)
      nts = CType(NtQuerySystemInformation.Invoke(Nothing, New Object() { _
        SystemTimeOfDayInformation, ptr, 48, 0 _
      }), Int32)
      
      If nts <> 0 Then
        Throw New InvalidOperationException("Could not get required data.")
      End If
      
      ts = DateTime.Now - DateTime.FromFileTime(Marshal.ReadInt64(ptr))
      Console.WriteLine("{0:D2}:{1:D2}:{2:D2} {3} day{4}", _
        ts.Hours, ts.Minutes, ts.Seconds, ts.Days, If (ts.Days <= 1, "", "s") _
      )
    Catch e As Exception
      Console.WriteLine(e.Message)
    Finally
      Marshal.FreeHGlobal(ptr)
    End Try
  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
Imports System
Imports System.IO
Imports System.Reflection
Imports System.Globalization
Imports System.Runtime.InteropServices
 
Friend NotInheritable Class ShortcutTester
  <ComImport, TypeLibType(CType(&H1040, Int16)), _
   Guid("F935DC23-1CF0-11D0-ADB9-00C04FD58A0B")> _
  Friend Interface IWshShortcut
    <DispId(0)> _
    ReadOnly Property FullName As <MarshalAs(UnmanagedType.BStr)> String
    <DispId(&H3e8)> _
    Property Arguments() As <MarshalAs(UnmanagedType.BStr)> String
    <DispId(&H3e9)> _
    Property Description() As <MarshalAs(UnmanagedType.BStr)> String
    <DispId(&H3ea)> _
    Property Hotkey() As <MarshalAs(UnmanagedType.BStr)> String
    <DispId(&H3eb)> _
    Property IconLocation() As <MarshalAs(UnmanagedType.BStr)> String
    <DispId(&H3ec)> _
    WriteOnly Property RelativePath() As <MarshalAs(UnmanagedType.BStr)> String
    <DispId(&H3ed)> _
    Property TargetPath() As <MarshalAs(UnmanagedType.BStr)> String
    <DispId(&H3ee)> _
    Property WindowStyle() As Int32
    <DispId(&H3ef)> _
    Property WorkingDirectory() As String
    <TypeLibFunc(CType(&H40, Int16)), DispId(&H7d0)> _
    Sub Load(<[In], MarshalAs(UnmanagedType.BStr)> PathLink As String)
    <DispId(&H7d1)> _
    Sub Save()
  End Interface
  'пример разбора ярлыка Autoruns.lnk на рабочем столе
  Shared Sub Main()
    Dim WScriptShell As Type
    Dim WshObject As Object
    Dim lnk = Path.Combine( _
      Environment.GetFolderPath(Environment.SpecialFolder.Desktop), _
      "autoruns.lnk" _
    )
    
    WScriptShell = Type.GetTypeFromProgID("WScript.Shell")
    WshObject = Activator.CreateInstance(WScriptShell)
    
    Dim iws As IWshShortcut = DirectCast( _
      WScriptShell.InvokeMember( _
        "CreateShortcut", _
        BindingFlags.InvokeMethod, _
        Nothing, _
        WshObject, _
        New Object() {lnk}, _
        CultureInfo.CurrentCulture _
      ), _
      IWshShortcut _
    )
    
    If Not File.Exists(iws.TargetPath) Then
      Console.WriteLine("Probably broken.")
      Return
    End if
    
    Console.WriteLine("Target : {0}", iws.TargetPath)
  End Sub
End Class
4
GSXL
167 / 175 / 27
Регистрация: 26.11.2011
Сообщений: 385
Записей в блоге: 1
26.01.2016, 02:01 153
Как запаковать в ZIP, TAR, WIM, 7z и распаковать
В корень проекта кидаем файл 7za.exe и обращаемся к нему, вот пример:
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
Public Class Form1
    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        'Архивирование
        Dim myProcess As Process = Process.Start("7za.exe", "a -p12345 -mhe -t7z -ssw -mx7 ""C:\Users\User\Desktop\NEW2.7z"" ""C:\Users\User\Desktop\Examples""")
        ' -tzip - формат архива установлен в 7z, без этого ключа 7z по умолчанию
        ' -ssw - принудительная упаковка файлов, которые в данный момент открыты для записи
        ' -mx7 - степень сжатия (где 0 - без сжатия а 7 максимальна степень)
        ' -p12345 - шифрование архива, где 12345 - пароль
        ' -mhe - шифрование имен файлов
        ' Путь и полное имя создаваемого архива
        ' Путь и полное имя папки/файла необходимого архивировать
 
        Do While Not myProcess.HasExited
            Application.DoEvents() 'Нужно что бы программа не зависла и откликалась на действия вовремя ожидания 
        Loop
        myProcess.WaitForExit() ' Ожидаем закрытия 
        'Действие по завершению
        MsgBox("Завершено: " & myProcess.ExitTime & "." & System.Environment.NewLine & "Код завершения: " & myProcess.ExitCode) 'Выводим информацию по завершению
        myProcess.Close() 'Освобождаем память
    End Sub
 
    Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
        'Распаковка
        Dim myProcess As Process = Process.Start("7za.exe", "x -p12345 ""C:\Users\User\Desktop\NEW.7z"" -o""C:\Users\User\Desktop\Examples2""")
 
        Do While Not myProcess.HasExited
            Application.DoEvents() 'Нужно что бы программа не зависла и откликалась на действия вовремя ожидания 
        Loop
        myProcess.WaitForExit() ' Ожидаем закрытия 
        'Действие по завершению
        MsgBox("Завершено: " & myProcess.ExitTime & "." & System.Environment.NewLine & "Код завершения: " & myProcess.ExitCode) 'Выводим информацию по завершению
        myProcess.Close() 'Освобождаем память
    End Sub
End Class
P.S. Есть DLL но с консолью удобно что в ней отображается процесс
8
Вложения
Тип файла: zip 7za.zip (466.5 Кб, 76 просмотров)
greg zakharov
Покинул форум
2401 / 991 / 281
Регистрация: 07.05.2015
Сообщений: 1,991
26.01.2016, 21:15 154
Pipelist
Несколько слов прежде. Код старый, можно сказать замшелый, изначально был написан на C# (.NET 3.5), затем по просьбе знакомого был переписан на VB.NET, отыскался случайно в закромах; по функциональности идентичен одноименной тулзе Руссиновича. Может кому сгодится в образовательных целях...
vb.net
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
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
Imports System
Imports System.IO
Imports System.Reflection
Imports System.ComponentModel
Imports Microsoft.Win32.SafeHandles
Imports System.Runtime.InteropServices
Imports System.Diagnostics.CodeAnalysis
 
Namespace PipeList
  <StructLayout(LayoutKind.Explicit, Size := 8)> _
  Friend Structure LARGE_INTEGER
    <SuppressMessage("Microsoft.Performance", "CA1823:AvoidUnusedPrivateFields")> _
    <FieldOffset(0)> _
    Friend QuadPart As Int64
    <FieldOffset(0)> _
    Friend LowPart As Int32
    <SuppressMessage("Microsoft.Performance", "CA1823:AvoidUnusedPrivateFields")> _
    <FieldOffset(4)> _
    Friend HighPart As UInt32
  End Structure
  
  <StructLayout(LayoutKind.Sequential)> _
  Friend Structure IO_STATUS_BLOCK
    Friend Status As UInt32
    Friend Information As UInt64
  End Structure
  
  <StructLayout(LayoutKind.Sequential, CharSet := CharSet.Unicode)> _
  Friend Structure FILE_DIRECTORY_INFORMATION
    Friend NextEntryOffset As UInt32
    Friend FileIndex As UInt32
    Friend CreationTime As LARGE_INTEGER
    Friend LastAccessTime As LARGE_INTEGER
    Friend LastWriteTime As LARGE_INTEGER
    Friend ChangeTime As LARGE_INTEGER
    Friend EndOfFile As LARGE_INTEGER
    Friend AllocationSize As LARGE_INTEGER
    Friend FileAttributes As UInt32
    Friend FileNameLength As UInt32
    <MarshalAs(UnmanagedType.ByValArray, SizeConst := 2)> _
    Friend FileName As Byte()
  End Structure
  
  Friend NotInheritable Class NativeMethods
    Private Sub New()
    End Sub
    
    <DllImport("kernel32.dll", CharSet := CharSet.Unicode, SetLastError := True)> _
    Friend Shared Function CreateFile( _
      ByVal lpFileName As String, _
      ByVal dwDesiredAccess As UInt32, _
      ByVal dwShareMode As FileShare, _
      ByVal lpSecurityAttributes As IntPtr, _
      ByVal dwCreationDisposition As FileMode, _
      ByVal dwFlagsAndAttributes As UInt32, _
      ByVal hTemplateFile As IntPtr _
    ) As SafeFileHandle
    End Function
 
    <DllImport("ntdll.dll")> _
    Friend Shared Function NtQueryDirectoryFile( _
      ByVal FileHandle As SafeFileHandle, _
      ByVal [Event] As IntPtr, _
      ByVal ApcRoutine As IntPtr, _
      ByVal ApcContext As IntPtr, _
      ByRef IoStatusBlock As IO_STATUS_BLOCK, _
      <Out> FileInformation As IntPtr, _
      ByVal Length As UInt32, _
      ByVal FileInformationClass As UInt32, _
      <MarshalAs(UnmanagedType.Bool)> _
      ByVal ReturnSingleEntry As Boolean, _
      ByVal FileName As IntPtr, _
      <MarshalAs(UnmanagedType.Bool)> _
      ByVal RestartScan As Boolean _
    ) As Int32
    End Function
  End Class
  
  Friend NotInheritable Class Program
    Const FileDirectoryInformation As UInt32 = 1
    Const GENERIC_READ As UInt32 = &H80000000UI
    Const STATUS_SUCCESS As Int32 = &H0
 
    Private Shared Function PtrToStruct(Of T)(ByVal p As IntPtr) As T
      Return DirectCast(Marshal.PtrToStructure(p, GetType(T)), T)
    End Function
 
    Private Shared Sub GetLastError()
      Console.WriteLine(New Win32Exception(Marshal.GetLastWin32Error()).Message)
    End Sub
 
    Shared Sub Main()
      Dim pipes As SafeFileHandle
      Dim ptr As IntPtr = IntPtr.Zero, ofs As IntPtr
      Dim isb As IO_STATUS_BLOCK
      Dim nts As Int32
      Dim query As Boolean = True
 
      pipes = NativeMethods.CreateFile("\\.\pipe", GENERIC_READ, FileShare.ReadWrite _
                        Or FileShare.Delete, IntPtr.Zero, FileMode.Open, 0, IntPtr.Zero)
 
      If pipes.IsInvalid Then
        GetLastError()
        Return
      End If
 
      Console.WriteLine("{0,-40}{1,14}{2,20}", "Pipe Name", "Instances", "Max Instances")
      Console.WriteLine("{0,-40}{1,14}{2,20}", "---------", "---------", "-------------")
 
      Try
        ptr = Marshal.AllocHGlobal(Marshal.SizeOf(GetType(FILE_DIRECTORY_INFORMATION)))
        ofs = ptr
        While True
          nts = NativeMethods.NtQueryDirectoryFile(pipes, IntPtr.Zero, IntPtr.Zero, _
                  IntPtr.Zero, isb, ofs, 1024, FileDirectoryInformation, False, IntPtr.Zero, query)
 
          If nts <> STATUS_SUCCESS Then
            Exit While
          End If
 
          While True
            Dim fdi As FILE_DIRECTORY_INFORMATION = PtrToStruct(Of FILE_DIRECTORY_INFORMATION)(ofs)
            Dim name As IntPtr = CType(Marshal.OffsetOf(GetType( _
                        FILE_DIRECTORY_INFORMATION), "FileName").ToInt64() + ofs.ToInt64(), IntPtr)
            Console.WriteLine("{0,-40}{1,14}{2,20}", _
              Marshal.PtrToStringUni(name, CType(fdi.FileNameLength \ 2, Int32)), _
              fdi.EndOfFile.LowPart, fdi.AllocationSize.LowPart _
            )
 
            If fdi.NextEntryOffset = 0 Then
              Exit While
            End If
            ofs = CType(ofs.ToInt64() + fdi.NextEntryOffset, IntPtr)
          End While
          query = False
        End While
      Catch e As Exception
        Console.WriteLine(e.Message)
      Finally
        Marshal.FreeHGlobal(ptr)
      End Try
 
      pipes.Close()
    End Sub
  End Class
End Namespace
2
greg zakharov
Покинул форум
2401 / 991 / 281
Регистрация: 07.05.2015
Сообщений: 1,991
30.01.2016, 17:40 155
Как проверить, есть ли сборка в GAC?
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
Imports System.Reflection
Imports System.Collections
 
Module GacList
  Sub Main(ByVal args As String())
    If args.Length <> 1 Then
      Return
    End If
    
    Dim al As New ArrayList()
    Dim assem As String = If(args.Length = 1, args(0), Nothing)
    
    Assembly.GetAssembly( _
      GetType(Object) _
    ).GetType( _
      "Microsoft.Win32.Fusion" _
    ).GetMethod( _
      "ReadCache" _
    ).Invoke(Nothing, New Object() {al, assem, CType(&H2, UInt32)})
    
    For Each a As String In al
      Console.WriteLine(a)
    Next
  End Sub
End Module
Пример использования:
Код
E:\proj> app system.management.automation
system.management.automation, Version=1.0.0.0, Culture=neutral, PublicKeyToken=31bf3856ad364e35
Как отобразить в консоли календарь на указанный месяц?
Кликните здесь для просмотра всего текста
vb.net
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
Imports System
Imports System.Linq
Imports System.Reflection
Imports System.Collections
Imports System.Globalization
Imports System.Threading.Interlocked
 
<Assembly: AssemblyTitle("cal")>
 
Namespace Calendar
  Friend NotInheritable Class AssemblyInfo
    Private a As Type
    Friend Sub New()
      a = GetType(Program)
    End Sub
 
    Friend ReadOnly Property Title() As String
      Get
        Return DirectCast(Attribute.GetCustomAttribute( _
          a.Assembly, GetType(AssemblyTitleAttribute _
        )), AssemblyTitleAttribute).Title
      End Get
    End Property
  End Class
  
  Friend NotInheritable Class Program
    Friend Structure Range
      Public Sub New(ByVal min As Int32, ByVal max As Int32)
        Minimum = min
        Maximum = max
      End Sub
      Public Minimum As Int32
      Public Maximum As Int32
    End Structure
 
    Private Shared Sub Usage()
      Dim ai As New AssemblyInfo()
      Console.WriteLine("Usage: {0} [-m <month>] [-y <year>] [-i]", ai.Title)
      Console.WriteLine("   -m   Set month number")
      Console.WriteLine("   -y   Indicate year")
      Console.WriteLine("   -i   Invertion (Monday first)")
    End Sub
 
    Private Shared Function ValidateRange(ByVal s As String, ByVal r As Range) As Int32
      Dim buf As Int32
 
      buf = If(Int32.TryParse(s, buf), buf, 0)
      If Not Enumerable.Range(r.Minimum, r.Maximum).Contains(buf) Then
        Throw New ArgumentException("Out of range.")
      End If
 
      Return buf
    End Function
 
    Private Shared Sub Print(ByVal ie As IEnumerable)
      For Each i As Object In ie
        Console.Write(Convert.ToString(i) & " ")
      Next
      Console.WriteLine()
    End Sub
 
    Private Shared Sub GetMonthCalendar(ByVal h As Hashtable, ByVal b As Boolean)
      Dim ci As DateTimeFormatInfo = DateTimeFormatInfo.CurrentInfo
      Dim now As DateTime = DateTime.Now
      Dim al As New ArrayList()
      Dim tmp As Int32 = 0
      Dim day As String = Nothing
      Dim mon = If(h.Contains("Month"), h("Month"), now.Month)
      Dim yer = If(h.Contains("Year"), h("Year"), now.Year)
      Dim cap = ci.MonthNames(CType(mon, Int32) - 1) & " " & Convert.ToString(yer)
      
      tmp = Convert.ToInt32((20 - cap.Length) \ 2)
      cap = New String(" "C, tmp) & cap
      
      For Each dow As String In ci.ShortestDayNames
        al.Add(dow)
      Next
      
      Dim cal = CultureInfo.CurrentCulture.Calendar
      tmp = CType(cal.GetDayOfWeek(New DateTime(CType(yer, Int32), CType(mon, Int32), 1)), Int32)
      
      If b Then
        Dim o As Object = al(0)
        al.RemoveAt(0)
        al.Add(o)
        tmp = If((Decrement(tmp)) < 0, 6, tmp)
      End If
      
      If tmp <> 0 Then
        For i As Int32 = 0 To tmp - 1
          al.Add(New String(" "C, 2))
        Next
      End If
      tmp = cal.GetDaysInMonth(CType(yer, Int32), CType(mon, Int32))
      For i As Int32 = 1 To tmp
        day = i.ToString(CultureInfo.CurrentCulture)
        al.Add(If(day.Length = 1, " " & day, day))
      Next
      
      tmp = 0
      Console.ForegroundColor = ConsoleColor.Magenta
      Console.WriteLine(cap)
      Console.ResetColor()
      Try
        While tmp < al.Count
          Print(al.GetRange(tmp, 7))
          tmp += 7
        End While
      Catch e As ArgumentException
        Print(al.GetRange(tmp, al.Count - tmp))
      End Try
    End Sub
 
    Shared Sub Main(ByVal args As String())
      If args.Length = 0 Then
        GetMonthCalendar(New Hashtable(), False)
        Return
      End If
 
      Dim ht As New Hashtable()
      Dim al As New ArrayList()
      
      Dim invert As Boolean = False
      Dim inv_dupl As Int32 = 0
      
      Try
        For i As Int32 = 0 To args.Length - 1
          If args(i)(0).Equals("-"C) OrElse args(i)(0).Equals("/"C) Then
            Select Case Char.ToUpper(args(i)(1), CultureInfo.CurrentCulture)
              Case "M"C
                ht.Add("Month", ValidateRange(args(i + 1), (New Range(1, 12))))
                i += 1
                Exit Select
              Case "Y"C
                ht.Add("Year", ValidateRange(args(i + 1), (New Range(2000, 9999))))
                i += 1
                Exit Select
              Case "I"C
                invert = True
                inv_dupl += 1
                Exit Select
              Case Else
                al.Add(args(i))
                Exit Select
            End Select
          Else
            al.Add(args(i))
          End If
        Next
      Catch e As Exception
        Usage()
        Return
      End Try
 
      If al.Count <> 0 OrElse inv_dupl > 1 Then
        Usage()
        Return
      End If
      GetMonthCalendar(ht, invert)
    End Sub
  End Class
End Namespace

Примеры использования:
Код
E:\proj> app
    Январь 2016
Вс Пн Вт Ср Чт Пт Сб
                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

E:\proj> app -i
    Январь 2016
Пн Вт Ср Чт Пт Сб Вс
             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

E:\proj> app -m 12 -y 2015 -i
    Декабрь 2015
Пн Вт Ср Чт Пт Сб Вс
    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
4
greg zakharov
Покинул форум
2401 / 991 / 281
Регистрация: 07.05.2015
Сообщений: 1,991
31.01.2016, 20:38 156
Как программно найти путь к GAC?
Вариант первый.
vb.net
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Imports System.IO
Imports System.Linq
Imports System.Reflection
Imports System.Text.RegularExpressions
Imports System.Runtime.InteropServices
 
Module Program
  Sub Main()
    Dim dll As String = Directory.GetFiles( _
      RuntimeEnvironment.GetRuntimeDirectory(), "*.dll" _
    ).Where( _
      Function(d) New Regex("Microsoft.Build.Tasks").IsMatch(d) _
    ).ToArray()(0)
    Dim asm As Assembly = Assembly.Load(File.ReadAllBytes(dll))
    Console.WriteLine(asm.GetType( _
      "Microsoft.Build.Tasks.GlobalAssemblyCache" _
    ).GetMethod( _
      "GetGacPath", BindingFlags.Static Or BindingFlags.NonPublic _
    ).Invoke(Nothing, New [Object]() {}))
  End Sub
End Module
Вариант второй.
vb.net
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Imports System.Collections
Imports System.Security.Policy
Imports System.Text.RegularExpressions
 
Module Program
  Sub Main()
    Dim ie As IEnumerator
    Dim re As New Regex("(?<=file:///).*(?=/gac)", RegexOptions.IgnoreCase)
 
    ie = AppDomain.CurrentDomain.GetAssemblies()(0).Evidence.GetHostEnumerator()
    While ie.MoveNext()
      Dim url As Url = TryCast(ie.Current, Url)
      If url IsNot Nothing Then
        Console.WriteLine(re.Match(url.ToString()).Value.Replace("/", ""))
      End If
    End While
  End Sub
End Module
Вариант третий.
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
Imports System.Text
Imports System.Runtime.InteropServices
 
Friend NotInheritable Class Program
  Friend Enum ASM_CACHE_FLAGS
    ASM_CACHE_ZAP = &H1
    ASM_CACHE_GAC = &H2
    ASM_CACHE_DOWNLOAD = &H4
    ASM_CACHE_ROOT = &H8
    ASM_CACHE_ROOT_EX = &H80
  End Enum
 
  Friend NotInheritable Class NativeMethods
    Private Sub New()
    End Sub
    <DllImport("fusion.dll", CharSet := CharSet.Auto, BestFitMapping := False)> _
    Friend Shared Function GetCachePath( _
      ByVal dwCacheFlags As ASM_CACHE_FLAGS, _
      ByVal pwzCachePath As StringBuilder, _
      ByRef pcchPath As Int32) As Int32
    End Function
  End Class
 
  Shared Sub Main()
    Dim acf As ASM_CACHE_FLAGS
    Dim sb As StringBuilder
    Dim sz As Int32
 
    acf = If(Environment.Version.Major < 4, ASM_CACHE_FLAGS.ASM_CACHE_ROOT, ASM_CACHE_FLAGS.ASM_CACHE_ROOT_EX)
    If NativeMethods.GetCachePath(acf, Nothing, sz) >= 0 Then
      If sz = 0 Then
        Return
      End If
    End If
    sb = New StringBuilder(sz)
    Console.WriteLine(If(NativeMethods.GetCachePath(acf, sb, sz) <> 0, "n/a", sb.ToString()))
  End Sub
End Class
3
greg zakharov
Покинул форум
2401 / 991 / 281
Регистрация: 07.05.2015
Сообщений: 1,991
07.02.2016, 14:27 157
Как изменить значок консоли?
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
Imports System.Linq
Imports System.Drawing
Imports System.Reflection
Imports System.ComponentModel
Imports System.Text.RegularExpressions
Imports System.Runtime.InteropServices
 
Friend NotInheritable Class Program
  Private Shared Property SetConsoleIcon() As _SetConsoleIcon
    Get
      Return m_SetConsoleIcon
    End Get
    Set
      m_SetConsoleIcon = Value
    End Set
  End Property
  Private Shared m_SetConsoleIcon As _SetConsoleIcon
 
  Private Shared Function GetProc(Of T As Class)(ByVal dll As String, ByVal fun As String) As T
    Dim meths = Assembly.GetAssembly( _
      GetType(Regex) _
    ).GetType( _
      "Microsoft.Win32.UnsafeNativeMethods" _
    ).GetMethods( _
      BindingFlags.Public Or BindingFlags.Static _
    ).Where( _
      Function(m) New Regex("\AGet(ProcA|ModuleH)").IsMatch(m.Name) _
    ).ToList()
    Dim ptr As IntPtr = CType(meths(1).Invoke(Nothing, New Object() { _
      New HandleRef(New IntPtr(), CType(meths(0).Invoke(Nothing, New Object() {dll}), IntPtr)), fun _
    }), IntPtr)
 
    If ptr = IntPtr.Zero Then
      Throw New InvalidOperationException("Could not find specified signature.")
    End If
 
    Return TryCast(Marshal.GetDelegateForFunctionPointer(ptr, GetType(T)), T)
  End Function
 
  <UnmanagedFunctionPointer(CallingConvention.Winapi, SetLastError := True)> _
  Private Delegate Function _SetConsoleIcon(ByVal hIcon As IntPtr) As _
    <MarshalAs(UnmanagedType.Bool)> Boolean
 
  Shared Sub Main()
    SetConsoleIcon = GetProc(Of _SetConsoleIcon)("kernel32.dll", "SetConsoleIcon")
    Dim ptr As IntPtr = New Bitmap("E:\Users\greg\Pictures\openbsd_logo.jpg").GetHicon()
 
    If Not SetConsoleIcon(ptr) Then
      Console.WriteLine(New Win32Exception(Marshal.GetLastWin32Error()).Message)
    End If
  End Sub
End Class
6
greg zakharov
Покинул форум
2401 / 991 / 281
Регистрация: 07.05.2015
Сообщений: 1,991
09.02.2016, 18:28 158
Как узнать заряд батареи ноутбука не используя WMI?
vb.net
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Imports System.Linq
Imports System.Reflection
Imports System.Windows.Forms
 
Module Program
  Sub Main()
    Dim ps As PowerStatus = DirectCast( _
      Assembly.GetAssembly(GetType(Form)).GetType( _
        "System.Windows.Forms.PowerStatus" _
      ).GetConstructor( _
        BindingFlags.NonPublic Or BindingFlags.Instance, Nothing, New Type() {}, Nothing _
      ).Invoke(Nothing), PowerStatus)
    Dim prop = ps.GetType().GetProperties().ToList()
    For Each p In prop
      Console.WriteLine("{0,-20} : {1}", p.Name, p.GetValue(ps, Nothing))
    Next
  End Sub
End Module
5
bobo bobo
13 / 13 / 0
Регистрация: 09.08.2015
Сообщений: 19
21.02.2016, 23:09 159
Красивый CheckBox в стиле SwitchButton
Visual Basic .NET FAQ. Готовые решения, полезные коды
9
Вложения
Тип файла: rar WindowsApplication1.rar (69.6 Кб, 167 просмотров)
Юпатов Дмитрий
1646 / 1137 / 224
Регистрация: 23.12.2010
Сообщений: 1,495
22.02.2016, 10:18 160
bobo bobo, прикольно. Можно немного допилить в плане звукового файла: чтобы его не таскать рядом с прогой, добавляем в ресурсы (у меня он получил имя "_1", когда я его мышкой туда поместил). И далее в коде контрола:
Вместо
vb.net
1
My.Computer.Audio.Play(My.Application.Info.DirectoryPath & "/1.wav")
пишем:
vb.net
1
2
3
Using sp As New Media.SoundPlayer(My.Resources.ResourceManager.GetStream("_1"))
    sp.Play()
End Using
В итоге все необходимые файлы спрятаны в скомпилированном файле. А зачем там label используется?
3
22.02.2016, 10:18
Answers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
22.02.2016, 10:18

Заказываю контрольные, курсовые, дипломные и любые другие студенческие работы здесь.

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

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

Литература и ресурсы по Visual Basic .NET
Литература по Visual Basic.NET 1. Виктор Зиборов &quot;Visual Basic 2010 на примерах&quot; Издательство:...


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

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

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