منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب - رغم استخدام دالة المعالج الخلفي إلا أنه ما زال يوجد تهنيج عند تنفيذ الكود

السلام عليكم ورحمة الله وبركاته

حاولت إضافة دالة المعالج الخلفي إلا أنه ما زال يوجد تهنيج عند تنفيذ الكود

وهذا هو الكود الذي أقوم بتنفيذه:

PHP كود :

   Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        Task.Factory.StartNew(Sub()
                                  'تاريخ النت
                                  Dispatcher.BeginInvoke(Sub() GetDateNet = GetInternetTime("time.nist.gov", True))
                              End Sub)
    End Sub


    Public Function GetInternetTime(ByVal host As String, Optional ByVal ToLocalTime As Boolean = False) As DateTime
        'الحصول على تاريخ النت
        Dim timeStr As String
        Dim reader As New IO.StreamReader(New Net.Sockets.TcpClient(host, 13).GetStream)
        Dim LastSysTime As DateTime
        LastSysTime = DateTime.UtcNow()
        timeStr = reader.ReadToEnd
        reader.Close()

        Dim year As Integer = CInt(timeStr.Substring(7, 2)) + 2000
        Dim month As Integer = CInt(timeStr.Substring(10, 2))
        Dim day As Integer = CInt(timeStr.Substring(13, 2))
        Dim hour As Integer = CInt(timeStr.Substring(16, 2))
        Dim minute As Integer = CInt(timeStr.Substring(19, 2))
        Dim second As Integer = CInt(timeStr.Substring(22, 2))

        If ToLocalTime Then
            Return New DateTime(year, month, day, hour, minute, second).ToLocalTime
        Else
            Return New DateTime(year, month, day, hour, minute, second)
        End If
    End Function 

لم أستخدم Net Namespace كثيرا و أيضا لم أتعامل مع Dispatcher
عموما و حسب ما اعرف ان Dispatcher مصصم للإستخدام مع wpf و ليس الويندوز فورم
وعلي ما أظن في حالتك هنا أنك محتاج تمرر له روتين او Delegate sub و ليس دالة أو Delegate Function
ايضا عليك اغلاق stream reader المستخدم داخل الدالة
حاول تستخدم الدالة مباشرة بدون استخدامها من خلال Task

شكراً لردك أخي العزيز silverlight

لقد جربت استخدام Delegate sub وحاولت استخدام الدالة مباشرة بدون Task ولكن بدون فائدة فلم يتغير أي شيء بخصوص التهنيج

أيضاً جربت كوداً مغايراً له علاقة بالبحث عن قيمة في ملف نصي مرفوع على النت، وأيضاً ما زال هنالك تهنيج:

PHP كود :

   Private Sub IsUpdate()
         Try
            ' تعيين ملف نصي مؤقت لحفظ بيانات ملف النت فيه
            Dim tmpFile As String = IO.Path.GetTempPath & Guid.NewGuid.ToString & ".tmp"

            My.Computer.Network.DownloadFile("http://shhada.net/myfiles/FbAutoPublish.txt", tmpFile)

            ' قراءة بيانات الملف النصي المؤقت
            Dim NewUpdate As String = IO.File.ReadAllText(tmpFile)
            If IsNumeric(NewUpdate) = False Then
                Msgbox("هنالك مشكلة في المخدم عاود التحديث لاحقاً !!")
 
            End If

            'إذا كان رقم الإصدار ليس فارغاً وأكبر من رقم التحديث الحالي
            'فهذا يدل على أن هنالك تحديث جديد
            If NewUpdate <> "" AndAlso (Val(NewUpdate) > Val(CurrentUpdate)) Then
                BtnUpdate.Content = "يتوفر تحديث جديد، انقر هنا لتحميله"
            Else
                Msgbox("أنت تمتلك أحدث إصدار من البرنامج")
            End If
        Catch ex As Exception
            Msgbox(ex.Message)
        End Try
    End Sub 

PHP كود :

Private Sub IsUpdate()
    System.
        Threading.
        Tasks.
        Task.
        Factory.
        StartNew(
            Sub()
                Try
                    ' تعيين ملف نصي مؤقت لحفظ بيانات ملف النت فيه
                    Dim tmpFile As String = IO.Path.GetTempPath & Guid.NewGuid.ToString & ".tmp"

                    My.Computer.Network.DownloadFile("http://shhada.net/myfiles/FbAutoPublish.txt", tmpFile)

                    ' قراءة بيانات الملف النصي المؤقت
                    Dim NewUpdate As String = IO.File.ReadAllText(tmpFile)
                    If IsNumeric(NewUpdate) = False Then
                        MsgBox("هنالك مشكلة في المخدم عاود التحديث لاحقاً !!")

                    End If

                    'إذا كان رقم الإصدار ليس فارغاً وأكبر من رقم التحديث الحالي
                    'فهذا يدل على أن هنالك تحديث جديد
                    If NewUpdate <> "" AndAlso (Val(NewUpdate) > Val(CurrentUpdate)) Then
                        Dispatcher.BeginInvoke(Sub() BtnUpdate.Content = "يتوفر تحديث جديد، انقر هنا لتحميله")
                    Else
                        MsgBox("أنت تمتلك أحدث إصدار من البرنامج")
                    End If
                Catch ex As Exception
                    MsgBox(ex.Message)
                End Try
            End Sub)
