تقييم الموضوع :
  • 0 أصوات - بمعدل 0
  • 1
  • 2
  • 3
  • 4
  • 5
فحص النص هل هو تاريخ حقيقي او غير معتمد بالجهاز
#2
عدلت على الكلاس كالتالي لم ارفق المرفق او احدثه
كود :
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 - 10-11-25, 07:29 PM

المواضيع المحتمل أن تكون متشابهة .
الموضوع : الكاتب الردود : المشاهدات : آخر رد
Photo [VB.NET] طريقة توسيط النص داخل أداة ListBox أبو خالد الشكري 1 776 26-08-25, 10:18 AM
آخر رد: Taha Okla
  التغيير الاوتوماتيكي لمحاذاة النص في حقول الداتاقريدفيو justforit 1 385 18-12-24, 04:55 AM
آخر رد: princelovelorn
  عمل ترخيص سنوي لبرنامج مع تجديده كل سنة بحيث لو تغير تاريخ الجهاز يبقى عداد الايام صح غزة العزة 3 815 27-05-24, 08:28 PM
آخر رد: atefkhalf2004
  الان نفذ العمليات والدوال في مربع النص وكأنك تكتب في خلية اكسل Taha Okla 2 1,280 03-03-23, 03:17 PM
آخر رد: mrfenix93
Wink [مشروع] مشروع تحويل النص الى صوت مسموع والتحكم برفع الصوت وتغيير سرعته مع السورس كود ahmadpal 8 5,392 04-08-22, 05:08 AM
آخر رد: abo ragab
  [مشروع] جلب سطر النص اللذي تم حفظه الى ملف نصي مرة اخرى الى الفورم سعود 1 1,511 26-07-22, 01:36 AM
آخر رد: سعود
Rainbow [كود] حساب التاريخ والوقت بالايام والساعات والثواني الى تاريخ محدد محمد مسافر 9 2,203 21-06-22, 03:03 PM
آخر رد: سعود
  [مشروع] استخلاص الحروف و الارقام والرموز من مربع النص او اي كونترول تضيفه سعود 0 1,672 15-01-22, 06:23 PM
آخر رد: سعود
  [مشروع] أداه TextBoxPlaceholder تسمح باظهار تلميح حول مربع النص عندما يكون فارغا Anas Mahmoud 0 2,170 01-12-20, 03:48 AM
آخر رد: Anas Mahmoud
Video [درس فيديو] طريقة طباعة النص من تكست بوكس او الصورة من بكتشر بوكس ahmadpal 3 3,164 06-09-20, 08:05 AM
آخر رد: Ali 2020

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


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