Lấy ngày và thời gian của máy tính trong mạng nội bộ (LAN) (1 người xem)

[levanduyet]

Đang viết một chương trình quản lý, cần phải cập nhật thời gian. Không biết ở đâu có đoạn mã, lên diễn đàn nước ngoài hỏi, được một ví dụ khá là hay. Xin chia sẽ cùng các bạn

Có bao giờ các bạn dùng lệnh NET TIME \\<tên máy tính> để biết thời gian của máy tính trong mạng nội bộ chưa?

NET TIME \\<computername>

Tại sao phải lấy thời gian của máy tính khác?
Khi các bạn viết một ứng dụng trong đó có lưu lại các thao tác của người dùng. Bạn muốn biết người dùng đã Log-In vào Server mấy giờ? chẳng hạn. Lúc này các bạn sẽ cảm thấy sự hữu ích của vấn đề tôi nêu ra ở trên.

Sub GetServerTime() 
   ' This routine gets the time of another computer on a LAN and shows the output in Excel.
   ' Written by Rembo (http://scriptorium.serve-it.nl)
   '
' Create a batchfile called getservertime.bat with this content:
   '
   ' @echo off
   ' NET TIME \\[servername] > %1
   '
   ' and save in your Windows folder.
   ' Note that [servername] obviously has to be the name of the computer you query for the time
   Static sTimefile As String 
   sTimefile = Environ("TEMP") & "\servertime.txt" 
   ' Get the time on remote computer and store it in a textfile
   Call Shell(Environ("windir") & "\getservertime.bat " & sTimefile, vbHide) 
   'Wait 1 second for the file to be created
   Application.Wait (Now + TimeValue("0:00:01")) 
   ' Display output or do with it what you want.
   MsgBox dExtractDateTime(sGetText(sTimefile)) 
   ' Delete the file with the net time output
   Kill sTimefile 
End Sub 
Function sGetText(sFile As String) As String 
   ' This function reads the first line from a textfile and returns it as a string
   Dim lFilenum As Long 
   Dim sLine As String 
   lFilenum = FreeFile 
   Open sFile For Input As #lFilenum 
   If Not EOF(lFilenum) Then 
      Line Input #lFilenum, sGetText 
   Else 
      MsgBox ("Ohoh.. no file or file is empty") 
   End If 
   Close lFilenum 
End Function 
Function dExtractDateTime(sInput As String) As Date 
   ' Convert the date and time in string to date type
   ' This is a "dirty" fast way to do this but this might not work for all languages
   ' Adjust as needed
   Dim lDatestart As Long 
   Dim sDate As String, sTime As String 
   Dim dDate As Date, dTime As Date 
   lDatestart = InStr(Len(sInput) - 20, sInput, " ", vbTextCompare) 
   sInput = Right(sInput, Len(sInput) - lDatestart) 
   sDate = Left(sInput, InStr(1, sInput, " ", vbTextCompare) - 1) 
   sTime = Right(sInput, Len(sInput) - Len(sDate) - 1) 
   dExtractDateTime = CDate(sDate) + CDate(sTime) 
End Function

Tham khảo tại:
http://scriptorium.serve-it.nl/view.php?sid=58 http://www.puremis.net/excel/cgi-bin/yabb/YaBB.pl?num=1183700331

Lê Văn Duyệt

 

[thanhadm]

anh Duyệt có thế hướng dẫn kỹ hơn một chút không em copy đoạn code về nhưng dùng bị báo lỗi ở dòng
Call Shell(Environ("windir") & "\getservertime.bat " & sTimefile, vbHide)
em đang làm 1 file quản lý để cho người khác nhập dữ liệu vào có quy định về mặt thời gian tuy nhiên nếu họ thay đổi thời gian trên máy họ thì coi như hỏng. Thế nên em đang rất cần đoạn code có thể lấy được time của máy khác trong cùng mạng Lan