تقييم الموضوع :
  • 0 أصوات - بمعدل 0
  • 1
  • 2
  • 3
  • 4
  • 5
[سؤال] رغم استخدام دالة المعالج الخلفي إلا أنه ما زال يوجد تهنيج عند تنفيذ الكود
#1
السلام عليكم ورحمة الله وبركاته
حاولت إضافة دالة المعالج الخلفي إلا أنه ما زال يوجد تهنيج عند تنفيذ الكود
وهذا هو الكود الذي أقوم بتنفيذه:

PHP كود :
   Private Sub Button1_Click(sender As ObjectAs EventArgsHandles 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(host13).GetStream)
 
       Dim LastSysTime As DateTime
        LastSysTime 
DateTime.UtcNow()
 
       timeStr reader.ReadToEnd
        reader
.Close()

 
       Dim year As Integer CInt(timeStr.Substring(72)) + 2000
        Dim month 
As Integer CInt(timeStr.Substring(102))
 
       Dim day As Integer CInt(timeStr.Substring(132))
 
       Dim hour As Integer CInt(timeStr.Substring(162))
 
       Dim minute As Integer CInt(timeStr.Substring(192))
 
       Dim second As Integer CInt(timeStr.Substring(222))

 
       If ToLocalTime Then
            Return 
New DateTime(yearmonthdayhourminutesecond).ToLocalTime
        Else
            Return 
New DateTime(yearmonthdayhourminutesecond)
 
       End If
 
   End Function 
فاعلم أنه لا إله إلا الله
الرد
تم الشكر بواسطة: Amir_Alzubidy
#2
لم أستخدم Net Namespace كثيرا و أيضا لم أتعامل مع Dispatcher
عموما و حسب ما اعرف ان Dispatcher مصصم للإستخدام مع wpf و ليس الويندوز فورم
وعلي ما أظن في حالتك هنا أنك محتاج تمرر له روتين او Delegate sub و ليس دالة أو Delegate Function
ايضا عليك اغلاق stream reader المستخدم داخل الدالة
حاول تستخدم الدالة مباشرة بدون استخدامها من خلال Task
Retired
الرد
#3
شكراً لردك أخي العزيز 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 
فاعلم أنه لا إله إلا الله
الرد
تم الشكر بواسطة: Amir_Alzubidy
#4
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 ObjectByVal e As RoutedEventArgsHandles MyBase.Loaded
    IsUpdate
()
End Sub 
الرد
#5
جزاك الله خيراً أخي العزيز الفاضل أحمد
تم حل المشكلة، والسبب كان خطأ مني في ترتيب الأحداث، وبتعديلك تم حل المشكلة
اسأل الله تعالى أن يبارك فيك وبعلمك
Smile
فاعلم أنه لا إله إلا الله
الرد
تم الشكر بواسطة: Amir_Alzubidy , Amir_Alzubidy
#6
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 
الرد
#7
أكرر شكري العميق لك أخي الحبيب a.ahmed
لا أفضل طريقة Regex في التعامل مع صفحات الإنترنت، وأجد من الأفضل طريقة HtmlAgilityPack
وقد عدلت الكود، ولم يعد هنالك تهنيج، والفضل لله ثم لك
تحياتي لك أخي الفاضل
Smile
فاعلم أنه لا إله إلا الله
الرد
تم الشكر بواسطة: سعود الشامان


المواضيع المحتمل أن تكون متشابهة .
الموضوع : الكاتب الردود : المشاهدات : آخر رد
  [سؤال] السلام عليكم هل يوجد حل افضل من هذا mohamedahmed1 2 27 منذ 1 دقيقه مضت
آخر رد: dasktop
  [VB.NET] كيف بامكاني تنفيذ مثل هذه الفكرة ؟ ميدو الفنان 17 236 منذ 30 دقيقة مضت
آخر رد: viv
Sad [سؤال] لدي مشكلة في الكود الاتصال tridz 13 209 منذ 8 ساعة مضت
آخر رد: سعود
  مساعدة ففي اصلاح هذا الكود mohamedahmed1 2 78 أمس, 03:24 AM
آخر رد: mohamedahmed1
Exclamation [VB.NET] تنفيذ حدث SelectedIndexChanged لأداة ListBox المرتبط برمجيا بDataTable عند فتح الفورم سميـر 8 131 23-08-19, 12:22 AM
آخر رد: ابراهيم ايبو
  الكود يعمل بشكل صحيح ولكن خالد كامل1 5 107 18-08-19, 04:43 AM
آخر رد: خالد كامل1
Thumbs Up [VB.NET] هل ممكن تغيير رقم الهارد عن طريق الكود رمضان محمد 1 262 16-08-19, 11:08 PM
آخر رد: عماني939
  [سؤال] هل يمكن استخدام بديل لاداة WebBrowser mohamedahmed1 3 111 13-08-19, 06:33 PM
آخر رد: mohamedahmed1
  [VB.NET] هذا الخطأ في هذا الكود mac9 2 88 13-08-19, 01:33 AM
آخر رد: الرائد
Exclamation [VB.NET] خطأ في الكود عندما يعمل إثنين في الشبكة sniperjawadino 10 295 10-08-19, 01:47 PM
آخر رد: asemshahen5

التنقل السريع :


يقوم بقرائة الموضوع: بالاضافة الى ( 1 ) ضيف كريم