هذا مثال بعد البهدلة اللتي حصلت مع التاريخ فاستخدام اجراء 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
الكلاس كما المرفق يحتوى اكواد مهمة لاي مبتديء وقد تكون مهمة للمتوسط ايضا.
اسعد الله مساءكم بكل خير
و السلام عليكم ورحمة الله و بركاته
ارجوكم الدعاء لي بالتوفيق
اللهم إني أعوذ بك من غلبة الدين وغلبة العدو، اللهم إني أعوذ بك من جهد البلاء ومن درك الشقاء ومن سوء القضاء ومن شماتة الأعداء
اللهم اغفر لي خطيئتي وجهلي، وإسرافي في أمري وما أنت أعلم به مني، اللهم اغفر لي ما قدمت وما أخرت، وما أسررت وما أعلنت وما أنت أعلم به مني، أنت المقدم وأنت المؤخر وأنت على كل شيء قدير
10-11-25, 07:29 PM (آخر تعديل لهذه المشاركة : 12-11-25, 03:51 AM {2} بواسطة justforit.)
عدلت على الكلاس كالتالي لم ارفق المرفق او احدثه
كود :
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
تم تعديل الخطأ
اللهم إني أعوذ بك من غلبة الدين وغلبة العدو، اللهم إني أعوذ بك من جهد البلاء ومن درك الشقاء ومن سوء القضاء ومن شماتة الأعداء
اللهم اغفر لي خطيئتي وجهلي، وإسرافي في أمري وما أنت أعلم به مني، اللهم اغفر لي ما قدمت وما أخرت، وما أسررت وما أعلنت وما أنت أعلم به مني، أنت المقدم وأنت المؤخر وأنت على كل شيء قدير
اللهم إني أعوذ بك من غلبة الدين وغلبة العدو، اللهم إني أعوذ بك من جهد البلاء ومن درك الشقاء ومن سوء القضاء ومن شماتة الأعداء
اللهم اغفر لي خطيئتي وجهلي، وإسرافي في أمري وما أنت أعلم به مني، اللهم اغفر لي ما قدمت وما أخرت، وما أسررت وما أعلنت وما أنت أعلم به مني، أنت المقدم وأنت المؤخر وأنت على كل شيء قدير
12-11-25, 07:06 PM (آخر تعديل لهذه المشاركة : 12-11-25, 07:22 PM {2} بواسطة justforit.)
(12-11-25, 06:48 PM)مصمم هاوي كتب :
(12-11-25, 03:52 AM)justforit كتب :
تم تعديل الخطا في الكلاس
ٱمين
أكثر شئ يزعجني هو تنسيق التاريخ
حياك الله اخي الكريم
انا وكل النصوص حول التاريخ في تحدي.
اليوم قرات وقت مشاركتي البارح مكتوبة "اليوم, والوقت" كلمة اليوم لم اقراها قبل.
فاضفتها للمصفوفة بالكلاس لكني لم احدث المكتوب بالمشاركة لاني اظن انها واضحة.
اشكر زيارتك للموضوع.
اللهم إني أعوذ بك من غلبة الدين وغلبة العدو، اللهم إني أعوذ بك من جهد البلاء ومن درك الشقاء ومن سوء القضاء ومن شماتة الأعداء
اللهم اغفر لي خطيئتي وجهلي، وإسرافي في أمري وما أنت أعلم به مني، اللهم اغفر لي ما قدمت وما أخرت، وما أسررت وما أعلنت وما أنت أعلم به مني، أنت المقدم وأنت المؤخر وأنت على كل شيء قدير
(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
بارك الله فيك و جزاك الله كل خير
باذن الله ساجرب الفكرة او التعديل.
اللهم إني أعوذ بك من غلبة الدين وغلبة العدو، اللهم إني أعوذ بك من جهد البلاء ومن درك الشقاء ومن سوء القضاء ومن شماتة الأعداء
اللهم اغفر لي خطيئتي وجهلي، وإسرافي في أمري وما أنت أعلم به مني، اللهم اغفر لي ما قدمت وما أخرت، وما أسررت وما أعلنت وما أنت أعلم به مني، أنت المقدم وأنت المؤخر وأنت على كل شيء قدير
.
