vb获取服务器时间

在窗体中建一个文本框和时间控件,可以在文本框中显示跳动的服务器时间

Private Sub Form_Load()

Timer1.Interval = 300

End Sub

Private Sub Timer1_Timer()

Dim cnn As New ADODB.Connection

Dim cmd As New ADODB.Command

Dim rst As New ADODB.Recordset

Dim Sqlser_time

cnn.ConnectionString = "driver={SQL Server}" &_

"server=serveruid=sapwd=database=master"

cnn.Open

cmd.ActiveConnection = cnn

cmd.CommandText = "SELECT GETDATE() AS sys_Sqlser_time"

Set rst = cmd.Execute

Sqlser_time = rst(0)

Text1.Text = Sqlser_time

rst.Close

cnn.Close

End Sub

VB：

response.write date()

SQL Server：

select CONVERT(varchar(10),getdate(), 120)

select CONVERT(varchar(100),getdate(), 23)

最简单的办法是用Shell调用NET TIME //<servername> 命令获得时间，你可以将输出重定向到一个文件，然后在VB读取这个文件以获得时间。 －－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－或者服务器上有SQL服务的话，可以：Set DbC = New ADODB.Connection

Dim adoDateTime As New ADODB.Recordset '获取 NT-SERVER 时间

With DbC

If .State = adStateOpen Then .Close

.CursorLocation = adUseClient

.ConnectionString = "DRIVER={MySQL ODBC 3.51 Driver}SERVER=" &Server &"UID=" &uID &"PWD=" &uPassword &"DATABASE=" &MyDatabase &"OPTION=1 + 2 + 8 + 32 + 2048 + 163841"

.ConnectionTimeout = 90

.Open

adoDateTime.Open "select now() as mysqlTime"

End With ————————————————————————————————————————————使用Windows API的NetRemoteTOD函数获得服务器的时间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 = 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("\\trademark")

MsgBox d

End Sub

---