Update ngày giờ của hệ thống qua Internet (1 người xem)

MinhKhai · 19/1/13

Tôi đang dùng 1 file Excel mà giá trị tính toán có dựa vào thời gian của hệ thống. Tuy nhiên một vài máy tính có thời gian chạy không đúng.
Vậy có Code nào để khi chạy mở file excel, Windows sẽ bị buộc phải cập nhật ngày giờ qua Internet Time Update.
Ngoài ra nếu được có thể tự chỉnh lại định dạng ngày tháng trong hệ thống không ?

Xin các ACE giúp đỡ

ndu96081631 · 19/1/13

MinhKhai đã viết:
Tôi đang dùng 1 file Excel mà giá trị tính toán có dựa vào thời gian của hệ thống. Tuy nhiên một vài máy tính có thời gian chạy không đúng.
Vậy có Code nào để khi chạy mở file excel, Windows sẽ bị buộc phải cập nhật ngày giờ qua Internet Time Update.
Ngoài ra nếu được có thể tự chỉnh lại định dạng ngày tháng trong hệ thống không ?

Xin các ACE giúp đỡ

Code để lấy Date Time từ internet

Mã:

Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Integer, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Integer, ByVal lpfnCB As Integer) As Integer
Private Declare Function DeleteUrlCacheEntry Lib "Wininet.dll" Alias "DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Integer

Mã:

Sub DownloadFile(ByVal sURL As String, ByVal FileName As String)
  DeleteUrlCacheEntry sURL
  URLDownloadToFile 0, sURL, FileName, 0, 0
End Sub

Mã:

[code]
Function InternetTime()
  Dim sTmp As String, sURL As String, FileName
  Dim fso As Object
  sURL = "http://www.timeanddate.com/worldclock/city.html?n=95"
  FileName = "C:\InternetDate.dat"
  DownloadFile sURL, FileName
  Set fso = CreateObject("Scripting.FileSystemObject")
  With fso.OpenTextFile(FileName, 1)
    sTmp = .ReadAll
    sTmp = Mid(sTmp, InStr(1, sTmp, "Current Time"))
    sTmp = Mid(sTmp, 1, InStr(1, sTmp, "</strong>") - 1)
    sTmp = Mid(sTmp, InStr(1, sTmp, "big>") + 4)
    sTmp = Mid(sTmp, InStr(1, sTmp, "at ") + 3)
    .Close
  End With
  InternetTime = Format(TimeValue(sTmp), "hh:mm:ss")
  Set fso = Nothing: Kill (FileName)
End Function

Và cuối cùng là Sub để Set time cho hệ thống

Mã:

Sub Main()
  Dim sComm As String, sTime As String
  sTime = InternetTime
  sComm = "cmd.exe /c Time " & sTime
  CreateObject("WScript.Shell").Run sComm, 0, True
End Sub

Bạn test thử, tôi không chắc (Test bằng cách chỉnh cho sai giờ hệ thống rồi chạy code xem giờ hệ thống đã đúng chưa)
Yêu cầu: Muốn chạy code phải kết nối internet (đương nhiên)

LienDong · 19/1/13

Bạn test thử, tôi không chắc (Test bằng cách chỉnh cho sai giờ hệ thống rồi chạy code xem giờ hệ thống đã đúng chưa)
Yêu cầu: Muốn chạy code phải kết nối internet (đương nhiên)

Sao mình Test mà nó chỉ chỉnh giờ chứ kg chỉnh ngày tháng năm?
Cảm ơn!

ndu96081631 · 19/1/13

LienDong đã viết:
Sao mình Test mà nó chỉ chỉnh giờ chứ kg chỉnh ngày tháng năm?
Cảm ơn!

Đúng rồi, ngày tháng hơi khó 1 chút vì phải xem Control Panel đang định dạng là d/M/y hay M/d/y
Giờ viết lại, Set cả ngày và giờ luôn nhé:

Mã:

Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Integer, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Integer, ByVal lpfnCB As Integer) As Integer
Private Declare Function DeleteUrlCacheEntry Lib "Wininet.dll" Alias "DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Integer

Mã:

Sub DownloadFile(ByVal sURL As String, ByVal FileName As String)
  DeleteUrlCacheEntry sURL
  URLDownloadToFile 0, sURL, FileName, 0, 0
End Sub

Mã:

Function InternetDateTime() As Double
  Dim sTmp As String, sURL As String, FileName As String
  Dim fso As Object, aTmp, Arr(1 To 2)
  sURL = "http://www.timeanddate.com/worldclock/city.html?n=95"
  Set fso = CreateObject("Scripting.FileSystemObject")
  FileName = fso.GetTempName
  DownloadFile sURL, FileName
  With fso.OpenTextFile(FileName, 1)
    sTmp = .ReadAll
    .Close
  End With
  Set fso = Nothing: Kill (FileName)
  sTmp = Mid(sTmp, InStr(1, sTmp, "Current Time"))
  sTmp = Mid(sTmp, 1, InStr(1, sTmp, "</strong>") - 1)
  sTmp = Mid(sTmp, InStr(1, sTmp, "big>") + 4)
  aTmp = Split(sTmp, " at ")
  Arr(2) = TimeValue(aTmp(1))
  sTmp = Trim(Replace(aTmp(0), ",", ""))
  aTmp = Split(sTmp, " ")
  Arr(1) = DateValue(aTmp(2) & "-" & aTmp(1) & "-" & aTmp(3))
  InternetDateTime = CLng(Arr(1)) + CDbl(Arr(2))
End Function

Mã:

Sub Main()
  Dim sComm As String, sTime As String, sDate As String, sFormat As String
  Dim dNow As Double
  dNow = InternetDateTime
  sTime = Format(dNow, "hh:mm:ss")
  Select Case Application.International(xlDateOrder)
    Case Is = 0: sFormat = "MM/dd/yyyy"
    Case Is = 1: sFormat = "dd/MM/yyyy"
    Case Is = 2: sFormat = "yyyy/MM/dd"
  End Select
  sDate = Format(dNow, sFormat)
  sComm = "cmd.exe /c Time " & sTime
  CreateObject("WScript.Shell").Run sComm, 0, True
  sComm = "cmd.exe /c Date " & sDate
  CreateObject("WScript.Shell").Run sComm, 0, True
End Sub

MinhKhai · 20/1/13

ndu96081631 đã viết:
Đúng rồi, ngày tháng hơi khó 1 chút vì phải xem Control Panel đang định dạng là d/M/y hay M/d/y
Giờ viết lại, Set cả ngày và giờ luôn nhé:

Tuyệt vời. Cảm ơn bác
Bác bổ sung code để nó mặc định sẽ chuyển múi giờ về HN được không ? (nếu đang múi giờ khác)

ndu96081631 · 21/1/13

MinhKhai đã viết:
Tuyệt vời. Cảm ơn bác
Bác bổ sung code để nó mặc định sẽ chuyển múi giờ về HN được không ? (nếu đang múi giờ khác)

Chuyển Time Zone thành Bangkok, Hanoi, Jakarta nhé

Mã:

Sub VNTimeZone()
  Dim sComm As String
  sComm = "cmd.exe /c TZUTIL /s ""SE Asia Standard time"""
  CreateObject("WScript.Shell").Run sComm, 0, True
End Sub

Thí nghiệm chuyển bằng tay Time Zone trên máy tính thành "cái khác", xong chạy code xem thế nào nhé
---------------
Để việc đặt ngày giờ được chính xác, bạn phải chạy code VNTimeZone trước, xong mới chạy Sub Main nhé
Bạn có thể gộp 2 code làm 1 cũng với nguyên tắc: Set Time Zone trước khi Set Data Time
Ví dụ code gộp:

Mã:

