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

Visual Basic .NET

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

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

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

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

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


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

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

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

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

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

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

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

195
Юпатов Дмитрий
1604 / 1116 / 223
Регистрация: 23.12.2010
Сообщений: 1,491
12.07.2012, 14:50 #31
Писателям лаунчеров посвящается...

Пример программы для загрузки обновлений.
Внешний вид окна - см. вложение.
Полный код формы
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
Imports System.Net
Imports System.Security.Cryptography
Public Class Form1
#Region "Variables"
    Dim WithEvents DownloadClient As New WebClient
    Dim OriginString As New List(Of StringList) ' массив оригинальных строк с путями для закачки, хешами и относительными путями назначения
    Dim ResultString As New List(Of StringList) ' список отобранного для загрузки
    Dim CurrentNum As Integer = 0
    Dim RootFolder As String = "C:\Users\Yupatov\Desktop\папка1" ' локальная корневая папка
    Dim NetFolder As String = "http://mytestsource.narod.ru/folder1/" ' корневая папка на сервере, гле размещен файл с информацией. Файлы для загрузки могут быть в другом месте
    Dim IsFileLoading = False
    Dim Errorlog As String = String.Empty ' пустая строка. В процессе загрузки сюда пишется лог ошибок, если они есть. Потом ее можно прочитать (например, отобразить в MsgBox)
    Dim InfoFile As String = "UpdateInfo.upd" ' имя файла с информацией на сервере
    Dim seprow() As Char = {vbCr, vbLf} ' сепараторы для нарезки на строки
    Dim sepcell() As String = {"[cell]"} ' сепаратор нарезки отдельных строк
#End Region
    ''' <summary>
    ''' Структура для списка файлов: путь для скачивания с сервера; md5 файла, расположенного по этому пути; относительный путь к такому же файлу на локальном диске; md5 файла, расположенного по этому пути
    ''' </summary>
    ''' <remarks></remarks>
    Private Structure StringList
        Dim ServerPath As String
        Dim ServerHash_MD5 As String
        Dim LocalPath As String
        Dim LocalHash_MD5 As String
    End Structure
 
