[Chia sẻ] Hàm lấy thời gian từ Internet.

Blue Softs Liên hệ QC

Hoàng Trọng Nghĩa

Chuyên gia GPE
Thành viên BQT
Moderator
Tham gia
17/8/08
Bài viết
8,308
Được thích
16,063
Giới tính
Nam
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
 

Hoàng Trọng Nghĩa

Chuyên gia GPE
Thành viên BQT
Moderator
Tham gia
17/8/08
Bài viết
8,308
Được thích
16,063
Giới tính
Nam
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:
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.
 
Upvote 0

Maika8008

Thành viên gắn bó
Tham gia
12/6/20
Bài viết
2,311
Được thích
2,539
Donate (Momo)
Donate
Giới tính
Nam
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.
 
Upvote 0

Hoàng Trọng Nghĩa

Chuyên gia GPE
Thành viên BQT
Moderator
Tham gia
17/8/08
Bài viết
8,308
Được thích
16,063
Giới tính
Nam
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.
 
Upvote 0

ongke0711

Thành viên tích cực
Tham gia
7/9/06
Bài viết
1,036
Được thích
1,245
Giới tính
Nam
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.
 
  • Thích
Reactions: 3ii
Upvote 0

Hoàng Trọng Nghĩa

Chuyên gia GPE
Thành viên BQT
Moderator
Tham gia
17/8/08
Bài viết
8,308
Được thích
16,063
Giới tính
Nam
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ứ!
 
Upvote 0

3ii

Thành viên hoạt động
Tham gia
4/7/21
Bài viết
101
Được thích
35
Bạn đọc bài sau, và các bài khác trong chủ đề.

Để đọc ra thiết lập thì dùng hàm GetLocaleInfo. Để thiết lập thì dùng SetLocaleInfo

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

batman1

