📄 时间同步.frm
字号:
VERSION 5.00
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 4995
ClientLeft = 3885
ClientTop = 2355
ClientWidth = 4140
LinkTopic = "Form1"
ScaleHeight = 4995
ScaleWidth = 4140
Begin VB.CommandButton Command10
Caption = "显示所有时间"
Height = 255
Left = 1320
TabIndex = 30
Top = 0
Width = 1335
End
Begin VB.CommandButton Command8
Caption = "时间"
Height = 255
Left = 3120
TabIndex = 26
Top = 2880
Width = 615
End
Begin VB.CommandButton Command7
Caption = "时间"
Height = 255
Left = 3120
TabIndex = 25
Top = 2520
Width = 615
End
Begin VB.CommandButton Command6
Caption = "时间"
Height = 255
Left = 3120
TabIndex = 24
Top = 2160
Width = 615
End
Begin VB.CommandButton Command5
Caption = "时间"
Height = 255
Left = 3120
TabIndex = 23
Top = 1800
Width = 615
End
Begin VB.CommandButton Command4
Caption = "时间"
Height = 255
Left = 3120
TabIndex = 22
Top = 1440
Width = 615
End
Begin VB.CommandButton Command3
Caption = "时间"
Height = 255
Left = 3120
TabIndex = 21
Top = 1080
Width = 615
End
Begin VB.CommandButton Command2
Caption = "时间"
Height = 255
Left = 3120
TabIndex = 20
Top = 720
Width = 615
End
Begin VB.Frame Frame1
Caption = "显示"
Height = 1215
Left = 240
TabIndex = 17
Top = 3480
Width = 3615
Begin VB.CommandButton Command9
Caption = "时间"
Height = 255
Left = 2760
TabIndex = 27
Top = 720
Width = 615
End
Begin VB.TextBox Text10
Height = 270
Left = 720
TabIndex = 19
Top = 720
Width = 1815
End
Begin VB.TextBox Text9
Height = 270
Left = 720
TabIndex = 18
Top = 240
Width = 2415
End
Begin VB.Label Label10
Caption = "时间:"
Height = 255
Left = 120
TabIndex = 29
Top = 720
Width = 495
End
Begin VB.Label Label9
Caption = "IP:"
Height = 255
Left = 360
TabIndex = 28
Top = 240
Width = 375
End
End
Begin VB.TextBox Text8
Height = 270
Left = 1080
TabIndex = 10
Top = 2880
Width = 1815
End
Begin VB.TextBox Text7
Height = 270
Left = 1080
TabIndex = 9
Top = 2520
Width = 1815
End
Begin VB.TextBox Text6
Height = 270
Left = 1080
TabIndex = 8
Top = 2160
Width = 1815
End
Begin VB.TextBox Text5
Height = 270
Left = 1080
TabIndex = 7
Top = 1800
Width = 1815
End
Begin VB.TextBox Text4
Height = 270
Left = 1080
TabIndex = 6
Top = 1440
Width = 1815
End
Begin VB.TextBox Text3
Height = 270
Left = 1080
TabIndex = 5
Top = 1080
Width = 1815
End
Begin VB.TextBox Text2
Height = 270
Left = 1080
TabIndex = 2
Top = 720
Width = 1815
End
Begin VB.TextBox Text1
Height = 270
Left = 1080
TabIndex = 1
Top = 360
Width = 1815
End
Begin VB.CommandButton Command1
Caption = "时间"
Height = 255
Left = 3120
TabIndex = 0
Top = 360
Width = 615
End
Begin VB.Label Label8
Caption = "Z7机:"
Height = 255
Left = 240
TabIndex = 16
Top = 2880
Width = 615
End
Begin VB.Label Label7
Caption = "Z6机:"
Height = 255
Left = 240
TabIndex = 15
Top = 2520
Width = 615
End
Begin VB.Label Label6
Caption = "Z5机:"
Height = 255
Left = 240
TabIndex = 14
Top = 2160
Width = 615
End
Begin VB.Label Label5
Caption = "Z4机:"
Height = 255
Left = 240
TabIndex = 13
Top = 1800
Width = 615
End
Begin VB.Label Label4
Caption = "Z3机:"
Height = 255
Left = 240
TabIndex = 12
Top = 1440
Width = 615
End
Begin VB.Label Label3
Caption = "Z2机:"
Height = 255
Left = 240
TabIndex = 11
Top = 1080
Width = 615
End
Begin VB.Label Label2
Caption = "Z1机:"
Height = 255
Left = 240
TabIndex = 4
Top = 720
Width = 615
End
Begin VB.Label Label1
Caption = "JF机:"
Height = 255
Left = 240
TabIndex = 3
Top = 360
Width = 495
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function NetRemoteTOD Lib "Netapi32.dll" ( _
tServer As Any, pBuffer As Long) As Long
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(32) As Integer
StandardDate As SYSTEMTIME
StandardBias As Long
DaylightName(32) As Integer
DaylightDate As SYSTEMTIME
DaylightBias As Long
End Type
Private Declare Function GetTimeZoneInformation Lib "kernel32" (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long
Private Declare Function NetApiBufferFree Lib "Netapi32.dll" (ByVal lpBuffer As Long) As Long
'
Private Type TIME_OF_DAY_INFO
tod_elapsedt As Long
tod_msecs As Long
tod_hours As Long
tod_mins As Long
tod_secs As Long
tod_hunds As Long
tod_timezone As Long
tod_tinterval As Long
tod_day As Long
tod_month As Long
tod_year As Long
tod_weekday As Long
End Type
'
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Function getRemoteTOD(ByVal strServer As String) As Date
Dim result As Date
Dim lRet As Long
Dim tod As TIME_OF_DAY_INFO
Dim lpbuff As Long
Dim tServer() As Byte
tServer = strServer & vbNullChar
lRet = NetRemoteTOD(tServer(0), lpbuff)
If lRet = 53 Then
Exit Function
End If
If lRet = 0 Then
CopyMemory tod, ByVal lpbuff, Len(tod)
NetApiBufferFree lpbuff
result = DateSerial(tod.tod_year, tod.tod_month, tod.tod_day) + _
TimeSerial(tod.tod_hours, tod.tod_mins - tod.tod_timezone, tod.tod_secs)
getRemoteTOD = result
Else
Err.Raise Number:=vbObjectError + 1001, _
Description:="cannot get remote TOD"
End If
End Function
'要运行该程序，通过如下方式调用。
Private Sub Command1_Click()
Dim d As Date
d = getRemoteTOD("\\jf")
Text1.Text = d
'MsgBox d
End Sub
Private Sub Command10_Click()
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
Text7.Text = ""
Text8.Text = ""
DoEvents
'Do Until Text8.Text = ""
'DoEvents
'Loop
Command1_Click
DoEvents
Command2_Click
DoEvents
Command3_Click
DoEvents
Command4_Click
DoEvents
Command5_Click
DoEvents
Command6_Click
DoEvents
Command7_Click
DoEvents
Command8_Click
End Sub
Private Sub Command2_Click()
Dim d As Date
d = getRemoteTOD("\\z1")
Text2.Text = d
End Sub
Private Sub Command3_Click()
Dim d As Date
d = getRemoteTOD("\\z2")
Text3.Text = d
End Sub
Private Sub Command4_Click()
Dim d As Date
d = getRemoteTOD("\\z3")
Text4.Text = d
End Sub
Private Sub Command5_Click()
Dim d As Date
d = getRemoteTOD("\\z4")
Text5.Text = d
End Sub
Private Sub Command6_Click()
Dim d As Date
d = getRemoteTOD("\\z5")
Text6.Text = d
End Sub
Private Sub Command7_Click()
Dim d As Date
d = getRemoteTOD("\\z6")
Text7.Text = d
End Sub
Private Sub Command8_Click()
Dim d As Date
d = getRemoteTOD("\\z7")
Text8.Text = d
End Sub
Private Sub Command9_Click()
Dim d As Date
d = getRemoteTOD("\\" & Text9.Text)
Text10.Text = d
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -