[Chia sẻ] Hàm lấy thời gian từ Internet. (1 người xem)

Hoàng Trọng Nghĩa · 22/8/21

Cái hàm này tôi cũng sưu tầm trên Internet cũng lâu lắm rồi, giờ rảnh rổi lục các file cũ và thấy nó hay hay nên chia sẻ lên đây, ai dùng được thì dùng.
Tôi có chỉnh sửa bẩy lỗi một chút và cộng thêm 7 tiếng so với giờ GMT cho phù hợp với giờ Việt Nam. Nếu ai có hàm nào tốt hơn, nhanh hơn thì chia sẻ cho mọi người nhé.

PHP:

Function GetGMTNetTime() As Date
    Const sURL As String = "https://www.timeanddate.com"
    Dim oHTTP As Object
    Dim sResp As String
    Set oHTTP = CreateObject("Microsoft.XMLHTTP")
    On Error GoTo ErrorHandler
    oHTTP.Open "GET", sURL, False, "", ""
    oHTTP.Send
    sResp = oHTTP.getResponseHeader("Date")
    GetGMTNetTime = CDate(Mid$(sResp, 6, 20)) + TimeSerial(7, 0, 0)
    Set oHTTP = Nothing
    Exit Function
ErrorHandler:
    Set oHTTP = Nothing
    MsgBox "Internet disconnected!"
End Function

ongke0711 · 22/8/21

Hoàng Trọng Nghĩa đã viết:
Cái hàm này tôi cũng sưu tầm trên Internet cũng lâu lắm rồi, giờ rảnh rổi lục các file cũ và thấy nó hay hay nên chia sẻ lên đây, ai dùng được thì dùng.

Tôi cũng có dùng hàm lấy giờ trên Internet và chia sẻ với các bạn cách mà tôi ứng dụng nó là:
- Kiểm tra thời gian hết hạn của chương trình. Môt số ứng dụng có thời gian dùng thử thì dùng phải lấy giờ chuẩn trên internet để đối chiếu với giờ hệ thống của máy tính, nếu thấy sai là phải đồng bộ lại ngay. Có nhiều người muốn kéo dài thời gian sử dụng nên chỉnh ngày giờ máy tính, nhưng một khi máy tính họ có kết nối internet thì ứng dụng sẽ chạy kiểm tra ngay.
- Góp phần ngăn ngừa việc chỉnh ngày hệ thống để nhập dữ liệu không đúng thời gian thực.
Có một cách khác để đồng bộ giờ hệ thống ngoài việc lấy giờ trên internet là lấy giờ từ máy chủ trong hệ thống. Khi ứng dụng có lưu CSDL lên máy chủ thì có thể dùng nó để kiểm tra giờ hệ thống của các máy con. Code lấy thời gian trên máy chủ cũng có nhiều trên mạng nhé.

Hoàng Trọng Nghĩa · 22/8/21

Đúng rồi, tôi cũng đang viết chương trình và ràng buộc nhân viên nhập liệu phải nhập cho đúng số liệu, nếu như sai sót chỉ chỉnh sửa hoặc xóa trong vòng 24h, quá 24h không cho chỉnh sửa, nếu muốn được chỉnh sửa phải làm báo cáo lên, sếp duyệt mới được chỉnh sửa.

batman1 · 22/8/21

Hoàng Trọng Nghĩa đã viết:
Cái hàm này tôi cũng sưu tầm trên Internet cũng lâu lắm rồi, giờ rảnh rổi lục các file cũ và thấy nó hay hay nên chia sẻ lên đây, ai dùng được thì dùng.
Tôi có chỉnh sửa bẩy lỗi một chút và cộng thêm 7 tiếng so với giờ GMT cho phù hợp với giờ Việt Nam. Nếu ai có hàm nào tốt hơn, nhanh hơn thì chia sẻ cho mọi người nhé.

Tôi chạy code có lỗi ở dòng

Mã:

GetGMTNetTime = CDate(Mid$(sResp, 6, 20)) + TimeSerial(7, 0, 0)

với sResp = "Sun, 22 Aug 2021 14:56:04 GMT"

Chạy code sau cũng sẽ có lỗi ngay

Mã:

Sub test()
Dim sResp As String, a As Date
    sResp = "Sun, 22 Aug 2021 14:56:04 GMT"
    a = CDate(Mid$(sResp, 6, 20))
    Debug.Print a
End Sub

-------------
Code tương tự nhưng lấy ngày tháng thời gian từ server http://time.windows.com

Mã:

Function GetDateTime(DateTime As Byte, TimeZone As Integer) As Date
'    DateTime:
'    1 - gio
'    2 - ngay thang
'    3 - ngay thang va gio
'    TimeZone - so nguyen (chenh lech voi gio Greenwich Mean Time)
'    TimeZone map - https://www.timeanddate.com/time/map/
'*******************************************************************
Dim Arr, XHTTP As Object
    On Error GoTo err

    Set XHTTP = CreateObject("MSXML2.XMLHTTP")
    With XHTTP
        .Open "Head", "http://time.windows.com/", False
        .Send
        Arr = Split(.getResponseHeader("Date"), " ")
    End With

    Select Case Arr(2)
        Case "Jan": Arr(2) = 1
        Case "Feb": Arr(2) = 2
        Case "Mar": Arr(2) = 3
        Case "Apr": Arr(2) = 4
        Case "May": Arr(2) = 5
        Case "Jun": Arr(2) = 6
        Case "Jul": Arr(2) = 7
        Case "Aug": Arr(2) = 8
        Case "Sep": Arr(2) = 9
        Case "Oct": Arr(2) = 10
        Case "Nov": Arr(2) = 11
        Case "Dec": Arr(2) = 12
    End Select

    Select Case DateTime
        Case 1: GetDateTime = TimeValue(Arr(4)) + 1 / 24 * TimeZone
        Case 2: GetDateTime = Format(DateSerial(Arr(3), Arr(2), Arr(1)) + TimeValue(Arr(4)) + 1 / 24 * TimeZone, "yyyy-mm-dd")
        Case 3: GetDateTime = DateSerial(Arr(3), Arr(2), Arr(1)) + TimeValue(Arr(4)) + 1 / 24 * TimeZone
    End Select

    Set XHTTP = Nothing

    On Error GoTo 0
    Exit Function