#Region "Downloader"
    Private Sub DownloadClient_DownloadFileCompleted(ByVal sender As Object, ByVal e As System.ComponentModel.AsyncCompletedEventArgs) Handles DownloadClient.DownloadFileCompleted
        If Not e.Error Is Nothing Then
            Errorlog = Errorlog & e.Error.ToString & vbCrLf & "----------" & vbCrLf
        End If
        CurrentNum = CurrentNum + 1
        If CurrentNum < Me.ResultString.Count Then
            Me.BeginDownload(Me.CurrentNum)
        Else
            IsFileLoading = False
            Me.CurrentNum = 0
            Me.Text = "Download complete"
            Me.OriginString.Clear()
            Me.ResultString.Clear()
            Me.lblLocalPath.Text = String.Empty
            Me.lblServerPath.Text = String.Empty
        End If
    End Sub
 
    Private Sub DownloadClient_DownloadProgressChanged(ByVal sender As Object, ByVal e As System.Net.DownloadProgressChangedEventArgs) Handles DownloadClient.DownloadProgressChanged
        If IsFileLoading = True Then
            Me.lblServerPath.Text = ResultString.Item(CurrentNum).ServerPath
            Me.lblLocalPath.Text = ResultString.Item(CurrentNum).LocalPath
        Else
            Me.Text = "Reading info..."
        End If
        Me.pbDownloadProgress.Value = Math.Min(e.BytesReceived, Me.pbDownloadProgress.Maximum)
        Me.pbDownloadProgress.Maximum = e.TotalBytesToReceive
        Me.Refresh()
    End Sub
 
    Private Sub DownloadClient_DownloadStringCompleted(ByVal sender As Object, ByVal e As System.Net.DownloadStringCompletedEventArgs) Handles DownloadClient.DownloadStringCompleted
        If Not e.Error Is Nothing Then
            Errorlog = Errorlog & e.Error.ToString & vbCrLf & "----------" & vbCrLf
            Exit Sub
        End If
        ' получаем массив строк
        For Each ostr As String In e.Result.Split(seprow, StringSplitOptions.RemoveEmptyEntries)
            Dim ss() As String = ostr.Split(sepcell, StringSplitOptions.RemoveEmptyEntries)
            Dim newSL As New StringList
            newSL.ServerPath = ss.GetValue(0)
            newSL.ServerHash_MD5 = ss.GetValue(1)
            newSL.LocalPath = Me.RootFolder & ss.GetValue(2)
            OriginString.Add(newSL)
        Next
        ' обрабатываем его, чтобы получить необходимое
        Add_LocalHashes_makeDirs()
        ' загружаем необходимые файлы
        If Me.ResultString.Count = 0 Then
            IsFileLoading = False
            Me.CurrentNum = 0
            Me.Text = "Nothing to download"
            Me.OriginString.Clear()
            Me.ResultString.Clear()
            Me.lblLocalPath.Text = String.Empty
            Me.lblServerPath.Text = String.Empty
        Else
            Me.BeginDownload(Me.CurrentNum)
        End If
    End Sub
 
    ''' <summary>
    ''' Процедура для старта загрузки файла
    ''' </summary>
    ''' <param name="CN">Порядковый номер файла в списке</param>
    ''' <remarks></remarks>
    Private Sub BeginDownload(ByVal CN As Integer)
        Me.IsFileLoading = True
        Me.Text = CurrentNum + 1 & "/" & Me.ResultString.Count
        Me.DownloadClient.DownloadFileAsync(New Uri(ResultString.Item(CN).ServerPath), ResultString.Item(CN).LocalPath)
    End Sub
#End Region
 
#Region "ComputingHash_MD5_makedir_fillresultstring"
    ''' <summary>
    ''' Функция вычисляет значение md5 для указанного файла, в случае его отсутствия присваивает -1
    ''' </summary>
    ''' <param name="filepath">Путь к файлу</param>
    ''' <returns>Хеш-сумма в виде строки</returns>
    ''' <remarks></remarks>
    Private Function GetHash(ByVal filepath As String) As String
        Try
            Dim checksum() As Byte
            Dim result As String = String.Empty
            Dim i As Integer
            Dim MD5Calc As New MD5CryptoServiceProvider
            Dim inStream As IO.Stream
            If IO.File.Exists(filepath) Then
                inStream = New IO.FileStream(filepath, IO.FileMode.Open, IO.FileAccess.Read)
            Else
                Return ("-1")
            End If
            checksum = MD5Calc.ComputeHash(inStream)
            inStream.Close()
            For i = 0 To checksum.Length - 1
                result &= String.Format("{0:X2}", checksum(i))
            Next
            Return result
        Catch ex As Exception
            Me.Errorlog = Me.Errorlog & ex.Message & vbCrLf & "----------" & vbCrLf
        End Try
        Return ("-1")
    End Function
 
    ''' <summary>
    ''' Процедура вычисляет md5 для локальных файлов, добавляет их значение в список OriginString и, при необходимости, создает недостающие каталоги для дальнейшего помещения туда файлов. Формирует список ResultString для загрузки
    ''' </summary>
    ''' <remarks></remarks>
    Private Sub Add_LocalHashes_makeDirs()
        For Each SL As StringList In Me.OriginString
            SL.LocalHash_MD5 = Me.GetHash(SL.LocalPath)
            If Not SL.ServerHash_MD5.Equals(SL.LocalHash_MD5) Then
                Me.ResultString.Add(SL)
                If IO.Directory.Exists(IO.Path.GetDirectoryName(SL.LocalPath)) = False Then
                    Try
                        IO.Directory.CreateDirectory(IO.Path.GetDirectoryName(SL.LocalPath))
                    Catch ex As Exception
                        Me.Errorlog = Me.Errorlog & ex.Message & vbCrLf & "----------" & vbCrLf
                    End Try
                End If
            End If
        Next
    End Sub
 
#End Region
 
    Private Sub btnDownload_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnDownload.Click
        DownloadClient.DownloadStringAsync(New Uri(NetFolder & InfoFile))
    End Sub
 
End Class

Что необходимо на сервере:
1) файл UpdateInfo.upd, который расположен по пути, указанному в переменной NetFolder
2) файлы обновлений, которые предстоит скачать. Расположение - где угодно, хоть на другом сервере (пути к ним прописываются в файле из п.1)

Структура файла UpdateInfo.upd - текстовый, с разделителями.
Строки разделены символами vbCr + vbLf
Сами строки имеют такую структуру:
Полный путь к файлу для скачивания[cell]MD5 файла в виде строки[cell]относительный путь для сохранения на локальной машине (относительно значения переменной RootFolderRoot)
Пример содержимого
http://mytestsource.narod.ru/folder1/File1.dll[cell]E047210B4CE2BBF0F6A9819031C5874A[cell]\File1.dll
http://mytestsource.narod.ru/folder1/File1.exe[cell]CAB0FFC1844E892CB44BC98359520CF0[cell]\Folder1\File1.exe
http://mytestsource.narod.ru/folder1/File2.bin[cell]31A69F32502DE8B29ED98BFA19DE1332[cell]\Folder1\File2.bin
http://mytestsource.narod.ru/folder1/File2.dll[cell]A74A9A50110E5F5B3AD0B2DCBDB1E6E8[cell]\Folder2\File2.dll

Что тут и как работает:
1) нажатием на кнопку запускаем процесс скачивания.
2) загружается содержимое файла UpdateInfo.upd
3) формируется список OriginStrings путем порезки полученных данных на фрагменты
4) имея корневую локальную папку и получив из файла UpdateInfo.upd относительные пути к файлам, вычисляются хеши локально расположенных файлов. Проверяется совпадение полученных хешей и вычисленных. Если совпали - файл качать не надо. Если не совпали:
- файл (точнее, елемент списка) добавляется в список ResultStrings. Одновременно создаются необходимые пустые каталоги (смотрим на полученный относительный путь)
- теперь производится собственно закачка каждого файла из списка ResultStrings и его сохранение в нужном месте (корневой путь у нас задан, относительные мы получили)
5) В процессе закачки на форме отображается процесс закачки каждого файла с отображением также серверного пути и локального. Т.е. откуда и куда качаем. В заголовке формы работает счетчик, показывающий порядковый номер файла из списка и длину списка.


Поскольку файл UpdateInfo.upd имеет достаточно специфические данные, написана также небольшая утилитка, которая может его формировать. Это утилитка для собственника программы, который будет заботиться о периодическом обновлении своего ПО.
Тут все просто:
1) Имеем папку с внутренней иерархией, повторяющей установленную программу, которую следует обновлять. В идеале - пересобрал прогу, установил у себя и потом используешь папку с установленной прогой.
В начале указываем путь к этой корневой папке.
Далее нажимаем "Подготовить данные". При этом заполнятся столбцы с локальным относительным путем и хешем файла. Желательно строку со значением MD5 получать именно отсюда, т.к. она никак не сегментирована, а просто непрерывный ряд символов. Другие программы могут выдавать значение в несколько отличающемся формате. Хотя массив байтов с хешем будет эквивалентен.
После этого остается (уже ручками) в столбец пути на сервере вписать путь к каждому файлу (путь на сервере, абсолютный. Вот почему ранее я написал, что файлы могут лежать где угодно и как угодно)
Код формы
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
Imports System.Security.Cryptography
Public Class Form1
 
    Private Sub btnBrowse_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnBrowse.Click
        If Me.dgvResults.RowCount > 0 Then
            If MsgBox("Вы действительно хотите очистить предыдущие результаты?", MsgBoxStyle.YesNo Or MsgBoxStyle.Question) = MsgBoxResult.Yes Then
                Me.txtPath.Text = String.Empty
                Me.dgvResults.Rows.Clear()
            End If
        End If
        Dim FBD As New FolderBrowserDialog
        With FBD
            .ShowNewFolderButton = False
        End With
        If FBD.ShowDialog = Windows.Forms.DialogResult.OK Then
            Me.txtPath.Text = FBD.SelectedPath
            Me.btnFillTable.Enabled = True
            Me.btnSavetofile.Enabled = True
        End If
    End Sub
 
    Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
        Me.btnFillTable.Enabled = False
        Me.btnSavetofile.Enabled = False
    End Sub
 
    Private Sub btnFillTable_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnFillTable.Click
        For Each pth As String In My.Computer.FileSystem.GetFiles(Me.txtPath.Text, FileIO.SearchOption.SearchAllSubDirectories)
            Me.dgvResults.Rows.Add(1)
            Me.dgvResults.Item(2, Me.dgvResults.Rows.Count - 1).Value = pth.Replace(Me.txtPath.Text, String.Empty)
            Me.dgvResults.Item(1, Me.dgvResults.Rows.Count - 1).Value = Me.GetHash(pth)
        Next
    End Sub
 
    ''' <summary>
    ''' Функция вычисляет значение md5 для указанного файла, в случае его отсутствия присваивает -1
    ''' </summary>
    ''' <param name="filepath">Путь к файлу</param>
    ''' <returns>Хеш-сумма в виде строки</returns>
    ''' <remarks></remarks>
    Private Function GetHash(ByVal filepath As String) As String
        Try
            Dim checksum() As Byte
            Dim result As String = String.Empty
            Dim i As Integer
            Dim MD5Calc As New MD5CryptoServiceProvider
            Dim inStream As IO.Stream
            If IO.File.Exists(filepath) Then
                inStream = New IO.FileStream(filepath, IO.FileMode.Open, IO.FileAccess.Read)
            Else
                Return ("-1")
            End If
            checksum = MD5Calc.ComputeHash(inStream)
            For i = 0 To checksum.Length - 1
                result &= String.Format("{0:X2}", checksum(i))
            Next
            Return result
        Catch ex As Exception
            MsgBox(ex.ToString)
        End Try
    End Function
 
    Private Sub btnSavetofile_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnSavetofile.Click
        If Me.dgvResults.RowCount = 0 Then Exit Sub
        Dim result As String = String.Empty
        For i As Integer = 0 To Me.dgvResults.Rows.Count - 1
            result = result & CStr(Me.dgvResults.Item(0, i).Value) & "[cell]" & CStr(Me.dgvResults.Item(1, i).Value) & "[cell]" & CStr(Me.dgvResults.Item(2, i).Value) & vbCr & vbLf
        Next
        Dim SFD As New SaveFileDialog
        With SFD
            .InitialDirectory = Me.txtPath.Text
            .DefaultExt = "upd"
            .Filter = "Файлы .udp|*.upd"
            .FileName = "Info.upd"
            .ShowHelp = False
            .AddExtension = True
        End With
        If SFD.ShowDialog = Windows.Forms.DialogResult.OK Then
            Try
                Dim SW As New IO.StreamWriter(SFD.FileName)
                SW.Write(result)
                SW.Close()
            Catch ex As Exception
                MsgBox(ex.ToString)
            End Try
        End If
    End Sub
End Class

Ну и, конечно:
1) пути, указанные в кодах - живые. Я ж тоже тестил все это.
2) как всегда - во вложениях архивы с проектами
3) естественно, код не идеален, могут возникать необработанные исключения - хотя тестировал в разных ситуациях, но недолго.
27
Миниатюры
Visual Basic .NET FAQ. Готовые решения, полезные коды   Visual Basic .NET FAQ. Готовые решения, полезные коды  
Вложения
Тип файла: rar WindowsApplication1.rar (108.2 Кб, 317 просмотров)
Тип файла: rar WindowsApplication2.rar (146.2 Кб, 297 просмотров)
Ciberst
507 / 420 / 18
Регистрация: 16.12.2010
Сообщений: 939
14.07.2012, 17:27 #32
следующий код позволит создать область выделения(как в знаменитых фоторедакторах)
Visual Basic .NET FAQ. Готовые решения, полезные коды
код
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
Public Class Form1
 
    Dim isDrag As Boolean = False
    Dim theRectangle As New Rectangle(New Point(0, 0), New Size(0, 0))
    Dim startPoint As Point
 
    Private Sub Form1_MouseDown(ByVal sender As Object, ByVal e As  _
        System.Windows.Forms.MouseEventArgs) Handles MyBase.MouseDown
 
        If (e.Button = MouseButtons.Left) Then
            isDrag = True
        End If
 
        Dim control As Control = CType(sender, Control)
 
       
        startPoint = control.PointToScreen(New Point(e.X, e.Y))
    End Sub
 
    Private Sub Form1_MouseMove(ByVal sender As Object, ByVal e As  _
    System.Windows.Forms.MouseEventArgs) Handles MyBase.MouseMove
 
       
        If (isDrag) Then
 
         
            ControlPaint.DrawReversibleFrame(theRectangle, Me.BackColor, _
                FrameStyle.Dashed)
 
           
            Dim endPoint As Point = CType(sender, Control).PointToScreen(New Point(e.X, e.Y))
            Dim width As Integer = endPoint.X - startPoint.X
            Dim height As Integer = endPoint.Y - startPoint.Y
            theRectangle = New Rectangle(startPoint.X, startPoint.Y, _
                width, height)
 
 
            ControlPaint.DrawReversibleFrame(theRectangle, Me.BackColor, _
                 FrameStyle.Dashed)
        End If
    End Sub
 
    Private Sub Form1_MouseUp(ByVal sender As Object, ByVal e As  _
    System.Windows.Forms.MouseEventArgs) Handles MyBase.MouseUp
 
 
        isDrag = False
 
        
        ControlPaint.DrawReversibleFrame(theRectangle, Me.BackColor, _
            FrameStyle.Dashed)
 
        Dim i As Integer
        Dim controlRectangle As Rectangle
        For i = 0 To Controls.Count - 1
            controlRectangle = Controls(i).RectangleToScreen _
                (Controls(i).ClientRectangle)
            If controlRectangle.IntersectsWith(theRectangle) Then
                Controls(i).BackColor = Color.BurlyWood
            End If
        Next
 
        theRectangle = New Rectangle(0, 0, 0, 0)
    End Sub
 
End Class


Получить имя переменной
vb.net
1
2
3
4
5
6
7
8
9
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim abc As String = "123"
        Dim a = New With {abc}
        MsgBox(GetName(a) & " = " & abc)
 
    End Sub
    Public Function GetName(ByVal obj As Object) As String
        Return obj.[GetType]().GetProperties()(0).Name
    End Function
8
вадим2
91 / 91 / 3
Регистрация: 01.12.2011
Сообщений: 94
06.08.2012, 11:43 #33
Загрузка файла на FTP сервер с прогрессом
Создаём новый проект, на форму кидаем Button1, Label1, ProgressBar1.
Весь код формы заменяем на:
vb.net
1
2
3
4
5
6
7
8
9
Imports System.IO
Imports System.Net
Imports System.ComponentModel
Public Class Form1
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Dim downloader As New filesuploader("Имя пользователя", "мой сайт.ru/", "пароль", Label1, ProgressBar1)
        downloader.Загрузить_файл("C:\file.exe")
    End Sub
End Class
Так же добавляем класс filesuploader, со следующим содержанием:

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
Public Class filesuploader
    Dim сервер As String
    Dim логин As String
    Dim пароль As String
    Dim label2 As Object
    Dim progressbar1 As Object
    ''' <summary>
    ''' Данные для работы класса
    ''' </summary>
    ''' <param name="логинinf">Логин для входа на FTP сервер.</param>
    ''' <param name="серверinf">Адрес сервера, например: mysite.ru/. Для сайта на яндекс.народ: mysite.ftp.narod.ru/</param>
    ''' <param name="парольinf">Пароль для входа на FTP сервер</param>
    ''' <param name="надпись_информацииinf">Label, в которой отображается информация(скорость, оставшееся время).</param>
    ''' <param name="полоса_загрузкиinf">Progressbar, в котором отображается прогресс загрузки.</param>
    ''' <remarks></remarks>
    Public Sub New(ByVal логинinf As String, ByVal серверinf As String, ByVal парольinf As String, ByVal надпись_информацииinf As Object, ByVal полоса_загрузкиinf As Object)
        логин = логинinf
        сервер = серверinf
        пароль = парольinf
        label2 = надпись_информацииinf
        progressbar1 = полоса_загрузкиinf
        worker.WorkerReportsProgress = True
    End Sub
    Dim WithEvents worker As New BackgroundWorker
    ''' <summary>
    ''' Загружает файл на FTP сервер с отображением прогресса и информации.
    ''' </summary>
    ''' <param name="файл">Укажите путь к загружаемому файлу.</param>
    ''' <remarks></remarks>
    Sub Загрузить_файл(ByVal файл As String)
        progressbar1.Value = 0
        Dim fileinf As New FileInfo(файл)
        Try
            progressbar1.Maximum = fileinf.Length / buffLength + 1
        Catch ex As Exception
            progressbar1.Maximum = 100
        End Try
        worker.RunWorkerAsync(New Object() {файл})
    End Sub
    Dim buffLength As Integer = 2048
    Dim str As String
    Private Sub worker_DoWork(ByVal sender As Object, ByVal e As DoWorkEventArgs) Handles worker.DoWork
        Try
            Dim fileInf As New FileInfo(e.Argument(0).ToString)
            Dim reqFTP As FtpWebRequest
            reqFTP = DirectCast(FtpWebRequest.Create(New Uri("ftp://" + сервер + "/" & fileInf.Name)), FtpWebRequest)
            reqFTP.Credentials = New NetworkCredential(логин, пароль)
            reqFTP.KeepAlive = False
            reqFTP.Method = WebRequestMethods.Ftp.UploadFile
            Application.DoEvents()
            reqFTP.UseBinary = True
            reqFTP.ContentLength = fileInf.Length
            Dim buff As Byte() = New Byte(buffLength) {}
            Dim contentLen As Integer
            Dim fs As FileStream = fileInf.OpenRead()
            Dim strm As Stream = reqFTP.GetRequestStream()
            contentLen = fs.Read(buff, 0, buffLength)
            Dim str1 As Integer = 0
            Dim all As Integer = 0
            Dim tmr As String
            Dim i12 As Integer
            While contentLen <> 0
                tmr = Split(My.Computer.Clock.LocalTime, ":")(2)
                strm.Write(buff, 0, contentLen)
                all = all + buffLength
                contentLen = fs.Read(buff, 0, buffLength)
                str1 = str1 + buffLength
                i12 = i12 + 1
                If tmr = Split(My.Computer.Clock.LocalTime, ":")(2) Then
                Else
                    Dim time As String
                    Dim int As Integer = (fileInf.Length - all) / str1
                    If int > 60 Then
                        time = "Осталось " & Replace((int / 60).ToString, ",", " мин, ") & " сек."
                        If Len(Split(int / 60, ",")(1)) > 3 Then
                            time = "Осталось " & Split(int / 60, ",")(0) & " мин."
                        End If
                    Else
                        time = "Осталось " & int.ToString & " сек."
                    End If
                    str = "Скорость: " & str1.ToString / 1024 & " КБ/С. " & time
                    str1 = 0
                End If
                worker.ReportProgress(i12)
            End While
            strm.Close()
            fs.Close()
            str = Nothing
            worker.ReportProgress(progressbar1.Maximum())
            ' Return "Http://www." & Replace(сервер, "ftp.", Nothing) & "/" & fileInf.Name
        Catch
            MessageBox.Show(Err.Description, "", MessageBoxButtons.OK, MessageBoxIcon.Error)
            ' Return Nothing
        End Try
    End Sub
    Private Sub Worker_ProgressChanged(ByVal sender As Object, ByVal e As ProgressChangedEventArgs) Handles worker.ProgressChanged
        progressbar1.Value = e.ProgressPercentage
        label2.Text = str
    End Sub
    Private Sub Worker_RunWorkerCompleted(ByVal sender As Object, ByVal e As RunWorkerCompletedEventArgs) Handles worker.RunWorkerCompleted
        MessageBox.Show("Файл успешно загружен!", "", MessageBoxButtons.OK, MessageBoxIcon.Asterisk)
    End Sub
End Class
7
_Лёша_
383 / 373 / 20
Регистрация: 08.02.2011
Сообщений: 1,078
22.11.2012, 16:53 #34
Telnet клиент на Vb.net
3
Вложения
Тип файла: zip telnet client.zip (26.8 Кб, 210 просмотров)
_Лёша_
383 / 373 / 20
Регистрация: 08.02.2011
Сообщений: 1,078
22.11.2012, 16:59 #35
Пример передачи файлов любого размера по tcp.
2 консольных приложения:
клиент:
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
Imports System.Collections
Imports System.Collections.Generic
Imports System.Data
Imports System.Diagnostics
Imports System.Net
Imports System.Net.Sockets
Imports System.Text
Imports System.IO
 
NotInheritable Class Program
    Private Sub New()
    End Sub
 
    Public Shared Sub Main()
        Do
            Dim Filename As String = Nothing
            Console.WriteLine("Перетащите файл на консоль для отправки и нажмите Enter")
            Filename = Console.ReadLine().Replace("""", "")
            Dim client As New TcpClient("127.0.0.1", 20000)
            Using inputStream As FileStream = File.OpenRead(Filename)
                Using outputStream As NetworkStream = client.GetStream()
                    Using writer As New BinaryWriter(outputStream)
                        Dim lenght As Long = inputStream.Length
                        Dim totalBytes As Long = 0
                        Dim readBytes As Integer = 0
                        Dim buffer As Byte() = New Byte(2047) {}
                        writer.Write(Path.GetFileName(Filename))
                        writer.Write(lenght)
                        Do
                            readBytes = inputStream.Read(buffer, 0, buffer.Length)
                            outputStream.Write(buffer, 0, readBytes)
                            totalBytes += readBytes
                        Loop While client.Connected AndAlso totalBytes < lenght
                    End Using
                End Using
            End Using
            client.Close()
        Loop While True
    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
Imports System.Collections
Imports System.Collections.Generic
Imports System.Data
Imports System.Diagnostics
Imports System.Net
Imports System.Net.Sockets
Imports System.Text
Imports System.IO
 
NotInheritable Class Program
    Private Sub New()
    End Sub
 
 
    Public Shared Sub Main()
 
        Dim folder As String = "recived"
        Dim listener As New TcpListener(IPAddress.Any, 20000)
        listener.Start()
        While True
            Dim client As TcpClient = listener.AcceptTcpClient()
            Using inputStream As NetworkStream = client.GetStream()
                Using reader As New BinaryReader(inputStream)
                    Dim filename As String = reader.ReadString()
                    Dim lenght As Long = reader.ReadInt64()
                    Using outputStream As FileStream = File.Open(Path.Combine(folder, filename), FileMode.Create)
                        Dim totalBytes As Long = 0
                        Dim readBytes As Integer = 0
                        Dim buffer As Byte() = New Byte(2047) {}
 
                        Do
                            readBytes = inputStream.Read(buffer, 0, buffer.Length)
                            outputStream.Write(buffer, 0, readBytes)
                            totalBytes += readBytes
                        Loop While client.Connected AndAlso totalBytes < lenght
                        Console.WriteLine("Принят файл " & filename & " Размер " & totalBytes)
                    End Using
 
                End Using
            End Using
 
            client.Close()
        End While
 
    End Sub
End Class
8
АББА
133 / 60 / 7
Регистрация: 08.11.2012
Сообщений: 250
29.01.2013, 19:04 #36
Имя пользователя:
vb.net
1
Label6.Text = My.User.Name

Операционная система:
vb.net
1
2
3
With My.Computer.Info
Msgbox(.OSFullName & " " & .OSVersion)
End With

Видеокарта(VGA):
vb.net
1
2
3
4
Dim a As ManagementObjectSearcher = New ManagementObjectSearcher("SELECT * FROM Win32_VideoController")
For Each видеокарта As ManagementObject In a.Get()
Msgbox(видеокарта("Name"))
Next

Режим экрана:
vb.net
1
2
3
4
5
6
With My.Computer.Screen
            Dim x$ = .Bounds.Size.Width
            Dim y$ = .Bounds.Size.Height
            Dim bit% = .BitsPerPixel
          msgbox( x & " x " & y & " (" & bit & " бит" & ")")
 End With


Процессор:
vb.net
1
2
3
4
5
6
7
8
Dim процессор = My.Computer.Registry.LocalMachine.OpenSubKey _
                        ("HARDWARE\\DESCRIPTION\\SYSTEM\\CentralProcessor\\0", False)
        With процессор
            Label1.Text = .GetValue("ProcessorNameString")
            ListBox1.Items.Add("Частота (MHz): " & .GetValue("~MHz"))
            ListBox1.Items.Add("Идентификация: " & .GetValue("Identifier"))
            ListBox1.Items.Add("Ид. продавца: " & .GetValue("VendorIdentifier"))
        End With

Получение информации о дисках:
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
 Dim имя$ = ""
        Dim s$ = "   "
        Const d% = 1073741824
        With My.Computer.FileSystem
            For i = 0 To .Drives.Count - 1
                имя = .Drives.Item(i).Name
 
                'Добавляем в лист имя диска
                ListBox2.Items.Add(.GetDriveInfo(имя).VolumeLabel & "_" & имя)
 
                'Проверка общего объёма диска
                Dim obem = Val(.GetDriveInfo(имя).TotalSize)
 
                ListBox2.Items.Add(s & "Общий объем: " & obem & " Байт | " & _
                                   Format(Val(obem) / d, "0.00") & " Гб")
                'Проверка свободного объёма диска
                Dim svob = Val(.GetDriveInfo(имя).TotalFreeSpace)
 
                ListBox2.Items.Add(s & "Свободно: " & svob & " Байт | " & _
                                   Format(Val(svob) / d, "0.00") & " Гб")
 
                'Получение информации об файловой системе
                ListBox2.Items.Add(s & "Файловая система: " & _
                      .GetDriveInfo(имя).DriveFormat)
 
                'Тип диска
                ListBox2.Items.Add(s & "Тип диска: " & _
                      .GetDriveInfo(имя).DriveType)
            Next
        End With
8
Pe4eNEG
108 / 108 / 9
Регистрация: 12.06.2010
Сообщений: 459
Записей в блоге: 2
02.02.2013, 11:54 #37
Для начала добавляем в проект новый класс, называем его Shortcut и записываем следующий код:
Код Shortcut.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
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
Imports System.Runtime.InteropServices
Imports System.Runtime.InteropServices.ComTypes
Imports System.Text
 
Public Class Shortcut
    ' egl1044
    Private Const CLSID_ShellLink As String = "00021401-0000-0000-C000-000000000046"
    Private Const CLSID_FolderShortcut As String = "0AFACED1-E828-11D1-9187-B532F1E9575D"
    Private dataBuffer As New StringBuilder(260)
    Public Enum LinkType As Integer
        File
        Folder
    End Enum
    Public Enum WindowStyle As Integer
        Normal = 1
        Maximized = 3
        ShowMinNoActive = 7
    End Enum
    Private psl As IShellLinkW = Nothing
    Private ppf As IPersistFile = Nothing
    Public Sub New(ByVal shortcutlinkType As LinkType)
        ' Get a pointer to the IShellLink interface.
        Select Case shortcutlinkType
            Case LinkType.File
                psl = DirectCast(Activator.CreateInstance(Type.GetTypeFromCLSID(New Guid(CLSID_ShellLink)), True), IShellLinkW)
            Case LinkType.Folder
                psl = DirectCast(Activator.CreateInstance(Type.GetTypeFromCLSID(New Guid(CLSID_FolderShortcut)), True), IShellLinkW)
        End Select
    End Sub
    Protected Overrides Sub Finalize()
        Me.Release()
        MyBase.Finalize()
    End Sub
    Public Sub Save(ByVal pszFileName As String)
        ' Get a pointer to the IPersistFile interface.
        ppf = DirectCast(psl, IPersistFile)
        ppf.Save(pszFileName, True)
    End Sub
    Public Sub Load(ByVal pszFileName As String)
        ' Get a pointer to the IPersistFile interface.
        ppf = DirectCast(psl, IPersistFile)
        ppf.Load(pszFileName, 0)
        psl.Resolve(IntPtr.Zero, 0)
    End Sub
    Public Function SetPath(ByVal pszFile As String) As Integer
        Return psl.SetPath(pszFile)
    End Function
    Public Function SetDescription(ByVal pszName As String) As Integer
        Return psl.SetDescription(pszName)
    End Function
    Public Function SetWorkingDirectory(ByVal pszDir As String) As Integer
        Return psl.SetWorkingDirectory(pszDir)
    End Function
    Public Function SetIconLocation(ByVal pszIconPath As String, ByVal iconIndex As Integer) As Integer
        Return psl.SetIconLocation(pszIconPath, iconIndex)
    End Function
    Public Function SetArguments(ByVal pszArgs As String) As Integer
        Return psl.SetArguments(pszArgs)
    End Function
    Public Function SetShowCmd(ByVal showCmd As WindowStyle) As Integer
        Return psl.SetShowCmd(showCmd)
    End Function
    Public Function SetHotKey(ByVal wHotKey As Short) As Integer
        Return psl.SetHotkey(wHotKey)
    End Function
    Public Function GetPath() As String
        psl.GetPath(dataBuffer, dataBuffer.Capacity, IntPtr.Zero, 0)
        Return dataBuffer.ToString
    End Function
    Public Function GetArguments() As String
        psl.GetArguments(dataBuffer, dataBuffer.Capacity)
        Return dataBuffer.ToString
    End Function
    Public Function GetDescription() As String
        psl.GetDescription(dataBuffer, dataBuffer.Capacity)
        Return dataBuffer.ToString
    End Function
    Public Function GetIconLocation() As ShortcutIconInfo
        Dim iconIndex As Integer
        psl.GetIconLocation(dataBuffer, dataBuffer.Capacity, iconIndex)
        Return New ShortcutIconInfo(dataBuffer.ToString, iconIndex)
    End Function
    Public Function GetWorkingDirectory() As String
        psl.GetWorkingDirectory(dataBuffer, dataBuffer.Capacity)
        Return dataBuffer.ToString
    End Function
    Public Function GetShowCommand() As Integer
        Dim pShowCmd As Integer
        psl.GetShowCmd(pShowCmd)
        Return pShowCmd
    End Function
    Public Function GetHotkey() As Short
        Dim pHotKey As Short
        psl.GetHotkey(pHotKey)
        Return pHotKey
    End Function
    Public Sub Release()
        If ppf IsNot Nothing Then
            Marshal.FinalReleaseComObject(ppf)
            ppf = Nothing
        End If
        If psl IsNot Nothing Then
            Marshal.FinalReleaseComObject(psl)
            psl = Nothing
        End If
    End Sub
 
    Public Class ShortcutIconInfo
        Private _iconLocation As String = String.Empty
        Private _iconIndex As Integer = 0
        Protected Friend Sub New(ByVal iconLocation As String, ByVal iconIndex As Integer)
            Me._iconLocation = iconLocation
            Me._iconIndex = iconIndex
        End Sub
        Public ReadOnly Property Location As String
            Get
                Return _iconLocation
            End Get
        End Property
        Public ReadOnly Property Index As Integer
            Get
                Return _iconIndex
            End Get
        End Property
    End Class
 
 
End Class
 
''' <summary>
''' IShellLinkW Interface
''' [url]http://msdn.microsoft.com/en-us/library/bb774950(VS.85).aspx[/url]
''' </summary>
''' <remarks>This interface cannot be used to create a link to a URL.</remarks>
<ComImport(), InterfaceType(ComInterfaceType.InterfaceIsIUnknown), _
Guid("000214F9-0000-0000-C000-000000000046")> _
Public Interface IShellLinkW
    <PreserveSig()> _
    Function GetPath(<MarshalAs(UnmanagedType.LPWStr)> ByVal pszFile As StringBuilder, ByVal cchMaxPath As Integer, ByVal pfd As IntPtr, ByVal fFlags As Integer) As Integer
    <PreserveSig()> _
    Function GetIDList(ByRef ppidl As IntPtr) As Integer
    <PreserveSig()> _
    Function SetIDList(ByVal pidl As IntPtr) As Integer
    <PreserveSig()> _
    Function GetDescription(<MarshalAs(UnmanagedType.LPWStr)> ByVal pszName As StringBuilder, ByVal cchMaxName As Integer) As Integer
    <PreserveSig()> _
    Function SetDescription(<MarshalAs(UnmanagedType.LPWStr)> ByVal pszName As String) As Integer
    <PreserveSig()> _
    Function GetWorkingDirectory(<MarshalAs(UnmanagedType.LPWStr)> ByVal pszDir As StringBuilder, ByVal cchMaxPath As Integer) As Integer
    <PreserveSig()> _
    Function SetWorkingDirectory(<MarshalAs(UnmanagedType.LPWStr)> ByVal pszDir As String) As Integer
    <PreserveSig()> _
    Function GetArguments(<MarshalAs(UnmanagedType.LPWStr)> ByVal pszArgs As StringBuilder, ByVal cchMaxPath As Integer) As Integer
    <PreserveSig()> _
    Function SetArguments(<MarshalAs(UnmanagedType.LPWStr)> ByVal pszArgs As String) As Integer
    <PreserveSig()> _
    Function GetHotkey(ByRef pwHotkey As Short) As Integer
    <PreserveSig()> _
    Function SetHotkey(ByVal wHotkey As Short) As Integer
    <PreserveSig()> _
    Function GetShowCmd(ByRef piShowCmd As Integer) As Integer
    <PreserveSig()> _
    Function SetShowCmd(ByVal iShowCmd As Integer) As Integer
    <PreserveSig()> _
    Function GetIconLocation(<MarshalAs(UnmanagedType.LPWStr)> ByVal pszIconPath As StringBuilder, ByVal cchIconPath As Integer, ByRef piIcon As Integer) As Integer
    <PreserveSig()> _
    Function SetIconLocation(<MarshalAs(UnmanagedType.LPWStr)> ByVal pszIconPath As String, ByVal iIcon As Integer) As Integer
    <PreserveSig()> _
    Function SetRelativePath(<MarshalAs(UnmanagedType.LPWStr)> ByVal pszPathRel As String, ByVal dwReserved As Integer) As Integer
    <PreserveSig()> _
    Function Resolve(ByVal hWnd As IntPtr, ByVal fFlags As Integer) As Integer
    <PreserveSig()> _
    Function SetPath(<MarshalAs(UnmanagedType.LPWStr)> ByVal pszFile As String) As Integer