Thành viên gạo cội
Tham gia
8/9/14
Bài viết
4,583
Được thích
7,536
Cháu đã đọc nhưng chưa biết vận dụng (@$%@
À nhầm. SetLocaleInfo dùng để vd. thiết lập dạng ngày tháng, vd. "yyyy-mm-dd"

Có thể dùng vd. dò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
 
Upvote 0

Kiều Mạnh

IIIIIIIIIIIIIIIII
Tham gia
9/6/12
Bài viết
4,478
Được thích
3,149
Giới tính
Nam
À nhầm. SetLocaleInfo dùng để vd. thiết lập dạng ngày tháng, vd. "yyyy-mm-dd"

Có thể dùng vd. dò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
 
Upvote 0

batman1

Thành viên gạo cội
Tham gia
8/9/14
Bài viết
4,583
Được thích
7,536
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 ý "Máy phải có quyền Run As". Thế nào là "Máy phải có quyền Run As" và thế nào là máy KHÔNG phải là "Máy phải có quyền Run As"? Nếu là trường hợp 2 thì khi chạy code của tôi sẽ nhận được gì?

Tôi biết Run As là gì nhưng tôi không hiểu "Máy phải có quyền Run As" là máy thế nào. Và bạn đã chạy code của tôi với máy KHÔNG CÓ cái gọi là "Máy phải có quyền Run As" hay chưa. Nếu chưa kiểm nghiệm thì hãy kiểm nghiệm rồi hãy khẳng định.
 
Upvote 0

Kiều Mạnh

IIIIIIIIIIIIIIIII
Tham gia
9/6/12
Bài viết
4,478
Được thích
3,149
Giới tính
Nam
Tôi không hiểu ý "Máy phải có quyền Run As". Thế nào là "Máy phải có quyền Run As" và thế nào là máy KHÔNG phải là "Máy phải có quyền Run As"? Nếu là trường hợp 2 thì khi chạy code của tôi sẽ nhận được gì?

Tôi biết Run As là gì nhưng tôi không hiểu "Máy phải có quyền Run As" là máy thế nào. Và bạn đã chạy code của tôi với máy KHÔNG CÓ cái gọi là "Máy phải có quyền Run As" hay chưa. Nếu chưa kiểm nghiệm thì hãy kiểm nghiệm rồi hãy khẳng đị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
uac-logo.jpg

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ử
 
Upvote 0

batman1

Thành viên gạo cội
Tham gia
8/9/14
Bài viết
4,583
Được thích
7,536
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 có người yêu cầu thì nên thử. Hoặc đừng viết gì. Bởi tôi cũng muốn biết cụ thể. Tôi có thể sai nhưng tôi muốn biết chắc chắn 200%. Máy tôi khi cài tôi vẫn để mặc định. Nếu tôi tự mở bằng tay CMD thì cũng không thay đổi được thời gian - khi gõ lệnh time 17:22:46 thì có thông báo là khách không có quyền. Cái này bạn gọi là "Máy phải có quyền Run As"? Tôi hiểu UAC là gì. Khi tôi phải chuột trên cmd.exe và chọn chạy với quyền administrator thì thực hiện được lệnh time 17:22:46. Và khi tôi chạy code thì cũng thực hiện được lệnh. Vì thế tôi khuyên bạn chạy code của tôi. Nhưng bạn không muốn kiểm tra lại thì chịu.

Một câu hỏi cuối, bạn trả lời hoặc không cũng được. Bạn có nhìn thấy "RUNAS" trong code không?

Chuyện xuất hiện cửa sổ mà Windows hỏi có cho phép hay không là đương nhiên. Cần phải chọn YES.

Lưu ý: bạn khẳng định là code không thể chạy được. Tôi thì cho là code chạy được, chỉ phải chọn YES thôi. 2 vấn đề KHÔNG CHẠY ĐƯỢC và PHẢI NHẤN YES (nhọc công?) là hoàn toàn khác nhau. Một đằng là bó tay, không làm được việc, còn một đằng là làm được việc nhưng hơi mất công.
 
Lần chỉnh sửa cuối:
  • Yêu thích
Reactions: 3ii
Upvote 0

HeSanbi

0 + Giao động -> Vũ Trụ
Tham gia
24/2/13
Bài viết
1,730
Được thích
2,183
Giới tính
Nam
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
 
Lần chỉnh sửa cuối:
Upvote 0

Kiều Mạnh

IIIIIIIIIIIIIIIII
Tham gia
9/6/12
Bài viết
4,478
Được thích
3,149
Giới tính
Nam
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

1631695851581.png

1722 = 17/09/1904
 
Upvote 0

batman1

Thành viên gạo cội
Tham gia
8/9/14
Bài viết
4,583
Được thích
7,536
Hàm phải trả về 0 mới là thành công. Trả về 1722 tức không thành công, thời gian không được cập nhật.

1722 là mã của lỗi trong System Error Codes ̣(standard Windows Error)

Muốn thời gian được cập nhật thành công và hàm trả về 0 thì phải:

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

"" có nghĩa là local computer
 
Lần chỉnh sửa cuối:
Upvote 0

Hoàng Trọng Nghĩa

Chuyên gia GPE
Thành viên BQT
Moderator
Tham gia
17/8/08
Bài viết
8,308
Được thích
16,063
Giới tính
Nam
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ỉ?

1631702982633.png
 
Upvote 0

Hoàng Trọng Nghĩa

Chuyên gia GPE
Thành viên BQT
Moderator
Tham gia
17/8/08
Bài viết
8,308
Được thích
16,063
Giới tính
Nam
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.
 
Upvote 0

Kiều Mạnh

IIIIIIIIIIIIIIIII
Tham gia
9/6/12
Bài viết
4,478
Được thích
3,149
Giới tính
Nam
Hàm phải trả về 0 mới là thành công. Trả về 1722 tức không thành công, thời gian không được cập nhật.

1722 là mã của lỗi trong System Error Codes ̣(standard Windows Error)

Muốn thời gian được cập nhật thành công và hàm trả về 0 thì phải:

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

"" có nghĩa là 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 ??
 
Upvote 0

batman1

Thành viên gạo cội
Tham gia
8/9/14
Bài viết
4,583
Được thích
7,536
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 là đấu nhau kiểu đó thì vẫn "trị" được. Nếu tôi có một "chức năng" tởm mà người dùng muốn có thì tôi là người ra điều kiện, tôi chủ động. Anh phải bật wifi không thì ngồi đó mà mơ "chức năng" nhé. Còn khi tôi kiểm tra có internet thì tôi cập nhật thời gian. Nếu thời gian đã qua giới hạn thì ngồi đó mà mơ "chức năng" nhé.
Tất nhiên đã code thì phải giấu kỹ. Tùy mức quan trọng, độ "hiếm" của "chức năng" mà chọn cách bảo vệ tởm hay thật tởm hay thật thật tởm, 1 hay 3, 4 lớp, trùng trùng điệp điệp. Người ta cần mình thì người ta không thể tắt wifi được.
 
Upvote 0
Top Bottom