err:
    MsgBox "Loi " & err.Number & " (" & err.Description & ") trong ham GetDateTime "
End Function

Sub test()
'    TimeZona = 7 cho Viet Nam
    MsgBox GetDateTime(1, 7)
    MsgBox GetDateTime(2, 7)
    MsgBox GetDateTime(3, 7)
End Sub

Code dùng http://time.windows.com vì bản thân Windows cũng dùng

Hoàng Trọng Nghĩa · 22/8/21

batman1 đã viết:

Tôi chạy code có lỗi ở dòng

Mã:

GetGMTNetTime = CDate(Mid$(sResp, 6, 20)) + TimeSerial(7, 0, 0)

với sResp = "Sun, 22 Aug 2021 14:56:04 GMT"

Chạy code sau cũng sẽ có lỗi ngay

Mã:

Sub test()
Dim sResp As String, a As Date
    sResp = "Sun, 22 Aug 2021 14:56:04 GMT"
    a = CDate(Mid$(sResp, 6, 20))
    Debug.Print a
End Sub

-------------
Code tương tự nhưng lấy ngày tháng thời gian từ server http://time.windows.com

Mã:

Function GetDateTime(DateTime As Byte, TimeZone As Integer) As Date
'    DateTime:
'    1 - gio
'    2 - ngay thang
'    3 - ngay thang va gio
'    TimeZone - so nguyen (chenh lech voi gio Greenwich Mean Time)
'    TimeZone map - https://www.timeanddate.com/time/map/
'*******************************************************************
Dim Arr, XHTTP As Object
    On Error GoTo err

    Set XHTTP = CreateObject("MSXML2.XMLHTTP")
    With XHTTP
        .Open "Head", "http://time.windows.com/", False
        .Send
        Arr = Split(.getResponseHeader("Date"), " ")
    End With

    Select Case Arr(2)
        Case "Jan": Arr(2) = 1
        Case "Feb": Arr(2) = 2
        Case "Mar": Arr(2) = 3
        Case "Apr": Arr(2) = 4
        Case "May": Arr(2) = 5
        Case "Jun": Arr(2) = 6
        Case "Jul": Arr(2) = 7
        Case "Aug": Arr(2) = 8
        Case "Sep": Arr(2) = 9
        Case "Oct": Arr(2) = 10
        Case "Nov": Arr(2) = 11
        Case "Dec": Arr(2) = 12
    End Select

    Select Case DateTime
        Case 1: GetDateTime = TimeValue(Arr(4)) + 1 / 24 * TimeZone
        Case 2: GetDateTime = Format(DateSerial(Arr(3), Arr(2), Arr(1)) + TimeValue(Arr(4)) + 1 / 24 * TimeZone, "yyyy-mm-dd")
        Case 3: GetDateTime = DateSerial(Arr(3), Arr(2), Arr(1)) + TimeValue(Arr(4)) + 1 / 24 * TimeZone
    End Select

    Set XHTTP = Nothing

    On Error GoTo 0
    Exit Function
err:
    MsgBox "Loi " & err.Number & " (" & err.Description & ") trong ham GetDateTime "
End Function

Sub test()
'    TimeZona = 7 cho Viet Nam
    MsgBox GetDateTime(1, 7)
    MsgBox GetDateTime(2, 7)
    MsgBox GetDateTime(3, 7)
End Sub

Code dùng http://time.windows.com vì bản thân Windows cũng dùng

View attachment 264554

Dạ có thể mỗi máy mỗi khác, nhưng chạy trên máy của em nó chẳng lỗi gì cả. Chỉ có một điều thắc mắc là mình cho nó chạy trên trang nào nó cũng ra giờ.

Const sURL As String = "https://www.timeanddate.com"

Có đổi thành:

Const sURL As String = "https://www.giaiphapexcel.com"

Nó cũng chạy ra đúng giờ. Chưa hiểu tại sao.

batman1 · 22/8/21

Hoàng Trọng Nghĩa đã viết:
Dạ có thể mỗi máy mỗi khác, nhưng chạy trên máy của em nó chẳng lỗi gì cả.

Bạn chạy từng bước xem dạng của sReps là thế nào. Trên máy tôi thì dạng như trong bài #4.

Bạn chạy code test trong bài #4 có thấy lỗi không?

À mà tôi đoán ra rồi. Bạn có dạng trong CP y như dạng của sReps. Máy tôi trong CP có dạng hoàn toàn khác. Windows phiên bản Ba Lan, thiết lập là Ba Lan mà. Không có chuyện chuỗi có chứa Aug mà CDate lại chấp nhận. Nhưng code của tôi thì ai chạy cũng không bị lỗi.

Hoàng Trọng Nghĩa · 22/8/21

batman1 đã viết:
Bạn chạy từng bước xem dạng của sReps là thế nào. Trên máy tôi thì dạng như trong bài #4.

View attachment 264556

Bạn chạy code test trong bài #4 có thấy lỗi không?

À mà tôi đoán ra rồi. Bạn có dạng trong CP y như dạng của sReps. Máy tôi trong CP có dạng hoàn toàn khác. Windows phiên bản Ba Lan, thiết lập là Ba Lan mà. Không có chuyện chuỗi có chứa Aug mà CDate lại chấp nhận. Nhưng code của tôi thì ai chạy cũng không bị lỗi.