Sub Main()
  Dim sComm As String, sTime As String, sDate As String, sFormat As String
  Dim dNow As Double
  [COLOR=#ff0000][B]VNTimeZone[/B][/COLOR]
  dNow = InternetDateTime
  sTime = Format(dNow, "hh:mm:ss")
  Select Case Application.International(xlDateOrder)
    Case Is = 0: sFormat = "MM/dd/yyyy"
    Case Is = 1: sFormat = "dd/MM/yyyy"
    Case Is = 2: sFormat = "yyyy/MM/dd"
  End Select
  sDate = Format(dNow, sFormat)
  sComm = "cmd.exe /c Time " & sTime
  CreateObject("WScript.Shell").Run sComm, 0, True
  sComm = "cmd.exe /c Date " & sDate
  CreateObject("WScript.Shell").Run sComm, 0, True
End Sub

app · 21/1/13

MinhKhai đã viết:
Tôi đang dùng 1 file Excel mà giá trị tính toán có dựa vào thời gian của hệ thống. Tuy nhiên một vài máy tính có thời gian chạy không đúng.
Vậy có Code nào để khi chạy mở file excel, Windows sẽ bị buộc phải cập nhật ngày giờ qua Internet Time Update.
Ngoài ra nếu được có thể tự chỉnh lại định dạng ngày tháng trong hệ thống không ?

Xin các ACE giúp đỡ

Trường hợp của bạn có 2 tùy chọn khá hay:

1. Dùng tính năng tự động cập nhật giờ của Windows. Tính năng này xuất hiện ít nhất là từ Windows XP.

Bạn tìm khóa sau trong Regedit:

HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\services\W32Time\TimeProviders\NtpClient

Với DWORD SpecialPollInterval là thời gian (giây) máy tính của bạn sẽ nối với máy chủ time của Microsoft để cập nhật. Mặc định là 7 ngày tuy nhiên bạn còn thể chỉnh xuống tổi thiểu 1 giây.
Để sử dụng được tính năng này thì dịch vụ Windows Time phải đang chạy. Trên Windows 7 mình đang chạy, dịch vụ này có trạng thái Stopped. Bạn chuyển Startup style về Automatic.

2. Nếu hệ thống LAN của bạn có 1 máy tính cài đặt giờ chuẩn thì dùng 1 file BATCH dùng lệnh NET TIME rồi kẻo thả vào Startup (thực thi khi máy khởi động/login). Cái này không yêu cầu kết nối internet.

Nhìn có vẻ phức tạp nhưng thực hiện khá đơn giản đấy. Cách 1 có thể coi là chuẩn nhất vì bạn được cập nhật giờ của máy chủ Microsoft. Chỉ cần bạn đặt đúng Time Zone Hà Nội thì máy tính sẽ tự cập nhật giờ Hà Nội cho bạn.

ndu96081631 · 21/1/13

app đã viết:
Trường hợp của bạn có 2 tùy chọn khá hay:

1. Dùng tính năng tự động cập nhật giờ của Windows. Tính năng này xuất hiện ít nhất là từ Windows XP.

Bạn tìm khóa sau trong Regedit:

HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\services\W32Time\TimeProviders\NtpClient

Với DWORD SpecialPollInterval là thời gian (giây) máy tính của bạn sẽ nối với máy chủ time của Microsoft để cập nhật. Mặc định là 7 ngày tuy nhiên bạn còn thể chỉnh xuống tổi thiểu 1 giây.

Để sử dụng được tính năng này thì dịch vụ Windows Time phải đang chạy. Trên Windows 7 mình đang chạy, dịch vụ này có trạng thái Stopped. Bạn chuyển Startup style về Automatic.

2. Nếu hệ thống LAN của bạn có 1 máy tính cài đặt giờ chuẩn thì dùng 1 file BATCH dùng lệnh NET TIME đặt vào Startup (thực thi khi máy khởi động/login). Cái này không yêu cầu kết nối internet.

Nhìn có vẻ phức tạp nhưng thực hiện khá đơn giản đấy. Cách 1 có thể coi là chuẩn nhất vì bạn được cập nhật giờ của máy chủ Microsoft. Chỉ cần bạn đặt đúng Time Zone Hà Nội thì máy tính sẽ tự cập nhật giờ Hà Nội cho bạn.

Vấn đề là người ta muốn tự động chứ không phải làm bằng tay
Dù là dùng cách gì thì cũng phải viết code ---> Mức độ phức tạp vẫn như nhau

app · 21/1/13

ndu96081631 đã viết:
Vấn đề là người ta muốn tự động chứ không phải làm bằng tay
Dù là dùng cách gì thì cũng phải viết code ---> Mức độ phức tạp vẫn như nhau

Vâng! Hoàn toàn tự động. Làm 1 lần hưởng thụ mãi mãi.

app · 21/1/13

ndu96081631 đã viết:
Vấn đề là người ta muốn tự động chứ không phải làm bằng tay
Dù là dùng cách gì thì cũng phải viết code ---> Mức độ phức tạp vẫn như nhau

Amateur đã viết:
Hi! Đây là cách giải quyết của người trình độ thấp sao bằng cách làm đẳng cấp của anh NDU được. Nhưng em nghĩ cái này là tính năng có sẵn, không cần cài đặt gì thêm. Của chùa mà không dùng thì tiếc quá.

Cái này cài 1 lần rồi nó tự chạy dài. Cứ login windows cái là nó chạy. Với cách 1 thì cứ sau n giây thì nó tự chạy. Không phải kích hoạt gì cả.

Thời gian được điều chỉnh theo Time Zone của bạn. Bạn cài time zone Hà Nội, thì nó tự nhận biết Hà Nội, Singapore thì tự nhận biết là Singapore, Lodon tự biết là London... Giống kiểu nhập gia tùy tục.

Chưa kể WindowsTime được Microsoft cung cấp ổn định hơn 12 năm nay trong khi các dịch vụ khác có thời gian hoạt động ít hơn và có thể bị thay đổi hoặc kết thúc không báo trước.

ndu96081631 · 21/1/13

app đã viết:
Cái này cài 1 lần rồi nó tự chạy dài. Cứ login windows cái là nó chạy. Với cách 1 thì cứ sau n giây thì nó tự chạy. Không phải kích hoạt gì cả.
Cái này là phần cài đặt cho Regedit. Thời gian mỗi lần tự cập nhật là 24h.
SpecialPollInterval (dword):00015180
Tiếc là GPE không cho up file REG.

Theo như tôi hiểu thì tác giả đang viết 1 code gì đó và đưa cho người khác xài (không phải xài trên máy mình).. Code này có tính toán gì đó liên quan đến thời gian thực nên buộc phải viết luôn trong code để dù người ta có cố tình chỉnh lại ngày giờ thì code vẫn nhận biết được
Vậy bạn nghĩ xem, liệu có phải nên khuyên tác giả rằng: Trước khi đưa code cho ai đó thì nên chịu khó ngồi vào máy đó chỉnh lại registry?
Dù chỉ chỉnh có 1 lần thì không phải vẫn mất công sao? Tôi ở Biên Hòa, bạn ấy ở Hà Nội, phải bay vào Nam để chỉnh chắc?
Còn nếu như viết code để làm vụ này (không phải ngồi vào máy người ta) thì vẫn như tôi nói ở trên: Độ phức tạp của code là như nhau

MinhKhai · 21/1/13

app đã viết:
Trường hợp của bạn có 2 tùy chọn khá hay:

1. Dùng tính năng tự động cập nhật giờ của Windows. Tính năng này xuất hiện ít nhất là từ Windows XP.
2. Nếu hệ thống LAN của bạn có 1 máy tính cài đặt giờ chuẩn thì dùng 1 file BATCH dùng lệnh NET TIME rồi kẻo thả vào Startup (thực thi khi máy khởi động/login). Cái này không yêu cầu kết nối internet.

Nhìn có vẻ phức tạp nhưng thực hiện khá đơn giản đấy. Cách 1 có thể coi là chuẩn nhất vì bạn được cập nhật giờ của máy chủ Microsoft. Chỉ cần bạn đặt đúng Time Zone Hà Nội thì máy tính sẽ tự cập nhật giờ Hà Nội cho bạn.

Bạn ơi, để update thời gian cho máy (Windows) bằng tay thì tôi đã biết từ năm 2011 khi WinXP giới thiệu bản dùng thử. Vấn để là file Excel được nhiều người sử dụng, chẳng lẽ mình nhắc từng người để họ Update thời gian, (hoặc gửi cho họ file .reg). Với lại nhiều máy chỗ tôi luôn luôn có thời gian không chuẩn, (chắc do yếu pin CMOS).
Sản phẩm phần mềm tốt khi chạy cần kiểm tra một vài thông số và tự động điều chỉnh nếu cần để giảm bớt thao tác cho người dùng.
Cảm ơn bác NDU, dùng file của bác em thấy kết quả update nhanh hơn khi nhấn nút Update Now.

siwtom · 21/1/13

ndu96081631 đã viết:
Chuyển Time Zone thành Bangkok, Hanoi, Jakarta nhé

Mã:

Sub VNTimeZone() Dim sComm As String sComm = "cmd.exe /c TZUTIL /s ""SE Asia Standard time""" CreateObject("WScript.Shell").Run sComm, 0, True End Sub

Thí nghiệm chuyển bằng tay Time Zone trên máy tính thành "cái khác", xong chạy code xem thế nào nhé
---------------
Để việc đặt ngày giờ được chính xác, bạn phải chạy code VNTimeZone trước, xong mới chạy Sub Main nhé
Bạn có thể gộp 2 code làm 1 cũng với nguyên tắc: Set Time Zone trước khi Set Data Time
Ví dụ code gộp:

Mã:

Sub Main() Dim sComm As String, sTime As String, sDate As String, sFormat As String Dim dNow As Double [COLOR=#ff0000][B]VNTimeZone[/B][/COLOR] dNow = InternetDateTime sTime = Format(dNow, "hh:mm:ss") Select Case Application.International(xlDateOrder) Case Is = 0: sFormat = "MM/dd/yyyy" Case Is = 1: sFormat = "dd/MM/yyyy" Case Is = 2: sFormat = "yyyy/MM/dd" End Select sDate = Format(dNow, sFormat) sComm = "cmd.exe /c Time " & sTime CreateObject("WScript.Shell").Run sComm, 0, True sComm = "cmd.exe /c Date " & sDate CreateObject("WScript.Shell").Run sComm, 0, True End Sub

Đạt yêu cầu của người hỏi rồi nhưng tôi muốn lưu ý những người khác để khỏi bất ngờ.

1. Không phải lúc nào cũng có "at" trong Current Time để có thể lọc theo code của ndu. Cái này có lẽ phụ thuộc vào "chỗ ngồi" của máy - vùng + phiên bản Windows?

2. TZUTIL chỉ có trong Win 7, trong Win XP không có. Ít ra thì trong XP Home của tôi không có

ndu96081631 · 21/1/13

siwtom đã viết:
2. TZUTIL chỉ có trong Win 7, trong Win XP không có. Ít ra thì trong XP Home của tôi không có

Chính xác là vậy!
Riêng với Windows XP em không biết có cách nào không? Theo anh thì dùng cái gì đây?
(Trong Registry em biết đường dẫn nhưng cũng không biết thay đổi thế nào cho đúng)

app · 21/1/13

Quả là các anh/chị toàn dùng cách cao siêu. Bái phục bái phục...

Mình thì hồi trước hay máy mó mấy cái tính năng trong Windows. Nội nguyên cái thư mục Windows cũng cả trăm chương trình mà chả thấy sách báo nào nói tới.

Cách NET TIME thì đúng lạc hậu quá rồi (chắc có từ thế kỷ trước). Còn cách Windows-Time tốn 10 phút search và thử. Nút thắt là vấn đề bật cái service time. Lâu lắm rồi mới có dịp mò ra 1 cái tính năng mới (cũ người mới ta). Với mình thì vậy là nhanh còn với các sư phụ đây chắc giải quyết nhanh hơn nhiều. :-=

Nói chung là không đủ trình độ viết code này nọ thì đành phải chịu khó thử và search vậy. :.,

ndu96081631 · 21/1/13

app đã viết:
Cách NET TIME thì đúng lạc hậu quá rồi (chắc có từ thế kỷ trước). Còn cách Windows-Time tốn 10 phút search và thử. Nút thắt là vấn đề bật cái service time. Lâu lắm rồi mới có dịp mò ra 1 cái tính năng mới (cũ người mới ta). Với mình thì vậy là nhanh còn với các sư phụ đây chắc giải quyết nhanh hơn nhiều.

Nói chung là không đủ trình độ viết code này nọ thì đành phải chịu khó thử và search vậy.

Đâu có đâu! NET TIME không lạc hậu... Mà nói chung thì chẳng cái gì lạc hậu cả, vấn đề là ta dùng nó thế nào thôi! Tôi vẫn dùng DOS trong VBA (bạn thấy trong code đấy thôi) mà chẳng thấy có gì lạc hậu cả
Tức là: Cái gì giúp ta giải quyết tốt vấn đề thì cái ấy.. ngon
Ẹc... Ẹc...

siwtom · 22/1/13

ndu96081631 đã viết:
Chính xác là vậy!
Riêng với Windows XP em không biết có cách nào không? Theo anh thì dùng cái gì đây?
(Trong Registry em biết đường dẫn nhưng cũng không biết thay đổi thế nào cho đúng)

Tôi làm cả hai công đoạn: Đổi vùng và thiết lập ngày tháng, thời gian.
Vậy sau khi lọc được ngày tháng và thời gian rồi thì gọi:

Mã:

    SetTimeZone ...
        SetLocalDateTime ...

Tôi dùng các hàm API, và mới thử vài lần gọi "chay" chứ không lấy ngày tháng và thời gian từ Internet.

Module1 cùng với vd. Button1_Click

[GPECODE=vb]
Private Const HKEY_LOCAL_MACHINE As Long = &H80000002
Private Const HKLM = HKEY_LOCAL_MACHINE

Private Const KEY_ALL_ACCESS = &H3F

Private Const REG_SZ = 1
Private Const REG_BINARY = 3

Private Const ERROR_SUCCESS = 0

Private Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type

Private Type TIME_ZONE_INFORMATION
Bias As Long
StandardName As String * 64 ' (0 To 31) As Integer
StandardDate As SYSTEMTIME
StandardBias As Long
DaylightName As String * 64 ' (0 To 31) As Integer
DaylightDate As SYSTEMTIME
DaylightBias As Long
End Type

Private Type REG_TIME_ZONE_INFORMATION
Bias As Long
StandardBias As Long
DaylightBias As Long
StandardDate As SYSTEMTIME
DaylightDate As SYSTEMTIME
End Type

Private Declare Function GetTimeZoneInformation Lib "kernel32.dll" (ByRef lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long
Private Declare Function SetTimeZoneInformation Lib "kernel32.dll" (ByRef lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long
Private Declare Function SetLocalTime Lib "kernel32.dll" (ByRef lpSystemTime As SYSTEMTIME) As Long

Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hkey As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hkey As Long, ByVal lpValueName As String, _
ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long

Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hkey As Long, ByVal lpSubKey As String, _
ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long

Private Declare Function RegQueryValueExStr Lib "advapi32" Alias "RegQueryValueExA" (ByVal hkey As Long, ByVal lpValueName As String, _
ByVal lpReserved As Long, ByRef lpType As Long, ByVal szData As String, ByRef lpcbData As Long) As Long

Private Const TimeZonesKey = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Time Zones\"

Sub SetTimeZone(ByVal TimeZone As String)
Dim hkey As Long, lpType As Long, lpcbData As Long
Dim TZI As TIME_ZONE_INFORMATION, RTZI As REG_TIME_ZONE_INFORMATION

If RegOpenKeyEx(HKLM, TimeZonesKey & TimeZone, 0, KEY_ALL_ACCESS, hkey) <> ERROR_SUCCESS Then Exit Sub
lpType = REG_BINARY
lpcbData = Len(RTZI)
If RegQueryValueEx(hkey, "TZI", 0, lpType, RTZI, lpcbData) <> ERROR_SUCCESS Then Exit Sub
lpType = REG_SZ
lpcbData = Len(TZI.StandardName)
If RegQueryValueExStr(hkey, "Std", 0, lpType, TZI.StandardName, lpcbData) <> ERROR_SUCCESS Then Exit Sub
lpcbData = Len(TZI.DaylightName)
If RegQueryValueExStr(hkey, "Dlt", 0, lpType, TZI.DaylightName, lpcbData) <> ERROR_SUCCESS Then Exit Sub
RegCloseKey hkey

TZI.StandardName = StrConv(TZI.StandardName, vbUnicode)
TZI.DaylightName = StrConv(TZI.DaylightName, vbUnicode)

TZI.Bias = RTZI.Bias
TZI.DaylightBias = RTZI.DaylightBias
TZI.DaylightDate = RTZI.DaylightDate
TZI.StandardBias = RTZI.StandardBias
TZI.StandardDate = RTZI.StandardDate

SetTimeZoneInformation TZI
End Sub

Sub SetLocalDateTime(ByVal Year As Integer, ByVal Month As Integer, ByVal Day As Integer, _
ByVal Hour As Integer, ByVal Minute As Integer, ByVal Second As Integer)
Dim st As SYSTEMTIME
With st
.wYear = Year
.wMonth = Month
.wDay = Day
.wHour = Hour
.wMinute = Minute
.wSecond = Second
End With
SetLocalTime st
End Sub

Sub Button1_Click()
SetTimeZone "SE Asia Standard Time"
SetLocalDateTime 2013, 2, 25, 16, 30, 25
End Sub
[/GPECODE]

Hoàng Trọng Nghĩa · 22/1/13

siwtom đã viết:
Tôi làm cả hai công đoạn: Đổi vùng và thiết lập ngày tháng, thời gian.
Vậy sau khi lọc được ngày tháng và thời gian rồi thì gọi:

Trời ơi, Thầy mình thức khuya quá! Ngủ sớm Thầy ơi!

Lại thấy anh Nguyễn Duy Tuân nữa chứ!

ndu96081631 · 22/1/13

siwtom đã viết:
Tôi dùng các hàm API, và mới thử vài lần gọi "chay" chứ không lấy ngày tháng và thời gian từ Internet.

Vấn đề Set Time Zone đương nhiên không cần kết nối internet, nhưng phần thời gian, em không hiểu nếu không lấy từ internet thì anh lấy ở đâu?

siwtom đã viết:
[GPECODE=vb]
Sub Button1_Click()
SetTimeZone "SE Asia Standard Time"
SetLocalDateTime 2013, 2, 25, 16, 30, 25
End Sub
[/GPECODE]

Em thấy hơi lạ về mấy con số 2013, 2, 25, 16, 30, 25... chẳng lẽ mấy số này là ta tự đặt? Mà muốn đặt thì biết bi nhiêu đâu mà đặt cho đúng?

siwtom · 22/1/13

ndu96081631 đã viết:
Vấn đề Set Time Zone đương nhiên không cần kết nối internet, nhưng phần thời gian, em không hiểu nếu không lấy từ internet thì anh lấy ở đâu?

Em thấy hơi lạ về mấy con số 2013, 2, 25, 16, 30, 25... chẳng lẽ mấy số này là ta tự đặt? Mà muốn đặt thì biết bi nhiêu đâu mà đặt cho đúng?

Trời ạ, đã bảo là thử chay. Tôi lười không muốn kết nối internet nên chỉ tự "bịa" ra thời gian rồi kiểm tra xem code chạy thế nào thôi. Tức code thiết lập ngày tháng, vùng chứ không phải code lấy thời gian từ internet vì code đó các bạn thử rồi còn gì?Tôi đã viết rõ:

sau khi lọc được ngày tháng và thời gian rồi thì gọi:

Mã:

SetTimeZone ...
SetLocalDateTime ...

ndu96081631 · 22/1/13

siwtom đã viết:
Trời ạ, đã bảo là thử chay. Tôi lười không muốn kết nối internet nên chỉ tự "bịa" ra thời gian rồi kiểm tra xem code chạy thế nào thôi. Tức code thiết lập ngày tháng, vùng chứ không phải code lấy thời gian từ internet vì code đó các bạn thử rồi còn gì?Tôi đã viết rõ:

sau khi lọc được ngày tháng và thời gian rồi thì gọi:

Mã:

SetTimeZone ... SetLocalDateTime ...

Anh ơi! Phần ngày tháng coi như khỏi bàn tới!
Như anh nói ở trên: TZUTIL chỉ hoạt động trên Windows 7 nên em thắc mắc có cách nào để chạy được trên mọi version không?
Ngoài cách anh dùng API như trên (để Set Time Zone), liệu có cách khác, đại loại như TimeDate.cpl /"gì gì đó" hay không?

siwtom · 22/1/13

ndu96081631 đã viết:
Anh ơi! Phần ngày tháng coi như khỏi bàn tới!

Ngày tháng là tôi viết thêm. Gọi là một lựa chọn khác. Vả lại đã API thì API tới bến luôn

Như anh nói ở trên: TZUTIL chỉ hoạt động trên Windows 7 nên em thắc mắc có cách nào để chạy được trên mọi version không?
Ngoài cách anh dùng API như trên (để Set Time Zone), liệu có cách khác, đại loại như TimeDate.cpl /"gì gì đó" hay không?

Tuấn có vẻ không khoái API "nhể".

Thôi được. Ta vẫn biết là dòng lệnh

Mã:

rundll32.exe shell32.dll,Control_RunDLL timedate.cpl,,[B][COLOR=#ff0000]1[/COLOR][/B]

sẽ mở cửa sổ Date and Time. Do cái 1 kia nên nó mở ở thẻ Time Zone.

Thế ta muốn chọn luôn "SE Asia Standard Time" rồi tự động đóng cửa sổ?

Ta thử thay 1 kia bằng "/Z SE Asia Standard Time" (Z "ám chỉ" Zone)
Tức chạy

Mã:

rundll32.exe shell32.dll,Control_RunDLL timedate.cpl,,/Z SE Asia Standard Time

Báo cáo kết quả.
---------------
Mà nên thỉnh thoảng đổi món chút đi. Phở dĩ nhiên là ngon rồi nhưng phở mãi mà không nhớ "cơm" đang đau đáu đợi à?

ndu96081631 · 22/1/13

siwtom đã viết:
Tức chạy

Mã:

rundll32.exe shell32.dll,Control_RunDLL timedate.cpl,,/Z SE Asia Standard Time

Báo cáo kết quả.
---------------
Mà nên thỉnh thoảng đổi món chút đi. Phở dĩ nhiên là ngon rồi nhưng phở mãi mà không nhớ "cơm" đang đau đáu đợi à?

Thật ra trước khi hỏi thì em đã thí nghiệm "tè lè" rồi (bởi vậy em mới hỏi đích danh timedate.cpl)
Không biết trên Windows XP chạy thế nào chứ còn Windows 7 thì nó cứ trơ trơ ra tại cửa sổ Date and Time (mà chẳng set cái gì cả)
------------------------------

siwtom đã viết:
Tuấn có vẻ không khoái API "nhể".

Em vẫn khoái API chứ anh, nhưng nếu có món nào đó làm được từ command prompt mà lại "cực ngắn" thì em vẫn khoái hơn
Ẹc... Ẹc...

siwtom · 22/1/13

ndu96081631 đã viết:
Thật ra trước khi hỏi thì em đã thí nghiệm "tè lè" rồi (bởi vậy em mới hỏi đích danh timedate.cpl)
Không biết trên Windows XP chạy thế nào chứ còn Windows 7 thì nó cứ trơ trơ ra tại cửa sổ Date and Time (mà chẳng set cái gì cả)

Mã:

sComm = "cmd.exe /c rundll32.exe shell32.dll,Control_RunDLL timedate.cpl,,/Z SE Asia Standard Time"
  CreateObject("WScript.Shell").Run sComm, 0, True

Nhưng đã rundll32.exe thì thôi bỏ cmd.exe

Mã:

sComm = "rundll32.exe shell32.dll,Control_RunDLL timedate.cpl,,/Z SE Asia Standard Time"
CreateObject("WScript.Shell").Run sComm, 0, True

Tôi đã thử
1. Cả 2 code chạy trên XP
2. Cả 2 code không chạy trên trên Win 7

Mà không chạy cũng đúng thôi. Cửa sổ trong Win 7 hoàn toàn khác so với trong XP
-----------------
Mà code của tôi cũng chỉ chạy trên XP. Buồn quá. Có khi phải thiết lập quyền

LienDong · 15/4/14

ndu96081631 đã viết:

Đúng rồi, ngày tháng hơi khó 1 chút vì phải xem Control Panel đang định dạng là d/M/y hay M/d/y
Giờ viết lại, Set cả ngày và giờ luôn nhé:

Mã:

Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Integer, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Integer, ByVal lpfnCB As Integer) As Integer
Private Declare Function DeleteUrlCacheEntry Lib "Wininet.dll" Alias "DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Integer

Mã:

Sub DownloadFile(ByVal sURL As String, ByVal FileName As String)
  DeleteUrlCacheEntry sURL
  URLDownloadToFile 0, sURL, FileName, 0, 0
End Sub

Mã:

Function InternetDateTime() As Double
  Dim sTmp As String, sURL As String, FileName As String
  Dim fso As Object, aTmp, Arr(1 To 2)
  sURL = "http://www.timeanddate.com/worldclock/city.html?n=95"
  Set fso = CreateObject("Scripting.FileSystemObject")
  FileName = fso.GetTempName
  DownloadFile sURL, FileName
  With fso.OpenTextFile(FileName, 1)
    sTmp = .ReadAll
    .Close
  End With
  Set fso = Nothing: Kill (FileName)
  sTmp = Mid(sTmp, InStr(1, sTmp, "Current Time"))
  sTmp = Mid(sTmp, 1, InStr(1, sTmp, "</strong>") - 1)
  sTmp = Mid(sTmp, InStr(1, sTmp, "big>") + 4)
  aTmp = Split(sTmp, " at ")
  Arr(2) = TimeValue(aTmp(1))
  sTmp = Trim(Replace(aTmp(0), ",", ""))
  aTmp = Split(sTmp, " ")
  Arr(1) = DateValue(aTmp(2) & "-" & aTmp(1) & "-" & aTmp(3))
  InternetDateTime = CLng(Arr(1)) + CDbl(Arr(2))
End Function

Mã:

Sub Main()
  Dim sComm As String, sTime As String, sDate As String, sFormat As String
  Dim dNow As Double
  dNow = InternetDateTime
  sTime = Format(dNow, "hh:mm:ss")
  Select Case Application.International(xlDateOrder)
    Case Is = 0: sFormat = "MM/dd/yyyy"
    Case Is = 1: sFormat = "dd/MM/yyyy"
    Case Is = 2: sFormat = "yyyy/MM/dd"
  End Select
  sDate = Format(dNow, sFormat)
  sComm = "cmd.exe /c Time " & sTime
  CreateObject("WScript.Shell").Run sComm, 0, True
  sComm = "cmd.exe /c Date " & sDate
  CreateObject("WScript.Shell").Run sComm, 0, True
End Sub

Hiện nay khi tôi chạy code trên thì báo lỗi "Subsript out of range" ở dòng
"Arr(2) = TimeValue(aTmp(1))"
Nhờ các bạn chỉ khắc phục lỗi. Xin cảm ơn

Hoàng Trọng Nghĩa · 15/4/14

LienDong đã viết:
Hiện nay khi tôi chạy code trên thì báo lỗi "Subsript out of range" ở dòng
"Arr(2) = TimeValue(aTmp(1))"
Nhờ các bạn chỉ khắc phục lỗi. Xin cảm ơn

Do biến sTmp nhận giá trị từ Internet như thế này:

sTmp = "thá»© ba 15 ThÃ¡ng tÆ° 2014 p. 11:00:02 CH"

Vì thế nó không thể tách chuỗi có " at " được:

aTmp = Split(sTmp, " at ")

Cho nên mảng aTmp sẽ có giá trị lần lượt là:

aTmp(0) = "thá»© ba 15 ThÃ¡ng tÆ° 2014 p. 11:00:02 CH"

aTmp(1) = Empty

aTmp(2) = Empty

Vì thế sẽ phát sinh ra lỗi tại:

Arr(2) = TimeValue(aTmp(1))

Với dòng chuỗi như thế, tôi cũng chẳng biết tách bắt đầu từ đâu.

siwtom · 16/4/14

Hoàng Trọng Nghĩa đã viết:
Do biến sTmp nhận giá trị từ Internet như thế này:

sTmp = "thá»© ba 15 ThÃ¡ng tÆ° 2014 p. 11:00:02 CH"

Vì thế nó không thể tách chuỗi có " at " được:

aTmp = Split(sTmp, " at ")

Cho nên mảng aTmp sẽ có giá trị lần lượt là:

aTmp(0) = "thá»© ba 15 ThÃ¡ng tÆ° 2014 p. 11:00:02 CH"

aTmp(1) = Empty

aTmp(2) = Empty

Vì thế sẽ phát sinh ra lỗi tại:

Arr(2) = TimeValue(aTmp(1))

Với dòng chuỗi như thế, tôi cũng chẳng biết tách bắt đầu từ đâu.

Không phải là

Mã:

aTmp(1) = Empty
aTmp(2) = Empty

Khi không có " at " thì aTmp chỉ có 1 phần tử là aTmp(0)

Không có phần tử aTmp(1), aTmp(2) chứ không phải chúng là Empty. Nếu chúng là Empty thì có nghĩa là dòng code

Mã:

If IsEmpty(aTmp(1)) then ...

không có lỗi

Đằng này là có lỗi.

Vì LBound(aTmp) = UBound(aTmp) = 0 nên khi truy cập tới phần tử có chỉ số 1 và 2 sẽ gây lỗi "Subsript out of range"

Range ở đây là 0 - 0, vậy 1 và 2 nằm ngoài Range
-------------
Cái " at " không phải bao giờ cũng thế.

Mà bạn có "thá»© ba 15 ThÃ¡ng tÆ° 2014 p. 11:00:02 CH" nhưng tôi có

Current Time</th><td><strong id=ct class=big>sroda 16 kwiecien 2014 03:41:15</strong>

tức sTmp = "sroda 16 kwiecien 2014 03:41:15"

Thế này thì chịu rồi. Vì chuỗi có thể rất khác nhau tùy system và tùy thiết lập, vd. kiểu 24 hay 12 giờ.
Với chuỗi như thế thì không làm được gì.

TranThanhPhong · 16/4/14

Anh chị kiểm tra thủ tục sau giúp.

[GPECODE=vba]Sub GetiNetTime()

Dim ws
Dim http
Dim GMT_Time, NewNow, NewDate, NewTime, Hr, Mn, Sc
Dim sComm As String

Const GMTTime As String = "http://wwp.greenwichmeantime.com/time/scripts/clock-8/runner.php?tz=gmt"

On Error Resume Next
Set http = CreateObject("Microsoft.XMLHTTP")

http.Open "GET", GMTTime & Now(), False, "", ""
http.send

GMT_Time = http.getResponseHeader("Date")
GMT_Time = Mid$(GMT_Time, 6, Len(GMT_Time) - 9)

Hr = 7 'Hours.
Mn = 0 'Minutes.
Sc = 0 'Seconds.

NewNow = DateAdd("h", Hr, GMT_Time) 'Adding 7 Hours to GMT.
NewNow = DateAdd("n", Mn, NewNow) 'Adding 0 Minutes to GMT.
NewNow = DateAdd("s", Sc, NewNow) 'Adding 0 Seconds to GMT.

MsgBox "Current Date & Time is: SE Asia Standard time " & NewNow, vbOKOnly, "GetiNetTime"

'Thay TimeZone và ngày giờ
Set ws = CreateObject("WScript.Shell")
NewDate = DateValue(NewNow)
NewTime = Format(TimeValue(NewNow), "hh:mm:ss")

sComm = "cmd.exe /c TZUTIL /s ""SE Asia Standard time"""
ws.Run sComm, 0, True

ws.Run "%comspec% /c time " & NewTime, 0
ws.Run "%comspec% /c date " & NewDate, 0
Set ws = Nothing

Set http = Nothing

End Sub[/GPECODE]

Nguồn tại đây

Thanh Phong

Hoàng Trọng Nghĩa · 16/4/14

TranThanhPhong đã viết:
Anh chị kiểm tra thủ tục sau giúp.

[GPECODE=vba]Sub GetiNetTime()

Dim ws
Dim http
Dim GMT_Time, NewNow, NewDate, NewTime, Hr, Mn, Sc
Dim sComm As String

Const GMTTime As String = "http://wwp.greenwichmeantime.com/time/scripts/clock-8/runner.php?tz=gmt"

On Error Resume Next
Set http = CreateObject("Microsoft.XMLHTTP")

http.Open "GET", GMTTime & Now(), False, "", ""
http.send

GMT_Time = http.getResponseHeader("Date")
GMT_Time = Mid$(GMT_Time, 6, Len(GMT_Time) - 9)

Hr = 7 'Hours.
Mn = 0 'Minutes.
Sc = 0 'Seconds.

NewNow = DateAdd("h", Hr, GMT_Time) 'Adding 7 Hours to GMT.
NewNow = DateAdd("n", Mn, NewNow) 'Adding 0 Minutes to GMT.
NewNow = DateAdd("s", Sc, NewNow) 'Adding 0 Seconds to GMT.

MsgBox "Current Date & Time is: SE Asia Standard time " & NewNow, vbOKOnly, "GetiNetTime"

'Thay TimeZone và ngày giờ
Set ws = CreateObject("WScript.Shell")
NewDate = DateValue(NewNow)
NewTime = Format(TimeValue(NewNow), "hh:mm:ss")

sComm = "cmd.exe /c TZUTIL /s ""SE Asia Standard time"""
ws.Run sComm, 0, True

ws.Run "%comspec% /c time " & NewTime, 0
ws.Run "%comspec% /c date " & NewDate, 0
Set ws = Nothing

Set http = Nothing

End Sub[/GPECODE]

Nguồn tại đây

Thanh Phong

Lẽ ra câu này:

MsgBox "Current Date & Time is: SE Asia Standard time " & NewNow, vbOKOnly, "GetiNetTime"

Phải để ở dòng cuối cùng. Lý do là nếu cứ chờ đợi lâu cho việc đọc và bấm OK thì đã mất đi "vài giây" hoặc lâu hơn nữa nếu ta không bấm OK, như thế thì cập nhật chưa sát giờ thực sự.

Nhưng code trên chạy rất chính xác.

Hoàng Trọng Nghĩa · 16/4/14

Dựa vào code của TranThanhPhong, tôi làm một file có đuôi *.vbs để chạy trực tiếp khi click vào, nhưng nó bị báo lỗi như thế này:

Xin vui lòng cho hỏi tại sao nó bị lỗi như thế ạ? Làm ơn khắc phục lỗi dùm ạ.

Cám ơn rất nhiều.

VetMini · 16/4/14

Xoá bỏ các khoảng đi sau As...
VBScript là ngôn ngữ script. Nó luôn luôn dùng kiểu Variant. Vì vậy chỉ cần Dim abc thôi chứ không cần As

Hoàng Trọng Nghĩa · 16/4/14

Hoàng Trọng Nghĩa đã viết:
Lẽ ra câu này:

MsgBox "Current Date & Time is: SE Asia Standard time " & NewNow, vbOKOnly, "GetiNetTime"

Phải để ở dòng cuối cùng. Lý do là nếu cứ chờ đợi lâu cho việc đọc và bấm OK thì đã mất đi "vài giây" hoặc lâu hơn nữa nếu ta không bấm OK, như thế thì cập nhật chưa sát giờ thực sự.

Nhưng code trên chạy rất chính xác.

Làm như code này chỉ chạy đúng trên WinXP chứ không có tác dụng với Win7 hay sao đó mà chạy nó không thay đổi gì đến ngày và giờ hệ thống. Các bạn kiểm tra lại xem sao!

siwtom · 16/4/14

Hoàng Trọng Nghĩa đã viết:
Làm như code này chỉ chạy đúng trên WinXP chứ không có tác dụng với Win7 hay sao đó mà chạy nó không thay đổi gì đến ngày và giờ hệ thống. Các bạn kiểm tra lại xem sao!

Tôi không có Win 7 để test nhưng ...
Code đọc được giờ GMT nhưng với dạng như hiện nay thì nếu trong CP chọn nước <> Anh thì
NewNow = 00:00:00
Phải lọc ngày, giờ từ GMT bằng cách khác.

Hoàng Trọng Nghĩa · 17/4/14

siwtom đã viết:
Tôi không có Win 7 để test nhưng ...
Code đọc được giờ GMT nhưng với dạng như hiện nay thì nếu trong CP chọn nước <> Anh thì
NewNow = 00:00:00
Phải lọc ngày, giờ từ GMT bằng cách khác.

Em không biết có đúng không, nếu nước Anh bắt đầu từ 0 giờ thì chỗ này sửa lại:

Thay vì:

Hr = 7 'Hours.

Thì:

Hr = 0 'Hours.

Hoàng Trọng Nghĩa · 17/4/14

VetMini đã viết:
Xoá bỏ các khoảng đi sau As...
VBScript là ngôn ngữ script. Nó luôn luôn dùng kiểu Variant. Vì vậy chỉ cần Dim abc thôi chứ không cần As

Không biết sao, sau khi anh hướng dẫn thì không còn lỗi nữa, click vào nó chạy nhưng không thực thi lệnh, cũng không thông báo gì cả! Có gì sai trong đó không nữa!

TranThanhPhong · 17/4/14

Hoàng Trọng Nghĩa đã viết:
Không biết sao, sau khi anh hướng dẫn thì không còn lỗi nữa, click vào nó chạy nhưng không thực thi lệnh, cũng không thông báo gì cả! Có gì sai trong đó không nữa!

Máy anh Nghĩa chạy có nằm trong Domain Cty không? Quyền của user chạy như thế nào?

Em nghĩ là user không đủ quyền để thay đổi thông tin hệ thống.

EM đã test thủ tục đó trong Win XP, Win7 và Win8 đều chạy tốt (thiết lập CP là English như anh siwtom đã lưu ý). Cũng có thể dùng mẹo nhỏ bắt Excel xử lý ngày tháng giúp ta (ghi giá trị GMT_Time nhận được và 1 cell nào đó rồi đọc lại giá trị trong cell đó vào thủ tục) rồi hãy cho vào thủ tục chạy thì khỏi sợ thiết lập hệ thống.

Thanh Phong

siwtom · 17/4/14

Hoàng Trọng Nghĩa đã viết:
Em không biết có đúng không, nếu nước Anh bắt đầu từ 0 giờ thì chỗ này sửa lại:

Thay vì:

Hr = 7 'Hours.

Thì:

Hr = 0 'Hours.

Vấn đề không phải ở chỗ đó.
Giờ VN = giờ GMT + 7. Ở nơi khác có thể là giờ = giờ GMT + 5. Chuyện sửa dòng

Mã:

Hr = 7

thành

Mã:

Hr = 5

là chuyện đương nhiên. Nhưng vấn đề không nằm ở chỗ đó. Nếu không sửa thì cùng lắm là cho kết quả y như giờ VN. Đằng này là ta nhận được 00:00:00.

Theo tôi nguyên nhân là cách thức hoạt động của hàm thời gian.

Chuỗi mà ta nhận được từ trang web luôn luôn là tiếng Anh ở dạng

Mã:

17 Apr 2014 08:12:52

Với những chuỗi dạng đó thì DateAdd("h", Hr, GMT_Time) trả về Empty nếu chọn trong CP <> Anh. Vì thế cuối cùng ta có NewNow = "00:00:00"

Kết luận: nếu ta có trong CP thiết lập cho nước XYZ và dạng ngày tháng dài là 17 *** 2014, trong đó *** là tên tháng bằng tiếng XYZ thì DateAdd("h", Hr, "chuỗi hic hic") trả về giá trị đúng khi và chỉ khi "chuỗi hic hic" có dạng "ab *** cdef" mà trong đó *** là bằng tiếng XYZ.

Nói cách khác thì DateAdd thao tác dựa trên thiết lập trong CP. Chuỗi truyền vào DateAdd phải có dạng ngày tháng y như được thiết lập trong CP. Nếu chuỗi truyền vào có dạng khác với dạng có trong CP thì kết quả trả về là Empty.

Thực ra cũng nên chú ý.
Ví dụ tôi chọn Pháp trong CP thì rõ ràng tôi nhìn thấy ở máy mình là "jeudi 17 avril 2014 08:12:52"

Nếu tôi cho thêm 1 dòng

Mã:

GMT_Time = "jeudi 17 avril 2014 08:12:52"

sau dòng

Mã:

GMT_Time = Mid$(GMT_Time, 6, Len(GMT_Time) - 9)

thì sau khi thực hiện

Mã:

NewNow = DateAdd("h", hr, GMT_Time)

tôi có NewNow = Empty

Nhưng nếu sửa thành

Mã:

GMT_Time = "17 avril 2014 08:12:52"

tức bỏ "jeudi" thì NewNow = "17/04/2014 15:12:52"

Vậy chuỗi truyền vào DateAdd không hẳn là y như trong CP. Nó chỉ có dạng "ngay ten_thang nam" (???). Chứ không có kiểu "gi_do ngay ten_thang nam"

Hoàng Trọng Nghĩa · 17/4/14

TranThanhPhong đã viết:
Máy anh Nghĩa chạy có nằm trong Domain Cty không? Quyền của user chạy như thế nào?

Em nghĩ là user không đủ quyền để thay đổi thông tin hệ thống.

EM đã test thủ tục đó trong Win XP, Win7 và Win8 đều chạy tốt (thiết lập CP là English như anh siwtom đã lưu ý). Cũng có thể dùng mẹo nhỏ bắt Excel xử lý ngày tháng giúp ta (ghi giá trị GMT_Time nhận được và 1 cell nào đó rồi đọc lại giá trị trong cell đó vào thủ tục) rồi hãy cho vào thủ tục chạy thì khỏi sợ thiết lập hệ thống.

Thanh Phong

WinXP tại cơ quan thì chạy tốt, riêng laptop của anh xài Win7 Ultimate Service Pack 1 thì chạy code đó không có một tác dụng nào cả!

siwtom · 19/4/14

Hoàng Trọng Nghĩa đã viết:
WinXP tại cơ quan thì chạy tốt, riêng laptop của anh xài Win7 Ultimate Service Pack 1 thì chạy code đó không có một tác dụng nào cả!

Bạn nói "chạy tốt" thì tôi thấy lạ.
Để hiểu nhau ta cần nói rõ là có 2 việc. Thứ nhất là chỉnh thời gian, và việc kia là thiết lập múi giờ. Bạn hãy làm thời gian sai đi và cũng chọn múi giờ khác rồi chạy code xem múi giờ có thay đổi không.

Vì khi tôi chạy code trên XP của tôi thì múi giờ không đổi. Cũng dễ hiểu thôi vì trong code có

Mã:

sComm = "cmd.exe /c [B][COLOR=#ff0000]TZUTIL[/COLOR][/B] /s ""SE Asia Standard time"""

mà XP không có tập tin TZUTIL.EXE (trong thư mục System32). Trong Windows 7 có tập tin tzutil.exe nên code trên chạy trong Windows 7.

Hay XP của tôi không có tzutil.exe vì nó là Home Edition?

Bạn viết "WinXP tại cơ quan thì chạy tốt" là do bạn chỉ để ý tới thời gian hay đúng là cả múi giờ (trước khi chạy code thì chọn múi giờ khác) cũng thay đổi?

Hoàng Trọng Nghĩa · 19/4/14

siwtom đã viết:
Bạn nói "chạy tốt" thì tôi thấy lạ.
Để hiểu nhau ta cần nói rõ là có 2 việc. Thứ nhất là chỉnh thời gian, và việc kia là thiết lập múi giờ. Bạn hãy làm thời gian sai đi và cũng chọn múi giờ khác rồi chạy code xem múi giờ có thay đổi không.

Vì khi tôi chạy code trên XP của tôi thì múi giờ không đổi. Cũng dễ hiểu thôi vì trong code có

Mã:

sComm = "cmd.exe /c [B][COLOR=#ff0000]TZUTIL[/COLOR][/B] /s ""SE Asia Standard time"""

mà XP không có tập tin TZUTIL.EXE (trong thư mục System32). Trong Windows 7 có tập tin tzutil.exe nên code trên chạy trong Windows 7.

Hay XP của tôi không có tzutil.exe vì nó là Home Edition?

Bạn viết "WinXP tại cơ quan thì chạy tốt" là do bạn chỉ để ý tới thời gian hay đúng là cả múi giờ (trước khi chạy code thì chọn múi giờ khác) cũng thay đổi?

Thật ra em cũng không đi sâu vào múi giờ cho lắm, máy cài sẳn giờ Việt Nam, rồi em chỉnh lại lệch ngày và lệch giờ rồi chạy code, sau đó thấy nó trở lại đúng thời gian là OK rồi Thầy ơi.

siwtom · 20/4/14

Tôi sửa lại code bài #28 như sau. Bạn nào test thì xin cho biết kết quả. Chỉ xét Windows >= XP

code

Mã:

Sub SetDateTimeFormNet(ByVal zone_offset As Long, ByVal zone_name As String)
Dim GMT_Time As String, currDateTime As String, currDate As Date, currTime As Date
Dim http As Object, shell As Object, sCmd As String, sMonth, s As String, index As Long
 
Const GMTTime As String = "http://wwp.greenwichmeantime.com/time/scripts/clock-8/runner.php?tz=gmt"
sMonth = Array("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")

On Error Resume Next

    s = Application.OperatingSystem
    index = InStr(1, s, "NT")
    If index > 0 Then index = Mid(s, index + 3, 1)
    If index > 5 Then
        sCmd = "cmd.exe /c TZUTIL /s " & zone_name
    ElseIf index = 5 Then
        sCmd = "cmd.exe /c rundll32.exe shell32.dll,Control_RunDLL timedate.cpl,,/Z " & zone_name
    Else
        Exit Sub
    End If
    
    Set shell = CreateObject("WScript.Shell")
    shell.Run sCmd, 0, True
    
    Set http = CreateObject("Microsoft.XMLHTTP")
     
    http.Open "GET", GMTTime & Now(), False, "", ""
    http.send
     
    GMT_Time = http.getResponseHeader("Date")
    
    GMT_Time = Mid$(GMT_Time, 6, Len(GMT_Time) - 9)
    For index = 0 To 11
        s = Mid(GMT_Time, 3, 5)
        If InStr(1, s, sMonth(index)) > 0 Then
            GMT_Time = Replace(GMT_Time, s, Application.International(xlDateSeparator) & _
                                        Format(index + 1, "00") & Application.International(xlDateSeparator))
            Exit For
        End If
    Next
     
    currDateTime = DateAdd("h", zone_offset, GMT_Time)
    currDate = DateValue(currDateTime)
    currTime = Format(TimeValue(currDateTime), "hh:mm:ss")
    
    shell.Run "%comspec% /c time " & currTime, False
    shell.Run "%comspec% /c date " & currDate, False
    
    Set shell = Nothing
    Set http = Nothing
End Sub

Gọi cho Việt Nam

Mã:

SetDateTimeFormNet 7, "SE Asia Standard Time"

Hoàng Trọng Nghĩa · 20/4/14

siwtom đã viết:
Gọi cho Việt Nam

Mã:

SetDateTimeFormNet 7, "SE Asia Standard Time"

Không biết có phải laptop của em "miễn nhiễm" với code can thiệp thời gian hay sao mà code nào cũng không tác dụng can thiệp vào ngày giờ hệ thống, chỉ chỉnh được bằng tay thôi.

siwtom · 20/4/14

Hoàng Trọng Nghĩa đã viết:
Không biết có phải laptop của em "miễn nhiễm" với code can thiệp thời gian hay sao mà code nào cũng không tác dụng can thiệp vào ngày giờ hệ thống, chỉ chỉnh được bằng tay thôi.

Code cũ có 2 vấn đề: thiết lập ngày giờ sai nếu trong CP chọn <> Anh, và nếu khi chuyển hđh thì phải sửa code. Vì sao?

Vì

Mã:

sCmd = "cmd.exe /c TZUTIL /s " & zone_name

chỉ chạy trên Win 7 còn

Mã:

sCmd = "cmd.exe /c rundll32.exe shell32.dll,Control_RunDLL timedate.cpl,,/Z " & zone_name

chỉ chạy trên XP. Như thế thì rất rách việc. Nhiều khi tập tin có code ta chuyển cho đồng nghiệp, đối tác thì chả nhẽ lại giải thích cho họ: anh sửa "chỗ này chỗ này"?

Tôi sửa chỉ với 2 mục đích trên. Bạn chuyển hđh qua lại nhưng không phải sửa vì sau khi hỏi tôi mới biết là bạn không quan tâm tới múi giờ.

Còn về vấn đề của bạn thì bạn thì gõ trực tiếp trong dòng lệnh

Mã:

time 07:35:22 --> ENTER

và xem giờ có đổi không và có thông báo gì trong dòng lệnh không. Tương tự cho date.

Hoàng Trọng Nghĩa · 20/4/14

siwtom đã viết:
Còn về vấn đề của bạn thì bạn thì gõ trực tiếp trong dòng lệnh

Mã:

time 07:35:22 --> ENTER

và xem giờ có đổi không và có thông báo gì trong dòng lệnh không. Tương tự cho date.

Em đã từng gõ vào Immediate:

date = #20/3/2014#

Nhưng nó báo lỗi:

Runtime Error '70':

Permission dinied

siwtom · 20/4/14

Hoàng Trọng Nghĩa đã viết:
Em đã từng gõ vào Immediate:

date = #20/3/2014#

Nhưng nó báo lỗi:

Runtime Error '70':

Permission dinied

Nếu là "Permission denied" thì rõ rồi. Nói chuyện mà cứ giấu thông tin thì mất thời gian lắm

Tôi không nghiên cứu Win 7 nhưng bạn có thể thử 1 trong 2 cách

1. Tắt UAC rồi chạy code
2. Chạy EXCEL với quyền của Administrator --> mở tập tin có code --> chạy code

Bởi nếu bạn thao tác trực tiếp trong dòng lệnh (tôi nghĩ bạn thao tác thử trực tiếp trong dòng lệnh cũng chả mất bao nhiêu thời gian) mà cũng không được thì ắt là do bị cấm.

Hoàng Trọng Nghĩa · 20/4/14

siwtom đã viết:
Nếu là "Permission denied" thì rõ rồi. Nói chuyện mà cứ giấu thông tin thì mất thời gian lắm

Tôi không nghiên cứu Win 7 nhưng bạn có thể thử 1 trong 2 cách

1. Tắt UAC rồi chạy code
2. Chạy EXCEL với quyền của Administrator --> mở tập tin có code --> chạy code

Bởi nếu bạn thao tác trực tiếp trong dòng lệnh (tôi nghĩ bạn thao tác thử trực tiếp trong dòng lệnh cũng chả mất bao nhiêu thời gian) mà cũng không được thì ắt là do bị cấm.

Em còn không biết nguyên do nữa Thầy ơi, làm sao mà giấu được, lúc Thầy hỏi mới chạy và thấy lỗi đó.

Em tắt UAC rồi chạy code thì đã OK rồi Thầy ơi.

trieubb · 15/8/18

ndu96081631 đã viết:

Đúng rồi, ngày tháng hơi khó 1 chút vì phải xem Control Panel đang định dạng là d/M/y hay M/d/y
Giờ viết lại, Set cả ngày và giờ luôn nhé:

Mã:

Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Integer, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Integer, ByVal lpfnCB As Integer) As Integer
Private Declare Function DeleteUrlCacheEntry Lib "Wininet.dll" Alias "DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Integer

Mã:

Sub DownloadFile(ByVal sURL As String, ByVal FileName As String)
  DeleteUrlCacheEntry sURL
  URLDownloadToFile 0, sURL, FileName, 0, 0
End Sub

Mã:

Function InternetDateTime() As Double
  Dim sTmp As String, sURL As String, FileName As String
  Dim fso As Object, aTmp, Arr(1 To 2)
  sURL = "http://www.timeanddate.com/worldclock/city.html?n=95"
  Set fso = CreateObject("Scripting.FileSystemObject")
  FileName = fso.GetTempName
  DownloadFile sURL, FileName
  With fso.OpenTextFile(FileName, 1)
    sTmp = .ReadAll
    .Close
  End With
  Set fso = Nothing: Kill (FileName)
  sTmp = Mid(sTmp, InStr(1, sTmp, "Current Time"))
  sTmp = Mid(sTmp, 1, InStr(1, sTmp, "</strong>") - 1)
  sTmp = Mid(sTmp, InStr(1, sTmp, "big>") + 4)
  aTmp = Split(sTmp, " at ")
  Arr(2) = TimeValue(aTmp(1))
  sTmp = Trim(Replace(aTmp(0), ",", ""))
  aTmp = Split(sTmp, " ")
  Arr(1) = DateValue(aTmp(2) & "-" & aTmp(1) & "-" & aTmp(3))
  InternetDateTime = CLng(Arr(1)) + CDbl(Arr(2))
End Function

Mã:

Sub Main()
  Dim sComm As String, sTime As String, sDate As String, sFormat As String
  Dim dNow As Double
  dNow = InternetDateTime
  sTime = Format(dNow, "hh:mm:ss")
  Select Case Application.International(xlDateOrder)
    Case Is = 0: sFormat = "MM/dd/yyyy"
    Case Is = 1: sFormat = "dd/MM/yyyy"
    Case Is = 2: sFormat = "yyyy/MM/dd"
  End Select
  sDate = Format(dNow, sFormat)
  sComm = "cmd.exe /c Time " & sTime
  CreateObject("WScript.Shell").Run sComm, 0, True
  sComm = "cmd.exe /c Date " & sDate
  CreateObject("WScript.Shell").Run sComm, 0, True
End Sub

bản WIN 64bit báo lỗi chỗ "Private Declare Function ..." anh ơi

trieubb · 17/8/18

lại lỗi dòng này
sTmp = Mid(sTmp, InStr(1, sTmp, "Current Time"))

Update ngày giờ của hệ thống qua Internet (1 người xem)

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

Giải pháp Ếc-xào

Huyền thoại GPE

File đính kèm

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

Huyền thoại GPE

File đính kèm

Giải pháp Ếc-xào

Huyền thoại GPE

Thành viên hoạt động

Huyền thoại GPE

Thành viên hoạt động

Thành viên hoạt động

Huyền thoại GPE

Giải pháp Ếc-xào

Thành viên gắn bó

Huyền thoại GPE

Thành viên hoạt động

Huyền thoại GPE

Thành viên gắn bó

Chuyên gia GPE

Huyền thoại GPE

Thành viên gắn bó

Huyền thoại GPE

Thành viên gắn bó

Huyền thoại GPE

Thành viên gắn bó

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

Chuyên gia GPE

Thành viên gắn bó

Ngày mai trời lại sáng!

Chuyên gia GPE

Chuyên gia GPE

File đính kèm

Đang đi tìm hòn đá

Chuyên gia GPE

Thành viên gắn bó

Chuyên gia GPE

Chuyên gia GPE

Ngày mai trời lại sáng!

Thành viên gắn bó

Chuyên gia GPE

Thành viên gắn bó

Chuyên gia GPE

Thành viên gắn bó

Chuyên gia GPE

Thành viên gắn bó

Chuyên gia GPE

Thành viên gắn bó

Chuyên gia GPE

Thành viên mới

Thành viên mới

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