End Sub 

PHP كود :

Private Sub Window_Loaded(ByVal sender As Object, ByVal e As RoutedEventArgs) Handles MyBase.Loaded
    IsUpdate()
End Sub 

جزاك الله خيراً أخي العزيز الفاضل أحمد
تم حل المشكلة، والسبب كان خطأ مني في ترتيب الأحداث، وبتعديلك تم حل المشكلة
اسأل الله تعالى أن يبارك فيك وبعلمك
Smile

PHP كود :

Sub InfoUsers()
    System.
    Threading.
    Tasks.
    Task.
    Factory.
    StartNew(
        Sub()

            Try
                Dim UrlShhada As String = "http://www.shhada.net/myfiles/NameUsers/index.htm"
                Dim GetNameUser As String = "//*[@id='shhada']"
                ' Dim GetNameUser As String = "//*[@id='mhmoodmossly']"

                'Dispatcher.BeginInvoke(Sub() Web.OverrideEncoding = System.Text.Encoding.Default) 'كي تظهر الأسماء باللغة العربية بشكل صحيح
                'Dim Doc As New HtmlAgilityPack.HtmlDocument

                'Dispatcher.BeginInvoke(Sub() Doc = Web.Load(UrlShhada))

                'For Each nameResult As HtmlAgilityPack.HtmlNode In Doc.DocumentNode.SelectNodes(GetNameUser)
                '    Dispatcher.BeginInvoke(Sub() NameUserAccount = nameResult.SelectSingleNode(".//td[@id='name']").InnerText)
                '    Dispatcher.BeginInvoke(Sub() IntervalLicenseAccount = nameResult.SelectSingleNode(".//td[@id='intervallicense']").InnerText)
                '    Dispatcher.BeginInvoke(Sub() DateStart = nameResult.SelectSingleNode(".//td[@id='datestar']").InnerText)
                '    Dispatcher.BeginInvoke(Sub() DateEnd = nameResult.SelectSingleNode(".//td[@id='dateend']").InnerText)
                'Next


                Dim source As String = New Net.WebClient() With {.Encoding = System.Text.Encoding.Default}.DownloadString(UrlShhada)

                Dim users = Regex.Matches(source, "<tr id=""[^headertable]\w+"">.+?</tr>", RegexOptions.Singleline)

                For Each m As Match In users

                    Dim userName As String = Regex.Match(m.Value, "(?<=<td id=""name"">).+?(?=</td>)").Value
                    Dim userInterval As String = Regex.Match(m.Value, "(?<=<td id=""intervallicense"">).+?(?=</td>)").Value
                    Dim userDateStart As String = Regex.Match(m.Value, "(?<=<td id=""datestar"">).+?(?=</td>)").Value
                    Dim userDateEnd As String = Regex.Match(m.Value, "(?<=<td id=""dateend"">).+?(?=</td>)").Value

                    MsgBox("NameUser: " & vbTab & userName & vbNewLine &
                           "IntervalLicense: " & vbTab & userInterval & vbNewLine &
                           "DateStart: " & vbTab & vbTab & userDateStart & vbNewLine &
                           "DateEnd: " & vbTab & vbTab & userDateEnd)

                    Dispatcher.BeginInvoke(Sub() NameUserAccount = userName)
                    Dispatcher.BeginInvoke(Sub() IntervalLicenseAccount = userInterval)
                    Dispatcher.BeginInvoke(Sub() DateStart = userDateStart)
                    Dispatcher.BeginInvoke(Sub() DateEnd = userDateEnd)

                Next

            Catch ex As Exception
                MsgBox(ex.Message)
            End Try
        End Sub)
End Sub 

أكرر شكري العميق لك أخي الحبيب a.ahmed

لا أفضل طريقة Regex في التعامل مع صفحات الإنترنت، وأجد من الأفضل طريقة HtmlAgilityPack

وقد عدلت الكود، ولم يعد هنالك تهنيج، والفضل لله ثم لك

تحياتي لك أخي الفاضل

منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب

السندبااد

silverlight

السندبااد

a.ahmed

السندبااد

a.ahmed

السندبااد