End Interface


А теперь как это использовать:
Ярлык на файл
vb.net
1
2
3
Dim sc As New Shortcut(Shortcut.LinkType.File)
sc.SetPath("диск:\имя программы.exe")
sc.Save("диск:\имя ярлыка.lnk")


Ярлык на папку
vb.net
1
2
3
Dim sc As New Shortcut(Shortcut.LinkType.Folder)
sc.SetPath("диск:\папка")
sc.Save("диск:\имя ярлыка для папки без расширения lnk")


Ярлык с описанием
vb.net
1
2
3
4
Dim sc As New Shortcut(Shortcut.LinkType.File)
sc.SetPath("диск:\программа.exe")
sc.SetDescription("Описание ярлыка")
sc.Save("диск:\имя ярлыка.lnk")


Ярлык на файл с аргументами командной строки и описанием
vb.net
1
2
3
4
5
Dim sc As New Shortcut(Shortcut.LinkType.File)
sc.SetPath("диск:\путь\программа.exe")
sc.SetDescription("Ярлык для программа")
sc.SetArguments("аргументы командной строки")
sc.Save("диск:\путь\ярлык для программа.lnk")


Ярлык на файл с изменением его иконки
vb.net
1
2
3
4
5
6
Dim sc As New Shortcut(Shortcut.LinkType.File)
sc.SetPath("путь\программа.exe")
sc.SetDescription("ярлык для программа")
sc.SetArguments("аргументы командной строки")
sc.SetIconLocation("путь до объекта с иконками (dll или exe)", номер иконки в файле)
sc.Save("путь\ярлык для программа.lnk")