Máy em test không bị gì nhé thầy. Nhưng test thì thấy hàm của thầy có tốc độ nhanh hơn.

Ngày mai trời lại sáng · 22/8/21

batman1 đã viết:

Tôi chạy code có lỗi ở dòng

Mã:

GetGMTNetTime = CDate(Mid$(sResp, 6, 20)) + TimeSerial(7, 0, 0)

với sResp = "Sun, 22 Aug 2021 14:56:04 GMT"

Chạy code sau cũng sẽ có lỗi ngay

Mã:

Sub test()
Dim sResp As String, a As Date
    sResp = "Sun, 22 Aug 2021 14:56:04 GMT"
    a = CDate(Mid$(sResp, 6, 20))
    Debug.Print a
End Sub

-------------
Code tương tự nhưng lấy ngày tháng thời gian từ server http://time.windows.com

Mã:

Function GetDateTime(DateTime As Byte, TimeZone As Integer) As Date
'    DateTime:
'    1 - gio
'    2 - ngay thang
'    3 - ngay thang va gio
'    TimeZone - so nguyen (chenh lech voi gio Greenwich Mean Time)
'    TimeZone map - https://www.timeanddate.com/time/map/
'*******************************************************************
Dim Arr, XHTTP As Object
    On Error GoTo err

    Set XHTTP = CreateObject("MSXML2.XMLHTTP")
    With XHTTP
        .Open "Head", "http://time.windows.com/", False
        .Send
        Arr = Split(.getResponseHeader("Date"), " ")
    End With

    Select Case Arr(2)
        Case "Jan": Arr(2) = 1
        Case "Feb": Arr(2) = 2
        Case "Mar": Arr(2) = 3
        Case "Apr": Arr(2) = 4
        Case "May": Arr(2) = 5
        Case "Jun": Arr(2) = 6
        Case "Jul": Arr(2) = 7
        Case "Aug": Arr(2) = 8
        Case "Sep": Arr(2) = 9
        Case "Oct": Arr(2) = 10
        Case "Nov": Arr(2) = 11
        Case "Dec": Arr(2) = 12
    End Select

    Select Case DateTime
        Case 1: GetDateTime = TimeValue(Arr(4)) + 1 / 24 * TimeZone
        Case 2: GetDateTime = Format(DateSerial(Arr(3), Arr(2), Arr(1)) + TimeValue(Arr(4)) + 1 / 24 * TimeZone, "yyyy-mm-dd")
        Case 3: GetDateTime = DateSerial(Arr(3), Arr(2), Arr(1)) + TimeValue(Arr(4)) + 1 / 24 * TimeZone
    End Select

    Set XHTTP = Nothing

    On Error GoTo 0
    Exit Function
err:
    MsgBox "Loi " & err.Number & " (" & err.Description & ") trong ham GetDateTime "
End Function

Sub test()
'    TimeZona = 7 cho Viet Nam
    MsgBox GetDateTime(1, 7)
    MsgBox GetDateTime(2, 7)
    MsgBox GetDateTime(3, 7)
End Sub

Code dùng http://time.windows.com vì bản thân Windows cũng dùng

View attachment 264554

Chuẩn không cần chỉnh chú ạ, sau khi lấy được thời gian từ inter về có thể chỉnh luôn cái đồng hồ theo giờ và định dạng ngày giờ đã lấy về được không chú? chú viết cho cháu thêm một cái hàm để kiểm tra xem máy tính có kết nối với internet hay không với.

batman1 · 22/8/21

Hoàng Trọng Nghĩa đã viết:
Máy em test không bị gì nhé thầy. Nhưng test thì thấy hàm của thầy có tốc độ nhanh hơn.

Thì tôi viết rồi mà. Thiết lập trong CP của bạn y như dạng trong sReps. Còn trên máy tôi sReps vẫn là dạng Sun, 22 Aug 2021 18:14:05 GMT nhưng trong CP tôi có niedziela, 22 sierpnia 2021 (niedziela = Sun, sierpnia = Aug). Có lẽ vì thế mà CDate trả về lỗi.

Bài đã được tự động gộp: 22/8/21

Hoàng Trọng Nghĩa đã viết:
Có đổi thành:
Const sURL As String = "https://www.giaiphapexcel.com"
Nó cũng chạy ra đúng giờ. Chưa hiểu tại sao.

Đoán ra rồi. Với những server khác nhau thì toàn bộ Header trả về là khác nhau (xem phần ở dưới), nhưng cấu trúc của phần Date luôn là như nhau, dường như có dạng chuẩn được qui định theo mẫu:

Date: <thứ bằng tiếng Anh>, <ngày> <tên tháng tiếng Anh> <năm> hh:mm:ss GMT

Header:

1. https://www.timeanddate.com

Connection: keep-alive
X-Frame-Options: SAMEORIGIN
Pragma: no-cache
Cache-Control: max-age=0, no-cache, no-store
Content-Type: text/html; charset=UTF-8
Accept-Ranges: bytes
Date: Sun, 22 Aug 2021 16:03:16 GMT
Via: 1.1 varnish
X-Served-By: cache-hhn4047-HHN
X-Cache: MISS
X-Cache-Hits: 0
X-Timer: S1629648197.501072,VS0,VE17
transfer-encoding: chunked

2. http://time.windows.com

Content-Type: text/html; charset=us-ascii
Date: Sun, 22 Aug 2021 16:01:41 GMT
Connection: close
Content-Length: 315

3. https://www.giaiphapexcel.com"

