+- منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب (http://vb4arb.com/vb)
+-- قسم : قسم لغة الفيجوال بيسك VB.NET (http://vb4arb.com/vb/forumdisplay.php?fid=182)
+--- قسم : قسم اسئلة VB.NET (http://vb4arb.com/vb/forumdisplay.php?fid=183)
+--- الموضوع : [سؤال] رغم استخدام دالة المعالج الخلفي إلا أنه ما زال يوجد تهنيج عند تنفيذ الكود (/showthread.php?tid=22243)
رغم استخدام دالة المعالج الخلفي إلا أنه ما زال يوجد تهنيج عند تنفيذ الكود - السندبااد - 25-10-17
السلام عليكم ورحمة الله وبركاته
حاولت إضافة دالة المعالج الخلفي إلا أنه ما زال يوجد تهنيج عند تنفيذ الكود
وهذا هو الكود الذي أقوم بتنفيذه:
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
RE: رغم استخدام دالة المعالج الخلفي إلا أنه ما زال يوجد تهنيج عند تنفيذ الكود - silverlight - 25-10-17
لم أستخدم Net Namespace كثيرا و أيضا لم أتعامل مع Dispatcher
عموما و حسب ما اعرف ان Dispatcher مصصم للإستخدام مع wpf و ليس الويندوز فورم
وعلي ما أظن في حالتك هنا أنك محتاج تمرر له روتين او Delegate sub و ليس دالة أو Delegate Function
ايضا عليك اغلاق stream reader المستخدم داخل الدالة
حاول تستخدم الدالة مباشرة بدون استخدامها من خلال Task
RE: رغم استخدام دالة المعالج الخلفي إلا أنه ما زال يوجد تهنيج عند تنفيذ الكود - السندبااد - 25-10-17
شكراً لردك أخي العزيز 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
RE: رغم استخدام دالة المعالج الخلفي إلا أنه ما زال يوجد تهنيج عند تنفيذ الكود - a.ahmed - 25-10-17
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
RE: رغم استخدام دالة المعالج الخلفي إلا أنه ما زال يوجد تهنيج عند تنفيذ الكود - السندبااد - 25-10-17
جزاك الله خيراً أخي العزيز الفاضل أحمد
تم حل المشكلة، والسبب كان خطأ مني في ترتيب الأحداث، وبتعديلك تم حل المشكلة
اسأل الله تعالى أن يبارك فيك وبعلمك
تم حل المشكلة، والسبب كان خطأ مني في ترتيب الأحداث، وبتعديلك تم حل المشكلة
اسأل الله تعالى أن يبارك فيك وبعلمك
RE: رغم استخدام دالة المعالج الخلفي إلا أنه ما زال يوجد تهنيج عند تنفيذ الكود - a.ahmed - 25-10-17
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
RE: رغم استخدام دالة المعالج الخلفي إلا أنه ما زال يوجد تهنيج عند تنفيذ الكود - السندبااد - 25-10-17
أكرر شكري العميق لك أخي الحبيب a.ahmed
لا أفضل طريقة Regex في التعامل مع صفحات الإنترنت، وأجد من الأفضل طريقة HtmlAgilityPack
وقد عدلت الكود، ولم يعد هنالك تهنيج، والفضل لله ثم لك
تحياتي لك أخي الفاضل