Получение информации о ярлыке
vb.net
1
2
3
4
5
6
7
8
Dim sc As New Shortcut(Shortcut.LinkType.File)
sc.Load("g:\notepad.lnk")
Debug.Print(sc.GetPath())
Debug.Print(sc.GetDescription)
Debug.Print(sc.GetArguments)
Dim sci As Shortcut.ShortcutIconInfo = sc.GetIconLocation
Debug.Print(sci.Location)
Debug.Print(sci.Index)


У кода есть небольшой минус: ярлык не создается там где требуются права администратора, у меня программа отказалась создать ярлык на разделе с Windows 8. Если у Вас отключен UAC то скорее всего таких проблем не будет.
7
Павлик Морозов
116 / 118 / 23
Регистрация: 26.10.2012
Сообщений: 385
Завершенные тесты: 1
09.02.2013, 18:29 #38
Шифрование пароля(каких-либо личных данных) алгоритмом TripleDES.

В проекте создаем класс:

Кликните здесь для просмотра всего текста
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
Imports System.Security.Cryptography
Imports System.Text
Public NotInheritable Class MainEnCryptingClass
    Private TripleDes As New TripleDESCryptoServiceProvider
    Sub New(ByVal key As String)
        ' Инициализация основного процесса шифрования.
        TripleDes.Key = TruncateHash(key, TripleDes.KeySize \ 8)
        TripleDes.IV = TruncateHash("", TripleDes.BlockSize \ 8)
    End Sub
 
    Private Function TruncateHash(ByVal key As String, ByVal length As Integer) As Byte()
 
        Dim sha1 As New SHA1CryptoServiceProvider
 
        ' Хэшируется ключ
        Dim keyBytes() As Byte = Encoding.Unicode.GetBytes(key)
        Dim hash() As Byte = sha1.ComputeHash(keyBytes)
 
        ReDim Preserve hash(length - 1)
        Return hash
    End Function
 
    Public Function EncryptData(ByVal plaintext As String) As String
 
        ' Переводим ключ в байтовый массив
        Dim plaintextBytes() As Byte = Encoding.Unicode.GetBytes(plaintext)
 
        ' Создается MemoryStream.
        Dim ms As New System.IO.MemoryStream
        ' Создание кодировщика
        Dim encStream As New CryptoStream(ms, TripleDes.CreateEncryptor(), CryptoStreamMode.Write)
 
        ' Использование шифрованного потока для записи массива.
        encStream.Write(plaintextBytes, 0, plaintextBytes.Length)
        encStream.FlushFinalBlock()
 
        ' Перевод ключа в тестовый формат.
        Return Convert.ToBase64String(ms.ToArray)
    End Function
 
    Public Function DecryptData(ByVal encryptedtext As String) As String
 
        ' Переводим ключ в байтовый массив
        Dim encryptedBytes() As Byte = Convert.FromBase64String(encryptedtext)
 
        '  Создается MemoryStream.
        Dim ms As New System.IO.MemoryStream
        ' Создание кодировщика
        Dim decStream As New CryptoStream(ms, TripleDes.CreateDecryptor(), CryptoStreamMode.Write)
 
        ' Использование шифрованного потока для записи массива.
        decStream.Write(encryptedBytes, 0, encryptedBytes.Length)
        decStream.FlushFinalBlock()
 
        ' Перевод ключа в тестовый формат.
        Return Encoding.Unicode.GetString(ms.ToArray)
    End Function