Server: nginx
Date: Sun, 22 Aug 2021 16:00:05 GMT
Content-Type: text/html; charset=utf-8
Connection: keep-alive
X-Frame-Options: SAMEORIGIN
X-Content-Type-Options: nosniff
Last-Modified: Sun, 22 Aug 2021 16:00:05 GMT
Expires: Thu, 19 Nov 1981 08:52:00 GMT
Cache-Control: private, no-cache, max-age=0
Vary: User-Agent
Set-Cookie: xf_csrf=DvxhevkU21B0jkI-; path=/; secure

truongvu317 · 22/8/21

batman1 đã viết:
lấy ngày tháng thời gian từ server

KHi chạy thì ra như này là bị như nào vậy bác.

batman1 · 22/8/21

3ii đã viết:
chú viết cho cháu thêm một cái hàm để kiểm tra xem máy tính có kết nối với internet hay không với.

Cái này bạn tìm dễ mà. Tìm bằng google hoặc dùng "Tìm kiếm" của GPE. Từ khóa có thể là InternetGetConnectedState

Bài đã được tự động gộp: 22/8/21

truongvu317 đã viết:
KHi chạy thì ra như này là bị như nào vậy bác.

Là khi code chạy bị lỗi. Dòng cuối cùng trong hàm GetDateTime là thế này (MsgBox)

Mã:

On Error GoTo err
...
err:
MsgBox "Loi " & err.Number & " (" & err.Description & ") trong ham GetDateTime "

batman1 · 22/8/21

3ii đã viết:
sau khi lấy được thời gian từ inter về có thể chỉnh luôn cái đồng hồ theo giờ và định dạng ngày giờ đã lấy về được không chú?

Bạn đọc bài sau, và các bài khác trong chủ đề.

Để đọc ra thiết lập thì dùng hàm GetLocaleInfo. Để thiết lập thì dùng SetLocaleInfo

Hỏi cách điều khiển control panel từ VBE

Trong control panel - region and language, có cho phép - chỉnh DECIMAL SYMBOL là dấu chấm (.) hay phẩy (,) va ... - chỉnh DIGIT GROUPING SYMBOL .. tui muốn điều khiển các giá trị này từ trong VBE CÁC BÁC CHỈ GIÚP VỚI AH!

www.giaiphapexcel.com

HeSanbi · 23/8/21

Không biết tại sao lại cần hàm này, dùng cmd refresh lại là thời gian tự động cập nhật cho window, rồi ta dùng Vba.Now thôi

Hoàng Trọng Nghĩa · 23/8/21

HeSanbi đã viết:
Không biết tại sao lại cần hàm này, dùng cmd refresh lại là thời gian tự động cập nhật cho window, rồi ta dùng Vba.Now thôi

Ý bạn nói là hàm gì? Còn tôi dùng hàm GetGMTNetTime này để cài vào chương trình của tôi nhằm mục đích ngăn không cho nhân viên sửa chữa sau khi nhập liệu 24h. Một số nhân viên chơi "tiểu xảo" chỉnh lại thời gian hệ thống để chỉnh sửa lại khi nhập liệu cẩu thả, sau khi chỉnh sửa xong họ tự chỉnh lại ngày giờ. Cho nên hàm này sẽ như là cột mốc thời gian ngăn lại việc họ có thay đổi giờ hệ thống hay không.

HeSanbi · 23/8/21

Nhân viên chỉnh bằng tay, mình chỉnh bằng code cmd, ai chắc hơn.
2 nữa, thời gian request được thì dùng javascript để convert thời gian, ai lại đi dùng hàm VBA.
Lỡ may nhân viên "tiểu xảo" ngắt internet, hàm trả giá trị 0. Bước tiếp theo mình phải xử lý ra sao

ongke0711 · 23/8/21

HeSanbi đã viết:
Nhân viên chỉnh bằng tay, mình chỉnh bằng code cmd, ai chắc hơn.
2 nữa, thời gian request được thì dùng javascript để convert thời gian, ai lại đi dùng hàm VBA.
Lỡ may nhân viên "tiểu xảo" ngắt internet, hàm trả giá trị 0. Bước tiếp theo mình phải xử lý ra sao

Cái vụ đồng bộ giờ để kiểm tra cũng còn nhiều bất cập nên nếu có các bước xử lý nào hay để hạn chế, ngăn ngừa được thì chia sẽ nhé HeSanbi.
- Nếu ứng dụng có dùng máy chủ để lưu CSDL backend thì tôi dùng lênh DOS để lấy giờ của máy chủ trong mạng LAN. Nếu nhân viên tắt mạng LAN luôn thì lấy gì nhập liệu.
- Còn nếu đồng bộ giờ từ internet thì bạn có cách gì xử lý khi nhân viên tắt net?
- Còn nếu là một file nhập liệu độc lập thì tắt net thì cách nào xử lý hiệu quả hơn?

Hoàng Trọng Nghĩa · 23/8/21

HeSanbi đã viết:
Nhân viên chỉnh bằng tay, mình chỉnh bằng code cmd, ai chắc hơn.
2 nữa, thời gian request được thì dùng javascript để convert thời gian, ai lại đi dùng hàm VBA.
Lỡ may nhân viên "tiểu xảo" ngắt internet, hàm trả giá trị 0. Bước tiếp theo mình phải xử lý ra sao

Trong thời gian ngắt internet thì mình ngăn không cho chỉnh sửa trong thời gian này. Mà làm sao biết lúc này NV chỉnh sửa mà dùng CMD chứ!

HeSanbi · 23/8/21

Kiểm tra thời gian hệ thống có bị chỉnh sửa không dùng winapi wm timechanged

Hoàng Trọng Nghĩa · 23/8/21

HeSanbi đã viết:
Kiểm tra thời gian hệ thống có bị chỉnh sửa không dùng winapi wm timechanged

