• Vui lòng đọc nội qui diễn đàn để tránh bị xóa bài viết
  • Tìm kiếm trước khi đặt câu hỏi

Hỏi? Lỗi khi lấy ngày giờ trên Internet

Góc trao đổi, hỏi đáp của ngôn ngữ Visual Basic 6 và Visual Basic Script

Điều hành viên: tungblt

garupro174
Thành viên chính thức
Thành viên chính thức
Bài viết: 18
Ngày tham gia: T.Năm 06/01/2011 9:06 pm
Has thanked: 5 time

Hỏi? Lỗi khi lấy ngày giờ trên Internet

Gửi bàigửi bởi garupro174 » T.Năm 16/02/2017 3:26 pm

Em chào các anh chị, em có một Mudules lấy ngày giờ trên Internet, trước vẫn chạy bình thường, bây giờ chạy lại kết quả luôn trả về rỗng ạ, nó báo lỗi ở dòng Request.Send mà em không biết xử lý thế nào, nhờ mọi người giúp em với ạ. Em cảm ơn rất nhiều

Mã: Chọn hết

Option Explicit


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.
    'On Error Resume Next
    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
    InternetTime = DateValue("1/1/1990")
    'The server address.
    ServerURL = "http://www.timeanddate.com/worldclock/fullscreen.html?n=2"
   
    'Build the XMLHTTP object and check if was created successfully.

    Set Request = CreateObject("Microsoft.XMLHTTP")

    '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")
        MsgBox Results
        '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.).
       
        If NetDate = "" Then
        LocalDate = ""
        Else
        LocalDate = ConvertDate(NetDate)
        End If
        'Add the hour difference to the retrieved GMT time.
        'LocalTime = NetTime + GMTDifference / 24

        'Return the local date and time.
        InternetTime = LocalDate ' + LocalTime
   
    End If
0:
    'Release the XMLHTTP object.
    Set Request = Nothing
    If Err.Number <> 0 Then
        Exit Function
    End If
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



Hình đại diện của người dùng
Dark.Cosmos
Thành viên năng nổ
Thành viên năng nổ
Bài viết: 72
Ngày tham gia: T.Sáu 21/11/2014 3:58 am
Has thanked: 25 time
Been thanked: 14 time
Liên hệ:

Re: Hỏi? Lỗi khi lấy ngày giờ trên Internet

Gửi bàigửi bởi Dark.Cosmos » T.Năm 13/07/2017 9:25 am

Mã: Chọn hết

Option Explicit


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.
    'On Error Resume Next
    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
    InternetTime = DateValue("1/1/1990")
    'The server address.
    ServerURL = "http://www.timeanddate.com/worldclock/fullscreen.html?n=2"
   
    'Build the XMLHTTP object and check if was created successfully.

    Set Request = CreateObject("WinHttp.WinHttpRequest.5.1")
   
    '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.Status = 200 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")
        MsgBox Results
        '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.).
       
        If NetDate = "" Then
        LocalDate = ""
        Else
        LocalDate = ConvertDate(NetDate)
        End If
        'Add the hour difference to the retrieved GMT time.
        'LocalTime = NetTime + GMTDifference / 24

        'Return the local date and time.
        InternetTime = LocalDate ' + LocalTime
   
    End If
0:
    'Release the XMLHTTP object.
    Set Request = Nothing
    If Err.Number <> 0 Then
        Exit Function
    End If
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
Triệu người quen có mấy người thân, khi lìa trần có mấy người đưa?
DK Cosmos


Quay về “Visual Basic 6 và Visual Basic Script (VB & VBS)”

Đang trực tuyến

Đang xem chuyên mục này: Không có thành viên nào trực tuyến.6 khách