End Class


Далее в классе формы запускаем события шифрования/дешифрования данных:

Кликните здесь для просмотра всего текста
vb.net
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
'Шифруем пароль
    Private Function PasswordEncrypting()
        Dim wrapper As New MainEnCryptingClass("Ключ") 'Ключ для шифрования/расшифровки. Можно зашить 
'жестко в код, можно и передавать в ходе работы приложения
        CryptPass = wrapper.EncryptData(PasswordTxt.Text) 'PasswordTxt.Text - Информация, подлежащая шифрованию
        Return CryptPass
    End Function
 
'Значение полученной переменной CryptPass можно писать куда угодно. 
'Будь то xml-файл с настройками ConnectionString или 
'пароль для авторизации пользователя, хранящийся в БД
    
'Расшифровываем пароль
'Из ресурса получили зашифрованную информацию в переменной CryptData.
    Private Function PasswordDecrypt()
        Dim wrapper As New MainEnCryptingClass("Ключ") 'Должен быть идентичен ключу шифрования
        DecryptPass = wrapper.DecryptData(CryptData)
        Return DecryptPass 'В этой переменной расшифрованная информация
    End Function
13
Маршинин
49 / 49 / 2
Регистрация: 05.12.2012
Сообщений: 167
Записей в блоге: 1
20.02.2013, 05:25 #39
Командная строка на форме Windows!
Кликните здесь для просмотра всего текста

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
Imports System.Runtime.InteropServices
Imports System.Text
Public Class Form1
    Private WithEvents MyProcess As Process
    Private Delegate Sub AppendOutputTextDelegate(ByVal text As String)
    Private Sub Form1_FormClosing(sender As Object, e As FormClosingEventArgs) Handles Me.FormClosing
        MyProcess.StandardInput.WriteLine("EXIT") 'Отпровляем запрос закрытия
        MyProcess.StandardInput.Flush()
        MyProcess.Close()
    End Sub
    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        Me.AcceptButton = Button1
        MyProcess = New Process
        With MyProcess.StartInfo
            .FileName = "C:\Windows\system32\cmd.EXE"
            .UseShellExecute = False
            .CreateNoWindow = True
            .RedirectStandardInput = True
            .RedirectStandardOutput = True
            .RedirectStandardError = True
        End With
        MyProcess.Start()
        MyProcess.BeginErrorReadLine()
        MyProcess.BeginOutputReadLine()
        AppendOutputText("Процесс запусчен: " & MyProcess.StartTime.ToString)
    End Sub
 
    Private Sub MyProcess_OutputDataReceived(sender As Object, e As DataReceivedEventArgs) Handles MyProcess.OutputDataReceived 'Оброботка обычных ответов (Статитческих)
        AppendOutputText(vbCrLf & Encoding.Default.GetString(Encoding.Convert(Encoding.GetEncoding(866), Encoding.Default, Encoding.Default.GetBytes(e.Data))))
    End Sub
 
    Private Sub MyProcess_ErrorDataReceived(ByVal sender As Object, ByVal e As System.Diagnostics.DataReceivedEventArgs) Handles MyProcess.ErrorDataReceived 'Оброботка ошибок и потоковых данных(Пример:загрузка какой либо игры через консоль)
        AppendOutputText(vbCrLf & "Error: " & vbCrLf & Encoding.Default.GetString(Encoding.Convert(Encoding.GetEncoding(866), Encoding.Default, Encoding.Default.GetBytes(e.Data))))
    End Sub
 
    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        MyProcess.StandardInput.WriteLine(TextBox1.Text)
        MyProcess.StandardInput.Flush()
        TextBox1.Text = ""
    End Sub
    Private Sub AppendOutputText(ByVal text As String)
        Invoke(Sub()
                   TextBox2.AppendText(text) 'Добавление в строку для показа пользователю
               End Sub)
    End Sub