Cái này tôi không biết, bạn có thể hướng dẫn cho tôi được không?

Còn tôi đang làm như vầy:

Mã:

Function GetGMTNetTime(Optional ByRef blnInternetDisconnected As Boolean) As Date
    Const sURL As String = "https://www.timeanddate.com"
    Dim oHTTP As Object
    Dim sResp As String
    Set oHTTP = CreateObject("Microsoft.XMLHTTP")
    On Error GoTo ErrorHandler
    oHTTP.Open "GET", sURL, False, "", ""
    oHTTP.Send
    sResp = oHTTP.getResponseHeader("Date")
    GetGMTNetTime = CDate(Mid(sResp, 6, 20)) + TimeSerial(7, 0, 0)
    Set oHTTP = Nothing
    Exit Function
ErrorHandler:
    Set oHTTP = Nothing
    blnInternetDisconnected = True
    'MsgBox "Internet disconnected!"
End Function

Sau đó là kiểm tra kết nối Internet, thế là xong.

Mã:

Sub test()
    Dim blnCheck As Boolean
    Dim dteDateTime As Date
    dteDateTime = GetGMTNetTime(blnCheck)
    If blnCheck Then
        MsgBox "Trong thoi gian mat ket noi Internet, ban khong duoc chinh sua"
        Exit Sub
    End If
    ''...
End Sub

ongke0711 · 23/8/21

Hoàng Trọng Nghĩa đã viết:
Trong thời gian ngắt internet thì mình ngăn không cho chỉnh sửa trong thời gian này.

Cái vụ này khó à. Nếu cty rớt mạng toàn hệ thống thì công việc nhập liệu, xử lý dữ liệu hàng ngày cũng ngưng luôn sao được bạn.

Bài đã được tự động gộp: 23/8/21

HeSanbi đã viết:
Kiểm tra thời gian hệ thống có bị chỉnh sửa không dùng winapi wm timechanged

Vậy có một giải pháp khác là ngăn không cho người dùng thay đổi giờ hệ thống.

Hoàng Trọng Nghĩa · 23/8/21

ongke0711 đã viết:
Cái vụ này khó à. Nếu cty rớt mạng toàn hệ thống thì công việc nhập liệu, xử lý dữ liệu hàng ngày cũng ngưng luôn sao được bạn.

Bài đã được tự động gộp: 23/8/21

Tôi ngăn không cho chỉnh sửa chứ tôi đâu có ngăn không cho nhập dữ liệu! Nếu chỉnh sửa vào thời điểm rớt mạng thì làm bản báo cáo xác nhận của phòng IT thì sẽ được phép chỉnh sửa, còn không thì ăn Warning. Có như vậy họ mới tập trung làm việc cẩn thận tránh để sửa chữa.

Maika8008 · 23/8/21

Hoàng Trọng Nghĩa đã viết:
Cái hàm này tôi cũng sưu tầm trên Internet cũng lâu lắm rồi, giờ rảnh rổi lục các file cũ và thấy nó hay hay nên chia sẻ lên đây, ai dùng được thì dùng.
Tôi có chỉnh sửa bẩy lỗi một chút và cộng thêm 7 tiếng so với giờ GMT cho phù hợp với giờ Việt Nam. Nếu ai có hàm nào tốt hơn, nhanh hơn thì chia sẻ cho mọi người nhé.

PHP:

Function GetGMTNetTime() As Date Const sURL As String = "https://www.timeanddate.com" Dim oHTTP As Object Dim sResp As String Set oHTTP = CreateObject("Microsoft.XMLHTTP") On Error GoTo ErrorHandler oHTTP.Open "GET", sURL, False, "", "" oHTTP.Send sResp = oHTTP.getResponseHeader("Date") GetGMTNetTime = CDate(Mid$(sResp, 6, 20)) + TimeSerial(7, 0, 0) Set oHTTP = Nothing Exit Function ErrorHandler: Set oHTTP = Nothing MsgBox "Internet disconnected!" End Function

Code chạy ổn trên máy tôi nhưng quả thực là dùng URL nào cũng được, miễn sao URL đó có thật.

Hoàng Trọng Nghĩa · 23/8/21

Maika8008 đã viết:
Code chạy ổn trên máy tôi nhưng quả thực là dùng URL nào cũng được, miễn sao URL đó có thật.

Cái này bác Batman1 đã giải thích rồi, nó chỉ lấy thông tin trên cái Header có chứa Date. Bạn nên chọn trang web nào chạy nhanh nhất điền vào thì code sẽ chạy rất nhanh.

ongke0711 · 23/8/21

Hoàng Trọng Nghĩa đã viết:
Tôi ngăn không cho chỉnh sửa chứ tôi đâu có ngăn không cho nhập dữ liệu! Nếu chỉnh sửa vào thời điểm rớt mạng thì làm bản báo cáo xác nhận của phòng IT thì sẽ được phép chỉnh sửa, còn không thì ăn Warning. Có như vậy họ mới tập trung làm việc cẩn thận tránh để sửa chữa.

Vậy thì quá cứng nhắc thành ra phát sinh thêm thủ tục hành chính. Nhân viên đang nhập liệu đơn hàng, bấm lưu xong, rồi phát hiện sai chính tả, ghi chú gì đó phải sửa --> phải đi xin xác nhận. Con người là phải có phát sinh sai sót, vô tình ứng dụng kiểu này gây phiền phức cho người dùng. Thông thường ứng dụng chỉ lưu thông tin ngày giờ sửa xoá, người sửa, nếu các ứng dụng kế toán thì có thời gian khoá sổ v.v..
Quan điểm thiết kế của tôi là vậy thôi.

Hoàng Trọng Nghĩa · 23/8/21

