获取指定机器的系统时间

Question

各位前辈：    请教一下如何获取局域网内指定IP地址的机器的系统时间，并且使本机时间与指定IP地址的机器的系统时间一致，谢谢如我需要获取 192.168.0.110 工作组名: workgroup 机器上的系统时间

Answer 1

如果服务器有SQL数据库的话 用SQL语句
执行一句SQL select getdate() as time

Answer 2

Dim   conn   As   ADODB.Connection   
          Dim   rs   As   ADODB.Recordset   
            
          Set   conn   =   New   ADODB.Connection   
          conn.ConnectionString   =   "Provider=SQLOLEDB.1;Persist   Security   Info=False;User   ID=sa;Initial   Catalog=ttt;Data   Source=tiger"   
          conn.Open   
            
          Set   rs   =   New   ADODB.Recordset   
          rs.Open   "select   getdate()   as   fldTime",   conn   
            
          MsgBox   rs.Fields("fldtime")   
          MsgBox   Format(rs.Fields("fldtime"),   "hh:mm")   
          '取得后将这个值赋给本机时间就行了   
                    
          rs.Close   
          conn.Close   
            
          Set   rs   =   Nothing   
          Set   conn   =   Nothing   

Answer 3

Private Declare Function CreatePipe Lib "kernel32" (phReadPipe As Long, phWritePipe As Long, lpPipeAttributes As SECURITY_ATTRIBUTES, ByVal nSize As Long) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, ByVal lpBuffer As String, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Any) As Long
Private Type SECURITY_ATTRIBUTES
    nLength   As Long
    lpSecurityDescriptor   As Long
    bInheritHandle   As Long
End Type
Private Type STARTUPINFO
    cb   As Long
    lpReserved   As String
    lpDesktop   As String
    lpTitle   As String
    dwX   As Long
    dwY   As Long
    dwXSize   As Long
    dwYSize   As Long
    dwXCountChars   As Long
    dwYCountChars   As Long
    dwFillAttribute   As Long
    dwFlags   As Long
    wShowWindow   As Integer
    cbReserved2   As Integer
    lpReserved2   As Long
    hStdInput   As Long
    hStdOutput   As Long
    hStdError   As Long
End Type
Private Type PROCESS_INFORMATION
    hProcess   As Long
    hThread   As Long
    dwProcessId   As Long
    dwThreadId   As Long
End Type
Private Declare Function CreateProcessAsUser Lib "advapi32.dll" Alias "CreateProcessAsUserA" (ByVal hToken As Long, ByVal lpApplicationName As String, ByVal lpCommandLine As String, ByVal lpProcessAttributes As SECURITY_ATTRIBUTES, ByVal lpThreadAttributes As SECURITY_ATTRIBUTES, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As String, ByVal lpCurrentDirectory As String, ByVal lpStartupInfo As STARTUPINFO, ByVal lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function CreateProcessA Lib "kernel32" (ByVal lpApplicationName As Long, ByVal lpCommandLine As String, lpProcessAttributes As SECURITY_ATTRIBUTES, lpThreadAttributes As SECURITY_ATTRIBUTES, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Const NORMAL_PRIORITY_CLASS = &H20
Private Const STARTF_USESTDHANDLES = &H100
Private Const STARTF_USESHOWWINDOW = &H1
Private Const SW_HIDE = 0
Private Function ExecuteCommandLineOutput(CommandLine As String, Optional BufferSize As Long = 256, Optional TimeOut As Long) As String
   Dim Proc     As PROCESS_INFORMATION
   Dim Start     As STARTUPINFO
   Dim SA     As SECURITY_ATTRIBUTES
   Dim hReadPipe     As Long
   Dim hWritePipe     As Long
   Dim lBytesRead     As Long
   Dim sBuffer     As String
   If VBA.Len(CommandLine) > 0 Then
        SA.nLength = Len(SA)
        'SA.nLength   =   vba.Len(sa)
        SA.bInheritHandle = 1&
        SA.lpSecurityDescriptor = 0&
        If CreatePipe(hReadPipe, hWritePipe, SA, 0) > 0 Then
              Start.cb = Len(Start)
              Start.dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW
              Start.hStdOutput = hWritePipe
              Start.hStdError = hWritePipe
              Start.wShowWindow = SW_HIDE
              If CreateProcessA(0&, CommandLine, SA, SA, 1&, NORMAL_PRIORITY_CLASS, 0&, 0&, Start, Proc) = 1 Then
                    CloseHandle hWritePipe
                    sBuffer = VBA.String(BufferSize, VBA.Chr(0))
                    If TimeOut > 0 Then
                          Dim BeginTime     As Date
                          BeginTime = VBA.Now
                    End If
                    Do Until ReadFile(hReadPipe, sBuffer, BufferSize, lBytesRead, 0&) = 0
                          DoEvents
                          If TimeOut > 0 Then
                                If VBA.DateDiff("s", BeginTime, VBA.Now) > TimeOut Then
                                      ExecuteCommandLineOutput = "Timeout"
                                      Exit Do
                                End If
                          End If
                          ExecuteCommandLineOutput = ExecuteCommandLineOutput & VBA.Left(sBuffer, lBytesRead)
                    Loop
                    CloseHandle Proc.hProcess
                    CloseHandle Proc.hThread
                    CloseHandle hReadPipe
              Else
                  ExecuteCommandLineOutput = "File   or   command   not   found"
            End If
        Else
            ExecuteCommandLineOutput = "CreatePipe   failed.   Error:   " & Err.LastDllError & "."
        End If
   End If
End Function
Private Sub Command1_Click()       '测试
    Text1.Text = ExecuteCommandLineOutput("net   time   \\130.10.7.101")
    Text1.Text = Mid(Text1.Text, 23, Len(Text1.Text))
    Text1.Text = Format(Text1.Text, "YYYY-MM-DD hh:mm:ss")
    '修改系统时间用API函数SetSystemTime你自己看看吧
End Sub

Answer 4

感谢zzyong00 tianhuo_soft gyear  前辈指点

Answer 5

回去想了下,其实没有必要这么麻烦的,不好意思
Private Sub Command1_Click()
    Dim strCommand As String
    strCommand = "net time \\130.10.7.101 /set /y"
    Call Shell(strCommand)
End Sub