End Class
14
Вложения
Тип файла: zip CMD.zip (114.1 Кб, 189 просмотров)
Юпатов Дмитрий
1604 / 1116 / 223
Регистрация: 23.12.2010
Сообщений: 1,491
04.03.2013, 21:34 #40
Получение почты по протоколу POP3.
Создадим класс POP3.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
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
Public Class Pop3
       ' ----- The default TCP/IP port number for POP3 is 110.
       Public Port As Integer = 110
       Public Messages As Integer = 0
 
       Private Const CommandFailure As String = "-ERR"
 
       Private Pop3Server As TcpClient
       Private CommandSender As NetworkStream
       Private ContentReceiver As StreamReader
 
       Public Sub Connect(ByVal serverName As String, _
             ByVal userName As String, ByVal password As String)
          ' ----- Initiate the connection to a POP3 server.
          Dim commandData As String
          Dim contentBuffer() As Byte
          Dim responseString As String
          Dim parts() As String
 
          ' ----- Connect to the POP3 server.
          Try
             Pop3Server = New TcpClient(serverName, Port)
             CommandSender = Pop3Server.GetStream()
             ContentReceiver = New StreamReader(CommandSender)
          Catch
             Throw
          End Try
 
          If (userName <> "") Then
             ' ----- Authenticate with the user ID.
             commandData = "USER " & userName & vbCrLf
             contentBuffer = _
                System.Text.Encoding.ASCII.GetBytes( _
                commandData.ToCharArray())
             CommandSender.Write(contentBuffer, 0, _
                contentBuffer.Length)
             responseString = ContentReceiver.ReadLine()
             If (Left(responseString, Len(CommandFailure)) = _
                   CommandFailure) Then
                Throw New Exception("Invalid user name.")
             End If
 
             ' ----- Send the authenticating password.
             commandData = "PASS " & password & vbCrLf
             contentBuffer = _
                System.Text.Encoding.ASCII.GetBytes( _
                commandData.ToCharArray())
             CommandSender.Write(contentBuffer, 0, _
                contentBuffer.Length)
             responseString = ContentReceiver.ReadLine()
             If (Left(responseString, Len(CommandFailure)) = _
                   CommandFailure) Then
                Throw New Exception("Invalid password.")
             End If
          End If
 
          ' ----- Logged in. On some servers, the PASS command
          '       is not enough to push the server into a
          '       transaction state. Send a STAT command twice.
          commandData = "STAT" + vbCrLf
          contentBuffer = System.Text.Encoding.ASCII.GetBytes( _
             commandData.ToCharArray())
          CommandSender.Write(contentBuffer, 0, _
             contentBuffer.Length)
          responseString = ContentReceiver.ReadLine()
 
          ' ----- Get a count of the messages.
          commandData = "STAT" + vbCrLf
          contentBuffer = System.Text.Encoding.ASCII.GetBytes( _
             commandData.ToCharArray())
          CommandSender.Write(contentBuffer, 0, _
             contentBuffer.Length)
          responseString = ContentReceiver.ReadLine()
          If (Left(responseString, Len(CommandFailure)) = _
                CommandFailure) Then
             Throw New Exception( _
                "Could not retrieve message count.")
          End If
 
          ' ----- The response includes two integers: a count
          '       and a size, separated by a space. Skip over
          '       the "+OK" part also.
          parts = Split(responseString, " ")
          Messages = Val(parts(1))
       End Sub
 
       Public Sub Disconnect()
          ' ----- Disconnect from the  