ongke0711 đã viết:
Vậy thì quá cứng nhắc thành ra phát sinh thêm thủ tục hành chính. Nhân viên đang nhập liệu đơn hàng, bấm lưu xong, rồi phát hiện sai chính tả, ghi chú gì đó phải sửa --> phải đi xin xác nhận. Con người là phải có phát sinh sai sót, vô tình ứng dụng kiểu này gây phiền phức cho người dùng. Thông thường ứng dụng chỉ lưu thông tin ngày giờ sửa xoá, người sửa, nếu các ứng dụng kế toán thì có thời gian khoá sổ v.v..
Quan điểm thiết kế của tôi là vậy thôi.

Ở bài #3 tôi đã nói rất rõ rồi mà, cho phép chỉnh sửa trong vòng 24h, nếu sau đó mà chỉnh sửa thì không cho phép, vì thế để ngăn chặn việc chỉnh ngược thời gian nên tôi mới lấy thời gian của Internet làm chuẩn. Ai nhập liệu sai mà không biết kiểm tra lại trong ngày thì gánh chịu hậu quả là ăn biên bản thôi, vậy mới tính được KPI chứ!

Ngày mai trời lại sáng · 23/8/21

batman1 đã viết:
Bạn đọc bài sau, và các bài khác trong chủ đề.

Để đọc ra thiết lập thì dùng hàm GetLocaleInfo. Để thiết lập thì dùng SetLocaleInfo

Hỏi cách điều khiển control panel từ VBE

Trong control panel - region and language, có cho phép - chỉnh DECIMAL SYMBOL là dấu chấm (.) hay phẩy (,) va ... - chỉnh DIGIT GROUPING SYMBOL .. tui muốn điều khiển các giá trị này từ trong VBE CÁC BÁC CHỈ GIÚP VỚI AH!

www.giaiphapexcel.com

