منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب
فحص النص هل هو تاريخ حقيقي او غير معتمد بالجهاز - نسخة قابلة للطباعة

+- منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب (http://vb4arb.com/vb)
+-- قسم : قسم لغة الفيجوال بيسك VB.NET (http://vb4arb.com/vb/forumdisplay.php?fid=182)
+--- قسم : قسم امثلة ومشاريع VB.NET (http://vb4arb.com/vb/forumdisplay.php?fid=188)
+--- الموضوع : فحص النص هل هو تاريخ حقيقي او غير معتمد بالجهاز (/showthread.php?tid=55520)



فحص النص هل هو تاريخ حقيقي او غير معتمد بالجهاز - justforit - 10-11-25

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

يوجد خطأ تم تصحيحه في المشاركة اللاحقة







هذا مثال بعد البهدلة اللتي حصلت مع التاريخ فاستخدام اجراء Isdate لا يفرق بين أي نص وبين نص التاريخ غير المعتمد بالجهاز لكنه نص تاريخ والدليل انك ان قمت بالتعديل على اعدادات الجهاز بخصوص تنسيق التاريخ يتم اعتماد نص التاريخ كتاريخ
المهم  المرفق كما بالصور 
و من لا يريد تحميل المرفق الكود التالي كامل كلاس الفورم
كود :
Imports System.Globalization
Imports System.Net
Imports System.Text
Public Class Form1
   Dim arr() As String = New String() {"أمس", "ساعة", "دقيقة"}
   Function Extract_date(txt As String, ff As String) As DateTime
       ' Try
       Return DateTime.ParseExact(txt, ff, CultureInfo.InvariantCulture)
       ' Catch ex As Exception
       'Return Nothing
       ' End Try
   End Function
   Public Function ToTimeStamp(ByVal target As Date) As Long
       Dim [date] As New DateTime(1970, 1, 1, 0, 0, 0, target.Kind)
       Dim hubspotTimestamp As Long = Convert.ToInt64((target - [date]).TotalSeconds)
       Return hubspotTimestamp
   End Function
   Public Function ConvertUnixTimestampToDateTime(ByVal unixTimestamp As Long) As DateTime
       ' Define the Unix epoch start date
       Dim epoch As New DateTime(1970, 1, 1, 0, 0, 0, DateTimeKind.Utc)
       ' Add the Unix timestamp (in seconds) to the epoch
       Dim dateTimeResult As DateTime = epoch.AddSeconds(unixTimestamp)
       ' Optionally, convert to local time if needed
       ' dateTimeResult = dateTimeResult.ToLocalTime()
       Return dateTimeResult
   End Function
   Public Function IsDateTime(ByVal inputString As String) As Boolean
       Dim dt As DateTime
       Return DateTime.TryParse(inputString, dt)
   End Function
   Function gettime(url As String) As String
       Dim wc As New WebClient
       wc.Encoding = Encoding.UTF8
       Dim html As String = wc.DownloadString(url)
       Dim doc As New HtmlAgilityPack.HtmlDocument
       doc.LoadHtml(html)
       Return doc.DocumentNode.SelectSingleNode("//span[@class='post_date']").FirstChild.InnerText
   End Function
   Private Sub Button1_Click(sender As Object, e As EventArgs) Handles btnGetdate.Click
       'Dim d As DateTime = Extract_date(t1.Text.TrimEnd, "dd-MM-yy, hh:mm tt")
       If (txturl.Text.Trim = "" And txtdate.Text.Trim = "") Then
           MsgBox("اما اكتب رابط مشاركة بالمربع الاول او اكتب تاريخ كامل مع الوقت بالمربع الثاني")
           Return
       End If
       Dim url As String = txturl.Text
       Dim dt As String = ""
       If url.Trim <> "" Then
           dt = gettime(url).TrimEnd
       ElseIf txtdate.Text.Trim <> "" Then
           dt = txtdate.Text
       End If
       If arr.Contains(dt.Split(",")(0)) Then
           Dim d As DateTime = Now.AddDays(-1).ToString("d")
           Dim t As DateTime = CDate(dt.Split(",")(1)).ToString("hh:mm tt")
           Dim dateString As String = d
           Dim timeString As String = t
           Dim combinedString As String = $"{dateString} {timeString}"
           TextBox2.Text = ToTimeStamp(combinedString)
       Else
           If IsDateTime(dt) Then
               TextBox2.Text = ToTimeStamp(dt)
           Else
               Dim f As String = InputBox("ادخل تنسيق التاريخ ثم حاول مجددا", "", "dd-MM-yy, hh:mm tt")
               Dim xd As String = Extract_date(dt, f)
               TextBox2.Text = ToTimeStamp(xd)
           End If
       End If
   End Sub
   Private Sub TextBox1_MouseClick(sender As Object, e As MouseEventArgs) Handles txturl.MouseClick
       If e.Button = MouseButtons.Left Then
           txturl.Clear()
           If Clipboard.GetText.Trim <> "" Then
               txturl.Paste()
           End If
       End If
   End Sub

   Private Sub TextBox2_MouseClick(sender As Object, e As MouseEventArgs) Handles TextBox2.MouseClick
       If e.Button = MouseButtons.Left Then
           TextBox2.Clear()
           If Clipboard.GetText.Trim <> "" Then
               TextBox2.Paste()
           End If
       End If
   End Sub

   Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
       TextBox3.Text = ConvertUnixTimestampToDateTime(TextBox2.Text)
   End Sub
End Class
الهدف انشاء مايسمى dateline بعد تحويل التاريخ الى:
TimeStamp
هذا يناسب ان يخزن في عمود الـdateline في جدول mybb_threads  وجداول اخرى
password:vb4arb
احمد الله تعالى ثم اشكر الاخ اللذي قام بتحويل اكواد بي اتش بي الى فيجوال بيسك دوت نت في اعوام 2012-2013
الكلاس كما المرفق يحتوى اكواد مهمة لاي مبتديء وقد تكون مهمة للمتوسط ايضا.
اسعد الله مساءكم بكل خير
و السلام عليكم ورحمة الله و بركاته
ارجوكم الدعاء لي بالتوفيق



RE: فحص النص هل هو تاريخ حقيقي او غير معتمد بالجهاز - justforit - 10-11-25

عدلت على الكلاس كالتالي لم ارفق المرفق او احدثه
كود :
Imports System.Globalization
Imports System.Net
Imports System.Text
Public Class Form1
   Dim arr() As String = New String() {"منذ", "أمس"}
   Function Extract_date(txt As String, ff As String) As DateTime
       ' Try
       Return DateTime.ParseExact(txt, ff, CultureInfo.InvariantCulture)
       ' Catch ex As Exception
       'Return Nothing
       ' End Try
   End Function
   Public Function ToTimeStamp(ByVal target As Date) As Long
       Dim [date] As New DateTime(1970, 1, 1, 0, 0, 0, target.Kind)
       Dim hubspotTimestamp As Long = Convert.ToInt64((target - [date]).TotalSeconds)
       Return hubspotTimestamp
   End Function
   Public Function ConvertUnixTimestampToDateTime(ByVal unixTimestamp As Long) As DateTime
       ' Define the Unix epoch start date
       Dim epoch As New DateTime(1970, 1, 1, 0, 0, 0, DateTimeKind.Utc)
       ' Add the Unix timestamp (in seconds) to the epoch
       Dim dateTimeResult As DateTime = epoch.AddSeconds(unixTimestamp)
       ' Optionally, convert to local time if needed
       ' dateTimeResult = dateTimeResult.ToLocalTime()
       Return dateTimeResult
   End Function
   Public Function IsDateTime(ByVal inputString As String) As Boolean
       Dim dt As DateTime
       Return DateTime.TryParse(inputString, dt)
   End Function
   Function gettime(url As String) As String
       Dim wc As New WebClient
       wc.Encoding = Encoding.UTF8
       Dim html As String = wc.DownloadString(url)
       Dim doc As New HtmlAgilityPack.HtmlDocument
       doc.LoadHtml(html)
       Return doc.DocumentNode.SelectSingleNode("//span[@class='post_date']").FirstChild.InnerText
   End Function
   Private Sub Button1_Click(sender As Object, e As EventArgs) Handles btnGetdate.Click
       'Dim d As DateTime = Extract_date(t1.Text.TrimEnd, "dd-MM-yy, hh:mm tt")
       If (txturl.Text.Trim = "" And txtdate.Text.Trim = "") Then
           MsgBox("اما اكتب رابط مشاركة بالمربع الاول او اكتب تاريخ كامل مع الوقت بالمربع الثاني")
           Return
       End If
       Dim url As String = txturl.Text
       Dim dt As String = ""
       If url.Trim <> "" Then
           dt = gettime(url).TrimEnd.TrimStart
       ElseIf txtdate.Text.Trim <> "" Then
           dt = txtdate.Text
       End If
       If arr.Contains(dt.Split(" ")(0)) Then
           Dim n As String = Val(dt.Split(" ")(1))
           Dim horm As String = dt.Split(" ")(2)
           If horm.Trim = "ساعة" Or horm.Trim = "ساعه" Then
               Dim d As DateTime = Now.AddHours(-n).ToString("f")
               TextBox2.Text = ToTimeStamp(d)
           ElseIf horm.Trim = "دقيقة" Or horm.Trim = "دقيقه" Then
               Dim d As DateTime = Now.AddMinutes(-n).ToString("f")
               TextBox2.Text = ToTimeStamp(d)
           End If
       ElseIf dt.Contains(",") Then
           If arr.Contains(dt.Split(",")(0)) Then
               Dim d As DateTime = Now.AddDays(-1).ToString("d")
               Dim t As DateTime = CDate(dt.Split(",")(1)).ToString("hh:mm tt")
               Dim dateString As String = d
               Dim timeString As String = t
               Dim combinedString As String = $"{dateString} {timeString}"
               TextBox2.Text = ToTimeStamp(combinedString)
           End If
       Else
           If IsDateTime(dt) Then
               TextBox2.Text = ToTimeStamp(dt)
           Else
               Dim f As String = InputBox("ادخل تنسيق التاريخ ثم حاول مجددا", "", "dd-MM-yy, hh:mm tt")
               Dim xd As String = Extract_date(dt, f)
               TextBox2.Text = ToTimeStamp(xd)
           End If
       End If
   End Sub
   Private Sub TextBox1_MouseClick(sender As Object, e As MouseEventArgs) Handles txturl.MouseClick
       If e.Button = MouseButtons.Left Then
           txturl.Clear()
           If Clipboard.GetText.Trim <> "" Then
               txturl.Paste()
           End If
       End If
   End Sub

   Private Sub TextBox2_MouseClick(sender As Object, e As MouseEventArgs) Handles TextBox2.MouseClick
       If e.Button = MouseButtons.Left Then
           TextBox2.Clear()
           If Clipboard.GetText.Trim <> "" Then
               TextBox2.Paste()
           End If
       End If
   End Sub

   Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
       TextBox3.Text = ConvertUnixTimestampToDateTime(TextBox2.Text)
   End Sub
End Class
تم تعديل الخطأ



RE: فحص النص هل هو تاريخ حقيقي او غير معتمد بالجهاز - justforit - 12-11-25

تم تعديل الخطا في الكلاس



RE: فحص النص هل هو تاريخ حقيقي او غير معتمد بالجهاز - مصمم هاوي - 12-11-25

(12-11-25, 03:52 AM)justforit كتب :
تم تعديل الخطا في الكلاس

ٱمين
أكثر شئ يزعجني هو تنسيق التاريخ


RE: فحص النص هل هو تاريخ حقيقي او غير معتمد بالجهاز - justforit - 12-11-25

(12-11-25, 06:48 PM)مصمم هاوي كتب :
(12-11-25, 03:52 AM)justforit كتب :
تم تعديل الخطا في الكلاس

ٱمين
أكثر شئ يزعجني هو تنسيق التاريخ

حياك الله اخي الكريم
انا وكل النصوص حول التاريخ في تحدي.
اليوم قرات وقت مشاركتي البارح مكتوبة "اليوم, والوقت" كلمة اليوم لم اقراها قبلSmile.
فاضفتها للمصفوفة بالكلاس لكني لم احدث المكتوب بالمشاركة لاني اظن انها واضحة.
اشكر زيارتك للموضوع.


RE: فحص النص هل هو تاريخ حقيقي او غير معتمد بالجهاز - justforit - 13-11-25

(13-11-25, 12:22 AM)Zuhare كتب : تعديل غير مجرب يعني مش مضمون
كود :
Imports System.Globalization
Imports System.Net
Imports System.Text
Public Class Form1
   Dim arr() As String = New String() {"منذ", "أمس", "اليوم"}
   Function Extract_date(ByVal txt As String, ByVal ff As String) As DateTime
       ' Try
       Return DateTime.ParseExact(txt, ff, CultureInfo.InvariantCulture)
       ' Catch ex As Exception
       'Return Nothing
       ' End Try
   End Function
   Public Function ToTimeStamp(ByVal target As Date) As Long
       Dim [date] As New DateTime(1970, 1, 1, 0, 0, 0, target.Kind)
       Dim hubspotTimestamp As Long = Convert.ToInt64((target - [date]).TotalSeconds)
       Return hubspotTimestamp
   End Function
   Public Function ConvertUnixTimestampToDateTime(ByVal unixTimestamp As Long) As DateTime
       ' Define the Unix epoch start date
       Dim epoch As New DateTime(1970, 1, 1, 0, 0, 0, DateTimeKind.Utc)
       ' Add the Unix timestamp (in seconds) to the epoch
       Dim dateTimeResult As DateTime = epoch.AddSeconds(unixTimestamp)
       ' Optionally, convert to local time if needed
       ' dateTimeResult = dateTimeResult.ToLocalTime()
       Return dateTimeResult
   End Function
   Public Function IsDateTime(ByVal inputString As String) As Boolean
       Dim dt As DateTime
       Return DateTime.TryParse(inputString, dt)
   End Function
   Function gettime(ByVal url As String) As String
       Dim wc As New WebClient
       wc.Encoding = Encoding.UTF8
       Dim html As String = wc.DownloadString(url)
       Dim doc As New HtmlAgilityPack.HtmlDocument
       doc.LoadHtml(html)
       Return doc.DocumentNode.SelectSingleNode("//span[@class='post_date']").FirstChild.InnerText
   End Function
   Private Sub Button1_Click(ByVal sender As Object, ByVal e As EventArgs) Handles btnGetdate.Click
       'Dim d As DateTime = Extract_date(t1.Text.TrimEnd, "dd-MM-yy, hh:mm tt")
       If (txturl.Text.Trim = "" And txtdate.Text.Trim = "") Then
           MsgBox("اما اكتب رابط مشاركة بالمربع الاول او اكتب تاريخ كامل مع الوقت بالمربع الثاني")
           Return
       End If
       Dim url As String = txturl.Text
       Dim dt As String = ""
       If url.Trim <> "" Then
           dt = gettime(url).TrimEnd.TrimStart
       ElseIf txtdate.Text.Trim <> "" Then
           dt = txtdate.Text
       End If
       If dt.Split(" ")(0) = arr(0) Then
           Dim n As String = Val(dt.Split(" ")(1))
           Dim horm As String = dt.Split(" ")(2)
           If horm.Trim = "ساعة" Or horm.Trim = "ساعه" Then
               Dim d As DateTime = Now.AddHours(-n).ToString("f")
               TextBox2.Text = ToTimeStamp(d)
           ElseIf horm.Trim = "دقيقة" Or horm.Trim = "دقيقه" Then
               Dim d As DateTime = Now.AddMinutes(-n).ToString("f")
               TextBox2.Text = ToTimeStamp(d)
           ElseIf n = 0 Then
               Dim d As DateTime = Now.ToString("f")
               TextBox2.Text = ToTimeStamp(d)
           End If
       ElseIf dt.Contains(",") AndAlso dt.Split(",")(0) = arr(1) Then
           Dim d As DateTime = Now.AddDays(-1).ToString("d")
           Dim t As DateTime = CDate(dt.Split(",")(1)).ToString("hh:mm tt")
           Dim dateString As String = d
           Dim timeString As String = t
           Dim combinedString As String = $"{dateString} {timeString}"
           TextBox2.Text = ToTimeStamp(combinedString)
       ElseIf dt.Contains(",") AndAlso dt.Split(",")(0) = arr(2) Then
           Dim d As DateTime = Now.ToString("d")
           Dim t As DateTime = CDate(dt.Split(",")(1)).ToString("hh:mm tt")
           Dim dateString As String = d
           Dim timeString As String = t
           Dim combinedString As String = $"{dateString} {timeString}"
           TextBox2.Text = ToTimeStamp(combinedString)
       Else
           If IsDateTime(dt) Then
               TextBox2.Text = ToTimeStamp(dt)
           Else
               Dim f As String = InputBox("ادخل تنسيق التاريخ ثم حاول مجددا", "", "dd-MM-yy, hh:mm tt")
               Dim xd As String = Extract_date(dt, f)
               TextBox2.Text = ToTimeStamp(xd)
           End If
       End If
   End Sub
   Private Sub TextBox1_MouseClick(ByVal sender As Object, ByVal e As MouseEventArgs) Handles txturl.MouseClick
       If e.Button = MouseButtons.Left Then
           txturl.Clear()
           If Clipboard.GetText.Trim <> "" Then
               txturl.Paste()
           End If
       End If
   End Sub

   Private Sub TextBox2_MouseClick(ByVal sender As Object, ByVal e As MouseEventArgs) Handles TextBox2.MouseClick
       If e.Button = MouseButtons.Left Then
           TextBox2.Clear()
           If Clipboard.GetText.Trim <> "" Then
               TextBox2.Paste()
           End If
       End If
   End Sub

   Private Sub Button2_Click(ByVal sender As Object, ByVal e As EventArgs) Handles Button2.Click
       TextBox3.Text = ConvertUnixTimestampToDateTime(TextBox2.Text)
   End Sub
End Class
بارك الله فيك و جزاك الله كل خير
باذن الله ساجرب الفكرة او التعديل.