POP3 server.
          Dim commandData As String
          Dim contentBuffer() As Byte
          Dim responseString As String
 
          ' ----- Tell the server we're through.
          commandData = "QUIT" & vbCrLf
          contentBuffer = System.Text.Encoding.ASCII.GetBytes( _
             commandData.ToCharArray())
          CommandSender.Write(contentBuffer, 0, _
             contentBuffer.Length)
          responseString = ContentReceiver.ReadLine()
 
          ' ----- End the connection.
          ContentReceiver.Close()
          CommandSender.Close()
           
Pop3Server.Close()
       End Sub
 
       Function GetMessage(ByVal whichMessage As Integer) _
             As String
          ' ----- Retrieve a single email message.
          Dim commandData As String
          Dim contentBuffer() As Byte
          Dim responseString As String
          Dim theMessage As New System.Text.StringBuilder
          Dim oneLine As String
 
          ' ----- Check for an invalid message.
          If (whichMessage < 1) Or (whichMessage > Messages) Then
             Throw New ArgumentOutOfRangeException(whichMessage, _
                "Messages are numbered from 1 to the number " & _
                "identified by the Messages property.")
          End If
 
          Try
             ' ----- Request the message.
             commandData = "RETR " & whichMessage & vbCrLf
             contentBuffer = _
                System.Text.Encoding.ASCII.GetBytes( _
                commandData.ToCharArray())
             CommandSender.Write(contentBuffer, 0, _
                contentBuffer.Length)
             responseString = ContentReceiver.ReadLine()
             If (Left(responseString, Len(CommandFailure)) = _
                   CommandFailure) Then
                Throw New Exception("Message retrieval failed.")
             End If
 
             ' ----- The message is all data until a line with
             '       a single dot (.) appears.
             Do While (ContentReceiver.EndOfStream = False)
                oneLine = ContentReceiver.ReadLine()
                If (oneLine = ".") Then Exit Do
                theMessage.AppendLine(oneLine)
             Loop
          Catch ex As InvalidOperationException
             MsgBox("Message retrieval failed: " & ex.Message)
          End Try
 
          ' ----- Return the constructed message.
          Return theMessage.ToString()
       End Function
    End Class

Он у нас будет отвечать за получение списка писем с сервера и показ тела выбранного письма.
Теперь форма, см. рисунок "Форма1"
На ней:
three TextBox controls named . Set the UserPassword control's PasswordChar field to the asterisk character (*). Add a ListBox control named MessageList and two Button controls named ActGet and ActView. Set the Button controls' Text properties to Get Messages and View Message, respectively. Add informational labels if desired

3 TextBox с именами ServerName, UserName и UserPassword. Установите свойство PasswordChar последнего равным *. Добавьте ListBox с именем MessageList и 2 кнопки с именами ActGet и ActView. Установите свойство Text у кнопок равным Get Messages и View Message соответственно. По желанию добавьте метки (label) с пояснениями.
Полный код формы:
Кликните здесь для просмотра всего текста
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
Private POP3Connection As Pop3 = Nothing
 
    Private Sub ActGet_Click(ByVal sender As System.Object, _
          ByVal e As System.EventArgs) Handles ActGet.Click
       ' ----- Initiate a POP3 connection.
       Dim counter As Integer
 
       ' ----- First, disconnect any previous connection.
       If (POP3Connection IsNot Nothing) Then
          Try
             POP3Connection.Disconnect()
          Catch ex As Exception
             ' ----- Ignore.
          End Try
       End If
       POP3Connection = Nothing
 
       ' ----- Clear any previous messages.
       MessageList.Items.Clear()
 
       ' ----- Try the new connection.
       Try
           