Cháu đã đọc nhưng chưa biết vận dụng (@$%@

batman1 · 23/8/21

3ii đã viết:
Cháu đã đọc nhưng chưa biết vận dụng

À nhầm. SetLocaleInfo dùng để vd. thiết lập dạng ngày tháng, vd. "yyyy-mm-dd"

Có thể dùng vd. dòng lệnh CMD.

Mã:

Sub SetDateTime(ByVal currDate As Date, ByVal currTime As Date)
Dim shell As Object
    Set shell = CreateObject("Shell.Application")
    shell.ShellExecute "cmd.exe", "/c time " & currTime, 0, "Runas", True
    shell.ShellExecute "cmd.exe", "/c date " & currDate, 0, "Runas", True
   
    Set shell = Nothing
End Sub

Sub vidu()
Dim currDate As Date, currTime As Date
    currDate = "25.08.2021"
    currTime = "15:15:47"
    SetDateTime currDate, currTime
End Sub

Kiều Mạnh · 23/8/21

batman1 đã viết:
À nhầm. SetLocaleInfo dùng để vd. thiết lập dạng ngày tháng, vd. "yyyy-mm-dd"

Có thể dùng vd. dòng lệnh CMD.

Mã:

Sub SetDateTime(ByVal currDate As Date, ByVal currTime As Date) Dim shell As Object Set shell = CreateObject("Shell.Application") shell.ShellExecute "cmd.exe", "/c time " & currTime, 0, "Runas", True shell.ShellExecute "cmd.exe", "/c date " & currDate, 0, "Runas", True Set shell = Nothing End Sub Sub vidu() Dim currDate As Date, currTime As Date currDate = "25.08.2021" currTime = "15:15:47" SetDateTime currDate, currTime End Sub

Máy phải có quyền Run As mới sử dụng code này được đó Anh

batman1 · 23/8/21

Kiều Mạnh đã viết:
Máy phải có quyền Run As mới sử dụng code này được đó Anh

Tôi không hiểu ý "Máy phải có quyền Run As". Thế nào là "Máy phải có quyền Run As" và thế nào là máy KHÔNG phải là "Máy phải có quyền Run As"? Nếu là trường hợp 2 thì khi chạy code của tôi sẽ nhận được gì?

Tôi biết Run As là gì nhưng tôi không hiểu "Máy phải có quyền Run As" là máy thế nào. Và bạn đã chạy code của tôi với máy KHÔNG CÓ cái gọi là "Máy phải có quyền Run As" hay chưa. Nếu chưa kiểm nghiệm thì hãy kiểm nghiệm rồi hãy khẳng định.

Kiều Mạnh · 23/8/21

batman1 đã viết:
Tôi không hiểu ý "Máy phải có quyền Run As". Thế nào là "Máy phải có quyền Run As" và thế nào là máy KHÔNG phải là "Máy phải có quyền Run As"? Nếu là trường hợp 2 thì khi chạy code của tôi sẽ nhận được gì?

Tôi biết Run As là gì nhưng tôi không hiểu "Máy phải có quyền Run As" là máy thế nào. Và bạn đã chạy code của tôi với máy KHÔNG CÓ cái gọi là "Máy phải có quyền Run As" hay chưa. Nếu chưa kiểm nghiệm thì hãy kiểm nghiệm rồi hãy khẳng định.

1/ Khi trên máy tính phần quyền quản trị thì chỉ User có quyền Administrator mới chạy được code đó ... còn các user khác ko có quyền Administrator là ko chạy được

2/ khi chạy nếu máy tính từ Windows7 To windows10 mà chạy khu UAC đang để chế độ mặc định sẻ báo như hình sau

3/ nhiều năm trước vọc hàm shell.ShellExecute rồi... giờ chỉ nhìn là biết thôi ko cần thử

batman1 · 23/8/21

Kiều Mạnh đã viết:
3/ nhiều năm trước vọc hàm shell.ShellExecute rồi... giờ chỉ nhìn là biết thôi ko cần thử

Nhưng khi có người yêu cầu thì nên thử. Hoặc đừng viết gì. Bởi tôi cũng muốn biết cụ thể. Tôi có thể sai nhưng tôi muốn biết chắc chắn 200%. Máy tôi khi cài tôi vẫn để mặc định. Nếu tôi tự mở bằng tay CMD thì cũng không thay đổi được thời gian - khi gõ lệnh time 17:22:46 thì có thông báo là khách không có quyền. Cái này bạn gọi là "Máy phải có quyền Run As"? Tôi hiểu UAC là gì. Khi tôi phải chuột trên cmd.exe và chọn chạy với quyền administrator thì thực hiện được lệnh time 17:22:46. Và khi tôi chạy code thì cũng thực hiện được lệnh. Vì thế tôi khuyên bạn chạy code của tôi. Nhưng bạn không muốn kiểm tra lại thì chịu.

Một câu hỏi cuối, bạn trả lời hoặc không cũng được. Bạn có nhìn thấy "RUNAS" trong code không?

Chuyện xuất hiện cửa sổ mà Windows hỏi có cho phép hay không là đương nhiên. Cần phải chọn YES.

Lưu ý: bạn khẳng định là code không thể chạy được. Tôi thì cho là code chạy được, chỉ phải chọn YES thôi. 2 vấn đề KHÔNG CHẠY ĐƯỢC và PHẢI NHẤN YES (nhọc công?) là hoàn toàn khác nhau. Một đằng là bó tay, không làm được việc, còn một đằng là làm được việc nhưng hơi mất công.

truongvu317 · 23/8/21

batman1 đã viết:
Bạn có nhìn thấy "RUNAS" trong code không?

Câu hỏi "chất" quá bác ơi.

HeSanbi · 15/9/21

Windows có một vấn đề: nếu thời gian lâu ngày không ReSync thì thời gian sẽ chạy lệch với thời gian thực. Phải chờ lịch cập nhật định kỳ mặc định của windows thì sẽ lâu.

Nên việc cập nhật thời gian cho Windows khi sử dụng ứng dụng Excel có tận dụng thời gian thực thì ta nên ReSync thời gian.

JavaScript:

'Cập nhật thời gian System Windows bằng CMD hoặc WinAPI:
#If VBA7 Then
Private Declare PtrSafe Function W32TimeSyncNow Lib "w32time.dll" (ByVal computername As String, ByVal wait As Boolean, flag As Long) As Long
#Else
Private Declare Function W32TimeSyncNow Lib "w32time.dll" (ByVal computername As String, ByVal wait As Boolean, flag As Long) As Long
#End If

Sub WindowsTimeSyncNow()
    ' Để test thì các bạn chỉnh thời gian System rồi chạy code
    Debug.Print W32TimeSyncNow(VBA.Environ("USERNAME"), True, 8)
' Dùng CMD:
'w32tm /unregister
'w32tm /register
'net stop w32time
'net start w32time
'w32tm /resync
End Sub

Kiều Mạnh · 15/9/21

HeSanbi đã viết:
Windows có một vấn đề: nếu thời gian lâu ngày không ReSync thì thời gian sẽ chạy lệch với thời gian thực. Phải chờ lịch cập nhật định kỳ mặc định của windows thì sẽ lâu.

Nên việc cập nhật thời gian cho Windows khi sử dụng ứng dụng Excel có tận dụng thời gian thực thì ta nên ReSync thời gian.

JavaScript:

'Cập nhật thời gian System Windows bằng CMD hoặc WinAPI: #If VBA7 Then Private Declare PtrSafe Function W32TimeSyncNow Lib "w32time.dll" (ByVal computername As String, ByVal wait As Boolean, flag As Long) As Long #Else Private Declare Function W32TimeSyncNow Lib "w32time.dll" (ByVal computername As String, ByVal wait As Boolean, flag As Long) As Long #End If Sub WindowsTimeSyncNow() ' Để test thì các bạn chỉnh thời gian System rồi chạy code Debug.Print W32TimeSyncNow(VBA.Environ("USERNAME"), True, 8) ' Dùng CMD: 'w32tm /unregister 'w32tm /register 'net stop w32time 'net start w32time 'w32tm /resync End Sub

hình như có gì đó sai sai hay sao ấy

1722 = 17/09/1904

batman1 · 15/9/21

Hàm phải trả về 0 mới là thành công. Trả về 1722 tức không thành công, thời gian không được cập nhật.

1722 là mã của lỗi trong System Error Codes ̣(standard Windows Error)

Muốn thời gian được cập nhật thành công và hàm trả về 0 thì phải:

Debug.Print W32TimeSyncNow("", True, 8)

"" có nghĩa là local computer

Hoàng Trọng Nghĩa · 15/9/21

HeSanbi đã viết:
Windows có một vấn đề: nếu thời gian lâu ngày không ReSync thì thời gian sẽ chạy lệch với thời gian thực. Phải chờ lịch cập nhật định kỳ mặc định của windows thì sẽ lâu.

Nên việc cập nhật thời gian cho Windows khi sử dụng ứng dụng Excel có tận dụng thời gian thực thì ta nên ReSync thời gian.

JavaScript:

'Cập nhật thời gian System Windows bằng CMD hoặc WinAPI: #If VBA7 Then Private Declare PtrSafe Function W32TimeSyncNow Lib "w32time.dll" (ByVal computername As String, ByVal wait As Boolean, flag As Long) As Long #Else Private Declare Function W32TimeSyncNow Lib "w32time.dll" (ByVal computername As String, ByVal wait As Boolean, flag As Long) As Long #End If Sub WindowsTimeSyncNow() ' Để test thì các bạn chỉnh thời gian System rồi chạy code Debug.Print W32TimeSyncNow(VBA.Environ("USERNAME"), True, 8) ' Dùng CMD: 'w32tm /unregister 'w32tm /register 'net stop w32time 'net start w32time 'w32tm /resync End Sub

Máy tính có nút này thì mình đâu cần code trên nhỉ?

ongke0711 · 15/9/21

Hoàng Trọng Nghĩa đã viết:
Máy tính có nút này thì mình đâu cần code trên nhỉ?

View attachment 266138

Ngừa trường hợp sửa ngày hệ thống.

Hoàng Trọng Nghĩa · 15/9/21

ongke0711 đã viết:
Ngừa trường hợp sửa ngày hệ thống.

Những người sửa ngày giờ hệ thống chắc chắn họ phải làm điều gì đó mờ ám, thì họ cũng rất thông minh, cho nên họ sẽ tắt wifi, tắt chức năng cài giờ tự động của windows. Lúc đó họ muốn làm gì đó thì làm.

Kiều Mạnh · 15/9/21

batman1 đã viết:
Hàm phải trả về 0 mới là thành công. Trả về 1722 tức không thành công, thời gian không được cập nhật.

1722 là mã của lỗi trong System Error Codes ̣(standard Windows Error)

Muốn thời gian được cập nhật thành công và hàm trả về 0 thì phải:

Debug.Print W32TimeSyncNow("", True, 8)

"" có nghĩa là local computer

cảm ơn anh thế mà em cứ nghĩ nó lội ngược dòng thời gian bay về năm 1904
hóa ra đó là mã lỗi API ... mà kể ra cũng lạ em viết API tối ngày thế mà cái mã lỗi đó lại nghĩ nhanh qua dd/mm/yyyy ??

batman1 · 15/9/21

Hoàng Trọng Nghĩa đã viết:
Những người sửa ngày giờ hệ thống chắc chắn họ phải làm điều gì đó mờ ám, thì họ cũng rất thông minh, cho nên họ sẽ tắt wifi, tắt chức năng cài giờ tự động của windows. Lúc đó họ muốn làm gì đó thì làm.

Nếu là đấu nhau kiểu đó thì vẫn "trị" được. Nếu tôi có một "chức năng" tởm mà người dùng muốn có thì tôi là người ra điều kiện, tôi chủ động. Anh phải bật wifi không thì ngồi đó mà mơ "chức năng" nhé. Còn khi tôi kiểm tra có internet thì tôi cập nhật thời gian. Nếu thời gian đã qua giới hạn thì ngồi đó mà mơ "chức năng" nhé.
Tất nhiên đã code thì phải giấu kỹ. Tùy mức quan trọng, độ "hiếm" của "chức năng" mà chọn cách bảo vệ tởm hay thật tởm hay thật thật tởm, 1 hay 3, 4 lớp, trùng trùng điệp điệp. Người ta cần mình thì người ta không thể tắt wifi được.

Kiều Mạnh · 15/9/21

Thử vậy xem sao
If Internet_Check = False then tạm ngủ chút

Mã:

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

Function Internet_Check(Optional ConnectMode As Integer) As Boolean   
    Dim flags As Long   
    Internet_Check = InternetGetConnectedState(flags, 0)   
    ConnectMode = flags
End Function

Hoàng Trọng Nghĩa · 15/9/21

Kiều Mạnh đã viết:
Thử vậy xem sao
If Internet_Check = False then tạm ngủ chút

Mã:

Private Declare Function InternetGetConnectedState Lib "wininet.dll" _ (ByRef lpSFlags As Long, ByVal dwReserved As Long) As Long Function Internet_Check(Optional ConnectMode As Integer) As Boolean Dim flags As Long Internet_Check = InternetGetConnectedState(flags, 0) ConnectMode = flags End Function

Chơi luôn cho Win 64bit luôn anh:

Mã:

#If Win64 Then
    Public Flg As LongPtr
    Public Declare PtrSafe Function InternetGetConnectedState _
            Lib "wininet.dll" (lpdwFlags As LongPtr, _
            ByVal dwReserved As Long) As Boolean
#Else
    Public Flg As Long
    Public Declare Function InternetGetConnectedState _
            Lib "wininet.dll" (lpdwFlags As Long, _
            ByVal dwReserved As Long) As Boolean
#End If

Function Internet_Check() As Boolean
    Internet_Check = InternetGetConnectedState(Flg, 0)
End Function

[Chia sẻ] Hàm lấy thời gian từ Internet. (1 người xem)

Người dùng đang xem chủ đề này

Chuyên gia GPE

Thành viên gắn bó

Chuyên gia GPE

Thành viên gạo cội

Chuyên gia GPE

Thành viên gạo cội

Chuyên gia GPE

Thành viên thường trực

Thành viên gạo cội

Thành viên tích cực

File đính kèm

Thành viên gạo cội

Thành viên gạo cội

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

Chuyên gia GPE

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

Thành viên gắn bó

Chuyên gia GPE

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

Chuyên gia GPE

Thành viên gắn bó

Chuyên gia GPE

Thành viên gạo cội

Chuyên gia GPE

Thành viên gắn bó

Chuyên gia GPE

Thành viên thường trực

Thành viên gạo cội

I don't program, I beat code into submission!!!

Thành viên gạo cội

I don't program, I beat code into submission!!!

Thành viên gạo cội

Thành viên tích cực

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

I don't program, I beat code into submission!!!

Thành viên gạo cội

Chuyên gia GPE

Thành viên gắn bó

Chuyên gia GPE

I don't program, I beat code into submission!!!

Thành viên gạo cội

I don't program, I beat code into submission!!!

Chuyên gia GPE

Thời gian đếm ngược.