تقييم الموضوع :
  • 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
فاعلم أنه لا إله إلا الله
الرد }}}
تم الشكر بواسطة: سعود الشامان


المواضيع المحتمل أن تكون متشابهة .
الموضوع : الكاتب الردود : المشاهدات : آخر رد
  ممكن حل المشكلة فى الكود التالي - من مشاركة استاذنا القدير / عبدالله الدوسري new_programer 4 169 02-03-24, 07:36 PM
آخر رد: new_programer
  ماهو حل هذا الخطأ في الكود melad2002 7 264 25-02-24, 12:25 AM
آخر رد: justforit
  كيفية تنفيذ امر عند التعليم على checkbox بالداتا جريد فيو heem1986 2 158 21-02-24, 01:37 AM
آخر رد: heem1986
  كيفية انشاء سكريبت لقاعدة بيانات من خلال الكود heem1986 1 194 20-02-24, 12:00 AM
آخر رد: Kamil
  كيفية تنفيذ أمر عرض بيانات من فورم ثان مصمم هاوي 7 329 19-02-24, 12:28 AM
آخر رد: مصمم هاوي
  تنفيذ كود عند حدوث تغيرات فى أحد جداول قاعد بيانات sql heem1986 2 247 16-02-24, 06:37 AM
آخر رد: عبدالله الدوسري
  مشكلة عدم اكتمال تنفيذ بسبب فصل الشبكة او التيار الكهربائي اثناء النتفيذ تناسيم 3 1,840 05-02-24, 10:04 PM
آخر رد: 01AHMED
  [VB.NET] أرغب فى استخدام هذا الكود بالتحديد على الإصدار 10 AmeenRashed 3 206 19-01-24, 12:42 PM
آخر رد: Taha Okla
  [VB.NET] ما الخطأ فى هذا الكود - كود البحث المتعدد Ashraf Elafify 7 464 27-12-23, 10:50 PM
آخر رد: Ashraf Elafify
  كيفية رسم بيان دالة رياضية؟ الخير19 6 415 23-12-23, 03:36 PM
آخر رد: الخير19

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


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