POP3Connection = New Pop3
          POP3Connection.Connect(ServerName.Text, _
             UserName.Text, UserPassword.Text)
       Catch ex As Exception
          MsgBox("Connection failure: " & ex.Message)
          POP3Connection = Nothing
          Return
       End Try
 
       ' ----- How many messages?
       If (POP3Connection.Messages = 0) Then
          MsgBox("No messages found.")
          POP3Connection.Disconnect()
          POP3Connection = Nothing
          Return
       End If
 
       ' ----- Show each message.
       For counter = 1 To POP3Connection.Messages
          MessageList.Items.Add("Message Number " & counter)
       Next counter
    End Sub
 
    Private Sub ActView_Click(ByVal sender As System.Object, _
          ByVal e As System.EventArgs) Handles ActView.Click
       ' ----- Show a message.
       Dim whichMessage As Integer
       Dim parts As String()
       Dim content As String
 
       ' ----- Which message? Each item has the format:
       '          Message Number x
       If (MessageList.SelectedIndex = -1) Then Return
       parts = Split(CStr(MessageList.SelectedItem), " ")
       whichMessage = CInt(Val(parts(2)))
 
       ' ----- Get the content.
       content = POP3Connection.GetMessage(whichMessage)
 
       ' ----- Show the content.
       MsgBox(content)
    End Sub
 
    Private Sub MessageList_DoubleClick(ByVal sender As Object, _
          ByVal e As System.EventArgs) _
          Handles MessageList.DoubleClick
       ' ----- Same as the View button.
       ActView.PerformClick()
    End Sub
 
    Private Sub Form1_FormClosing(ByVal sender As Object, _
          ByVal e As System.Windows.Forms.FormClosingEventArgs) _
          Handles Me.FormClosing
       ' ----- Disconnect before leaving.
       On Error Resume Next
 
       If ( 
POP3Connection IsNot Nothing) Then
          POP3Connection.Disconnect()
          POP3Connection = Nothing
       End If
    End Sub

В итоге письма мы сможем увидеть в текстовом представлении. В том числе и вложения там будут в виде строки в кодировке Base64.
В целом рекомендую почитать и поизучать формат файлов .mht - именно в нем тело письма представлено. Добраться в него можно через класс CDO. Но это уже отдельная история (сам разбираюсь понемногу...)
Код не мой, но рабочий - проверено. Взят из книги: Visual Basic 2005 Cookbook (By John Clark Craig, Tim Patrick).
Для страждущих - книга приложена в архиве
13
Миниатюры
Visual Basic .NET FAQ. Готовые решения, полезные коды  
Вложения
Тип файла: rar Visual_Basic_2005_Cookbook.rar (5.63 Мб, 354 просмотров)
MLF
27 / 27 / 4
Регистрация: 14.02.2012
Сообщений: 135
09.03.2013, 08:10 #41
Цитата Сообщение от Памирыч Посмотреть сообщение
vb.net
1
2
3
4
        ..
        Dim VB As New VBCodeProvider()
        Dim Compiler As ICodeCompiler = VB.CreateCompiler()
        ..
Студия ругается на устаревший код. Следуя рекомендациям msdn поправил:
vb.net
1
        Dim Compiler As VBCodeProvider = CodeDomProvider.CreateProvider("VB")
а первую строку можно удалить)
2
Pe4eNEG
108 / 108 / 9
Регистрация: 12.06.2010
Сообщений: 459
Записей в блоге: 2
09.04.2013, 01:33 #42
Восстанавливаем "потерянную" библиотеку или файл из приложения:
Предварительно этот файл нужно добавить в ресурсы приложения.

vb.net
1
2
3
4
5
6
7
8
9
Imports System.IO
Public sub dllRestore() 
        Dim _DllFIle As FileInfo = New FileInfo(My.Application.Info.DirectoryPath & "\имя_библиотеки_или_файла.dll")
        If _DllFIle.Exists = False Then
            MsgBox("Один из компонентов приложения отсутствует, нажмите ОК для восстановления и перезапуска", MsgBoxStyle.Information, "Восстановление программы")
            File.WriteAllBytes(My.Application.Info.DirectoryPath & "\имя_библиотеки_или_файла.dll", My.Resources.имя_библиотеки_или_файла)
             Application.Restart()  'если нужно перезапускаем приложение.    
        End If
    End Sub
7
Gemorg
169 / 146 / 10
Регистрация: 08.11.2012
Сообщений: 225
10.06.2013, 16:19 #43
Кликните здесь для просмотра всего текста

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
Public Class CShadow
 
    'Автор: Григорий Ляпин
    'Распространение свободное, модификация разрешена
 
    Dim _s As Integer
    Dim cnt As Control
 
    Public Sub New(ByVal _Object As Control, ByVal smesh As Integer)
        AddHandler _Object.Paint, AddressOf _Paint
        _s = smesh
        cnt = _Object
    End Sub
 
    Public Property SR() As Integer
        Get
            Return _s
        End Get
        Set(ByVal value As Integer)
            _s = value
            cnt.Invalidate()
        End Set
    End Property
 
    Private Sub _Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs)
 
        e.Graphics.SmoothingMode = Drawing2D.SmoothingMode.AntiAlias
 
        For i = 0 To cnt.Controls.Count - 1
 
            Dim r As Rectangle
            r.Location = New Point(cnt.Controls(i).Location.X + _s, _
                                   cnt.Controls(i).Location.Y + _s)
            r.Size = cnt.Controls(i).Size
 
            e.Graphics.FillRectangle(Brushes.LightGray, r)
 
        Next
 
    End Sub
 
End Class


Как использовать:
Добавить в тело класса/событие/куда хотите вот этот код:
vb.net
1
Dim shadow As New CShadow(Me, 5)
4
Farzy
29 / 29 / 2
Регистрация: 14.01.2013
Сообщений: 74
21.06.2013, 21:25 #44
Функция для проверки прокси :
vb.net
1
2
3
4
5
6
7
8
9
10
11
12
 Dim item As String = "прокси"
 Try
                With CreateObject("MSXML2.ServerXMLHTTP.6.0")
                    .setProxy(2, item)
                    .Open("GET", "http://internet.yandex.ru/", False)
                    .setTimeouts(2000, 2000, 3000, 2000)
                    .send("")
                End With
                TextBox4.AppendText(vbNewLine & "[Works]> " & item)
            Catch ex As Exception
                TextBox4.AppendText(vbNewLine & "[Exception]>" & item)
            End Try
5
AeroWhite
Форумчанин.NET
540 / 411 / 63
Регистрация: 12.02.2013
Сообщений: 834
24.06.2013, 09:41 #45
Альтернативная отправка писем на E-mail

Сверху проекта подключаем:
vb.net
1
2
Imports System.Net.Mail
Imports System.Text
А дальше располагаем код на свою кнопку:
vb.net
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
        Dim EMail As New MailMessage
        Dim Smtp As SmtpClient
        Smtp = New SmtpClient("smtp.yandex.ru")
        Smtp.Port = 587
        Smtp.Credentials = New Net.NetworkCredential("Кто@отправляет.ru", "Пароль") 'Данные Вашей почты
        EMail.From = New MailAddress("Кто@отправляет.ru", Subject.Text) ' Subject.Text здесь для красоты, по желанию можно убрать
        EMail.To.Add(New MailAddress("Кому@отправляем.ru"))
        EMail.Body = Message.Text 'Основной текст
        EMail.Subject = Subject.Text 'Тема письма
        Try
            Smtp.Send(EMail)
            MsgBox("Ваше сообщение отправлено. Спасибо!", MsgBoxStyle.Information)
        Catch ex As Exception
            MsgBox("Ваше сообщение не было отправлено. Пожалуйста, повторите попытку", MsgBoxStyle.Critical)
        End Try
+ красивое прикрепление файлов в архиве
10
Вложения
Тип файла: rar Отправка E-mail.rar (45.9 Кб, 353 просмотров)
24.06.2013, 09:41
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
24.06.2013, 09:41
Привет! Вот еще темы с ответами:

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

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

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

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


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

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

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