Làm sao sử dụng lệnh Time trong CMD

[Quang_Hải]

Mình muốn thử code lấy ngày giờ từ Internet để cập nhật giờ hệ thống tự động.
Trong Win 7 hàm SetSystemTime của API không tác dụng nên mình viết thế này để dùng lệnh Time trong CMD, nhưng loay hoay mãi chưa code được

Option Explicit
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Sub TimeSetting()
ShellExecute 0, "runas", "cmd", Command, vbNullString, 1
End Sub
Function InternetTime(Optional GMT_Dif As Integer) As Date
    Dim ServerURL As String, Res As String, NetDate As String
    Dim NetTime As Date, LocalTime As Date
    ServerURL = "http://www.timeanddate.com/worldclock/fullscreen.html?n=2"
    With CreateObject("Microsoft.XMLHTTP")
      .Open "GET", ServerURL, 0, "", ""
      .Send
      If .ReadyState = 4 Then
         Res = .getResponseHeader("Date")
         Res = Mid(Res, 6, Len(Res) - 9)
         NetDate = Left(Res, Len(Res) - 9)
         NetTime = Right(Res, 8)
         LocalTime = NetTime + (GMT_Dif / 24)
         [A1] = DateValue(NetDate)
         [A2] = TimeValue(LocalTime)
      End If
   End With
End Function
Sub Auto_Open()
InternetTime (7)
TimeSetting
End Sub

 

[ndu96081631]

Mình muốn thử code lấy ngày giờ từ Internet để cập nhật giờ hệ thống tự động.
Trong Win 7 hàm SetSystemTime của API không tác dụng nên mình viết thế này để dùng lệnh Time trong CMD, nhưng loay hoay mãi chưa code được

Tôi làm thế này:
1> Hàm download file từ internet thông qua URL

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
Sub DownloadFile(ByVal sURL As String, ByVal fileName As String)
  DeleteUrlCacheEntry sURL
  URLDownloadToFile 0, sURL, fileName, 0, 0
End Sub

2> Hàm lấy giờ từ Internet

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")
  If fso.FileExists(fileName) Then
    With fso.OpenTextFile(fileName, 1)
      sTmp = .ReadAll
     [COLOR=#0000cd] sTmp = Mid(sTmp, InStr(1, sTmp, "<span id=ct class=h1>") + 21)
      sTmp = Mid(sTmp, 1, InStr(1, sTmp, "</span>") - 1)
      sTmp = Replace(Replace(sTmp, "SA", "AM"), "CH", "PM")[/COLOR]
      .Close
    End With
    InternetTime = Format(TimeValue(sTmp), "hh:mm:ss")
    Kill (fileName)
  End If
  Set fso = Nothing
End Function

3> Cài giờ vào hệ thống

Sub Main()
  Dim sComm As String, sTime As String
  sTime = InternetTime
  If Len(sTime) Then
    [COLOR=#ff0000]sComm = "cmd.exe /c Time " & sTime
    CreateObject("WScript.Shell").Run sComm, 0, True[/COLOR]
    MsgBox "SetTime Thành công"
  Else
    MsgBox "SetTime that bai"
  End If
End Sub

Chỗ màu đỏ là dùng CMD đấy
Lưu ý: đoạn xử lý text (màu xanh) đôi khi có sự thay đổi (bây giờ thế này nhưng năm sau có khi lại khác)

 

[Quang_Hải]

AloAlo, có anh em nào test hộ code bài số 2. Mình chạy code toàn là thông báo "Settime that bai"
Mình thử trực tiếp thế này cũng không ăn thua. Giờ hệ thống vẫn trơ trơ không nhúc nhích.
Mình đoán là Win 7 không chạy cmd bằng quyền Admin thì không thể dùng hàm Time được.

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

End Sub

 

[nmhung49]

AloAlo, có anh em nào test hộ code bài số 2. Mình chạy code toàn là thông báo "Settime that bai"
Mình thử trực tiếp thế này cũng không ăn thua. Giờ hệ thống vẫn trơ trơ không nhúc nhích.
Mình đoán là Win 7 không chạy cmd bằng quyền Admin thì không thể dùng hàm Time được.

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

End Sub

Set lại giờ hệ thống rồi chạy code giờ vẫn i nguyên cho dùng hiện thông báo thành công em kiểm tra win7 quyền admin (không phải đăng nhập với administator)

 

[ndu96081631]

AloAlo, có anh em nào test hộ code bài số 2. Mình chạy code toàn là thông báo "Settime that bai"
Mình thử trực tiếp thế này cũng không ăn thua. Giờ hệ thống vẫn trơ trơ không nhúc nhích.
Mình đoán là Win 7 không chạy cmd bằng quyền Admin thì không thể dùng hàm Time được.

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

End Sub

Set lại giờ hệ thống rồi chạy code giờ vẫn i nguyên cho dùng hiện thông báo thành công em kiểm tra win7 quyền admin (không phải đăng nhập với administator)

Vậy thì chắc liên quan đến UAC hay Admin gì gì đó...
Thế thì tôi không biết đâu... bị tôi chạy trên máy tôi nó.. phình phường... Ẹc... Ẹc...

 

[Quang_Hải]

Vậy thì chắc liên quan đến UAC hay Admin gì gì đó...
Thế thì tôi không biết đâu... bị tôi chạy trên máy tôi nó.. phình phường... Ẹc... Ẹc...

Em cũng đoán là trên máy anh chạy OK vì anh đã kiểm tra trước khi gởi bài rồi.
Trong lúc chờ đợi tìm phương án, tạm chạy code này rồi chỉnh thủ công

CreateObject("shell.application").settime