القيمة الإفتراضية لمربع نص = التوقيت العالمي (وقت الإنترنت)

[abo3aesha_2014]

هل من الممكن جعل القيمة الإفتراضية لمربع النص الوقت في نموذج الحضور = توقيت الإنترنت في مصر

بحيث إذا ما تم تغيير ساعة الويندوز لا يؤثر في قاعدة البيانات ؟

منع تغيير الوقت.rar

[ابوخليل]

وجدت لك مثالا في مكتبتي  يظهر تاريخ الانترنت في مصر  ( مكتبتي تشمل امثلة كثيرة معظمها ليست من عملي)

سوف تلاحظ بطء عند تشغيل النموذج وهذا بسبب جلب التاريخ من الموقع المخصص يحتاج لهذا الوقت حسب سرعة الانترنت

هذه هي الوحدة النمطية الاصلية .. فقط غيرت رابط الموقع فيها

Function InternetTime(Optional GMTDifference As Integer) As Date
    '-----------------------------------------------------------------------------------
    'This function returns the Greenwich Mean Time retrieved from an internet server.
    'You can use the optional argument GMTDifference in order to add (or subtract)
    'an hour from the GMT time. For Example if you call the function as:
    '=InternetTIme(2) it will return the (local) hour GMT + 2. Note that the
    'GMTDifference variable is an integer number.
   
    'Written by:    Christos Samaras
    'Date:          25/09/2013
    'Last Updated:  20/11/2013
    'e-mail:        xristos.samaras@gmail.com
    'site:          http://www.myengineeringworld.net

    'Declaring the necessary variables.
    Dim Request     As Object
    Dim ServerURL   As String
    Dim Results     As String
    Dim NetDate     As String
    Dim NetTime     As Date
    Dim LocalDate   As Date
    Dim LocalTime   As Date
   
    'Check if the time difference is within the accepted range.
    If GMTDifference < -12 Or GMTDifference > 14 Then
        Exit Function
    End If

    'The server address.
    ServerURL = "https://www.time.gov/"
    'ServerURL = "http://www.timeanddate.com/worldclock/fullscreen.html?n=2"
   
    'Build the XMLHTTP object and check if was created successfully.
    On Error Resume Next
    Set Request = CreateObject("Microsoft.XMLHTTP")
    If Err.Number <> 0 Then
        Exit Function
    End If
    On Error GoTo 0
   
    'Create the request.
    Request.Open "GET", ServerURL, False, "", ""
   
    'Send the request to the internet server.
    Request.Send
   
    'Based on the status node result, proceed accordingly.
    If Request.readyState = 4 Then
       
        'If the request succeed, the following line will return
        'something like this: Mon, 30 Sep 2013 18:33:23 GMT.
        Results = Request.getResponseHeader("date")
       
        'Use the Mid function to get something like: 30 Sep 2013 18:33:23.
        Results = Mid(Results, 6, Len(Results) - 9)
       
        'Use the Left and Right function to distinguish the date and time.
        NetDate = Left(Results, Len(Results) - 9) '30 Sep 2013
        NetTime = Right(Results, 8) '18:33:23
       
        'Convert the date into a valid Excel date 30 Sep 2013 -> 30/9/2013.
        'Required for countries that have some non-Latin characters at their alphabet (Greece, Russia, Serbia etc.).
        LocalDate = ConvertDate(NetDate)

        'Add the hour difference to the retrieved GMT time.
        LocalTime = NetTime + GMTDifference / 24

        'Return the local date and time.
        InternetTime = LocalDate + LocalTime
   
    End If
   
    'Release the XMLHTTP object.
    Set Request = Nothing

End Function

Function ConvertDate(strDate As String) As Date
   
    '-------------------------------------------------------------------------
    'This function converts the input date into a valid Excel date.
    'For example the 30 Sep 2013 becomes 30/9/2013.
    'Required for countries that have non-Latin characters at their alphabet.
   
    'Written by:    Christos Samaras
    'Date:          25/09/2013
    'e-mail:        xristos.samaras@gmail.com
    'site:          http://www.myengineeringworld.net
    '-------------------------------------------------------------------------
   
    'Declaring the necessary variables.
    Dim MyMonth As Integer
   
    'Check the month and convert it to number.
    Select Case UCase(Mid(strDate, 4, 3))
        Case "JAN": MyMonth = 1
        Case "FEB": MyMonth = 2
        Case "MAR": MyMonth = 3
        Case "APR": MyMonth = 4
        Case "MAY": MyMonth = 5
        Case "JUN": MyMonth = 6
        Case "JUL": MyMonth = 7
        Case "AUG": MyMonth = 8
        Case "SEP": MyMonth = 9
        Case "OCT": MyMonth = 10
        Case "NOV": MyMonth = 11
        Case "DEC": MyMonth = 12
    End Select
   
    'Rebuild the date.
    ConvertDate = DateValue(Right(strDate, 4) & "/" & MyMonth & "/" & Left(strDate, 2))

End Function

وهذا هي الاكواد الخاصة بمنادات الدالة في النموذج

Private Declare Function InternetGetConnectedState Lib _
    "wininet" (ByRef dwflags As Long, ByVal dwReserved As _
    Long) As Long

Private Sub Form_Load()
    If InternetGetConnectedState(0, 0) = 1 Then
        lblResult.Caption = "Connected"
    Else
        lblResult.Caption = "Not Connected"
    End If
End Sub

وهذا السطر يوضع في مصدر تحكم الحقل .. لاحظ الرقم يتغير حسب المنطقة فلو اردت تطبيق النموذج على السعودية فيجب تغيير الرقم 2 الى الرقم 3

=InternetTime(2)

وهذا تنسيق لاظهار الوقت فقط في مصدر تحكم الحقل

=Format(InternetTime(2);"hh:nn:ss AM/PM")

 

 

تاريخ ووقت الانترنت.rar