vb取服务器时间_vb获取系统时间

文章目录：

• 1、vb 获取网络时间较快的代码
• 2、VB如何“简单”获取网络时间？高手过来支两招。
• 3、VB实现服务器时间和本机时间同步
• 4、Vb.net 2008 如何获取网络时间
• 5、vb6.0如何获取sql server的时间？
• 6、用VB同步网络时间的程序，是获得北京时间，不是获得本地时间

vb 获取网络时间较快的代码

直接用vb转换GMT时间

Private Function getWebDatetime() As String

Dim XmlHttp As Object

Set XmlHttp = CreateObject("Microsoft.XMLHTTP")

XmlHttp.Open "POST", "", False

XmlHttp.send

getWebDatetime = CDate(1 / 3 + CDbl(CDate(Mid$(XmlHttp.getResponseHeader("Date"), 5, 21))))

Set XmlHttp = Nothing

End Function

扩展资料：

读取网站服务器返回的时间的代码

Private Function getWebDatetime() As String

Dim XmlHttp As Object, objJs As Object

Set XmlHttp = CreateObject("Microsoft.XMLHTTP")

XmlHttp.Open "POST", "", False

XmlHttp.send

Set objJs = CreateObject("msscriptcontrol.scriptcontrol")

objJs.Language = "jScript"

getWebDatetime = objJs.Eval("var dt = new Date('"  XmlHttp.getResponseHeader("Date")  "');var date = [  [dt.getFullYear(), dt.getMonth() + 1, dt.getDate()].join('-'),  [dt.getHours(), dt.getMinutes(), dt.getSeconds()].join(':')].join(' ').replace(/(?=\b\d\b)/g, '0');date;")

Set XmlHttp = Nothing

Set objJs = Nothing

End Function

VB如何“简单”获取网络时间？高手过来支两招。

最简单的办法是用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

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=server;uid=sa;pwd=;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.net 2008 如何获取网络时间

你是指Internet上的国际标准时间吗。

先加入控件 AxWinsock1 在.Com中Microsoft.Winsock

Public Class Form1

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Integer)

Dim NoSrv As Boolean

Dim TimeFromNet As String

Dim OldTime As Date

Dim NewTime As Date

Dim MyDate As Date

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

If AxWinsock1.CtlState MSWinsockLib.StateConstants.sckClosed Then AxWinsock1.Close()

AxWinsock1.Protocol = MSWinsockLib.ProtocolConstants.sckTCPProtocol

NetTime("") '首先取中科院国家授时中心时间

If NoSrv Or TimeFromNet = "" Then

NetTime("time.nist.gov") '取美国标准技时院时间

If NoSrv Or TimeFromNet = "" Then

MsgBox("检测不到网络标准时间服务器time.nist.gov！")

Else

NetTime("time.nist.gov")

If TimeFromNet = "" Then

MsgBox("网络标准时间服务器time.nist.gov超时！")

Else

MyDate = Mid(TimeFromNet, 8, 8)

OldTime = Mid(TimeFromNet, 17, 8)

NewTime = TimeSerial((Hour(OldTime) + 8) Mod 24, Minute(OldTime), Second(OldTime))

Dim MyTime As DateTime = MyDate Space(1) NewTime

MsgBox(MyTime)

'SetWindowsClock(MyTime)

End If

End If

Else

'使网络误差时间小，第2次再中科院国家授时中心时间

NetTime("")

If TimeFromNet = "" Then

MsgBox("网络标准时间服务器超时！")

Else

MyDate = Mid(TimeFromNet, 8, 8)

NewTime = Mid(TimeFromNet, 17, 8)

Dim MyTime As DateTime = MyDate Space(1) NewTime

MsgBox(MyTime)

'SetWindowsClock(MyTime)

End If

End If

End Sub

Private Sub NetTime(ByVal TimeSrv As String)

NoSrv = False

TimeFromNet = ""

If AxWinsock1.CtlState MSWinsockLib.StateConstants.sckClosed Then AxWinsock1.Close()

AxWinsock1.RemoteHost = TimeSrv ' "" 或 "time.nist.gov"

AxWinsock1.RemotePort = 13

AxWinsock1.LocalPort = 0

AxWinsock1.Connect()

Do While TimeFromNet = ""

If NoSrv Then Exit Do

Sleep(55)

System.Windows.Forms.Application.DoEvents()

Loop

If AxWinsock1.CtlState MSWinsockLib.StateConstants.sckClosed Then AxWinsock1.Close()

End Sub

Private Sub AxAxWinsock1_CloseEvent(ByVal sender As Object, ByVal e As System.EventArgs) Handles AxWinsock1.CloseEvent

AxWinsock1.Close()

End Sub

Private Sub AxAxWinsock1_DataArrival(ByVal sender As Object, ByVal e As AxMSWinsockLib.DMSWinsockControlEvents_DataArrivalEvent) Handles AxWinsock1.DataArrival

AxWinsock1.GetData(TimeFromNet)

End Sub

Private Sub AxAxWinsock1_Error(ByVal sender As Object, ByVal e As AxMSWinsockLib.DMSWinsockControlEvents_ErrorEvent) Handles AxWinsock1.Error

NoSrv = True

End Sub

End Class

vb6.0如何获取sql server的时间？

vb6.0如何获取sql server的时间？

"driver={SQL Server};server=你的服务名称;uid=登录账户;pwd=密码;database=数据库名称"

--模板

在server这里，如过你是本机，就可以用本机的IP、计算机名、127.0.0.1==

用VB同步网络时间的程序，是获得北京时间，不是获得本地时间

我的电脑主板有点问题,每次开机日期与时间都需要重新设定.很麻烦,只好开发了时间校正的程序,现在解决了日期与时间的问题.

只是:中国科学院国家授时中心

这两天不知道怎么回事,第一段代码无法正常获取服务器日期与时间了.只好更改为第二个方式,来获取日期与时间.但是开发完成后,360却提示有病毒呀.

'*******************************************************************************************************************

Private Sub GetDate_Timer()

'自动获取网络日期与时间

On Error GoTo Err_Load

Dim StrCoding As String

    StrCoding = Inet1.OpenURL(";quot;)

  Time0 = Right(Split(StrCoding, "年")(0), 4)  "年"  Split(Split(StrCoding, "年")(1), "日")(0)  "日"

    date0 = Left(Split(StrCoding, "var hrs = ")(1), 2)  ":"  Left(Split(StrCoding, "var min = ")(1), 2)  ":"  Left(Split(StrCoding, "var sec = ")(1), 2)

    Label1.Caption = "    中国地区标准时间："  Format(Time0, "yyyy年m月d日")  " "  Format(date0, "hh时mm分ss秒")

    Label2.Caption = "        本机系统时间："  Format(Date, "yyyy年m月d日")  " "  Format(Time, "hh时mm分ss秒")

'    MsgBox TypeName(Time0)'查询数据类型

    DoEvents    '转移控制权

   '自动校正

    If Check1.Item(0).Value = 1 Then

        Date = CDate(Time0)

        Time = CDate(date0)

        GetDate.Enabled = False

        Update.Interval = 1000

    End If

  If Check1.Item(2).Value = 1 Then

        Unload Me

    End If

Exit Sub

Err_Load:

If Err.Number  0 Then

    Select Case Err.Number

    Case 9

        Call MdlGetDate.StrIp(";quot;)

        Resume Next

    Case 364

        Resume Next

    Case Else

        MsgBox "错误代码："  Err.Number  "   错误描述："  Err.Description, vbExclamation, "获取网络日期"

    End Select

End If

End Sub