如何用VB获取服务器的系统日期时间

zhuqingxipy 2003-09-16 02:30:11
如题
...全文
731 18 打赏 收藏 转发到动态 举报
写回复
用AI写文章
18 条回复
切换为时间正序
请发表友善的回复…
发表回复
射天狼 2003-09-19
  • 打赏
  • 举报
 回复
'取数据服务器当前时间
Public Function GetCurDate() As String
On Error Resume Next
Dim rs As New ADODB.Recordset

rs.Open "select GetDate() from USERPASSWORD", cn, adOpenKeyset, adLockReadOnly
If IsNull(rs.Fields(0).Value) Then
GetCurDate = Format$(Date, "yyyy/mm/dd hh:mm")
Else
GetCurDate = Format$(rs.Fields(0).Value, "yyyy/mm/dd hh:mm")
End If

rs.Close
Set rs = Nothing
End Function
现在还是人类 2003-09-19
  • 打赏
  • 举报
 回复
用NET命令显示服务器时间的具体方法

Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Const SYNCHRONIZE = &H100000
Private Const INFINITE = &HFFFF ' Infinite timeout
Private Sub Command1_Click()
Dim ServerTimeInfo As String, DOSCommand As String, ProcessID As Long, ShellID As Long
DOSCommand = "cmd /c net time \\" & ServerIP.Text & " >C:\Time.Txt"
ShellID = Shell(DOSCommand, vbHide)
ProcessID = OpenProcess(SYNCHRONIZE, False, ShellID)
WaitForSingleObject ProcessID, INFINITE
CloseHandle ProcessID
Open "C:\Time.Txt" For Input As #1
Line Input #1, ServerTimeInfo
Close #1
kill "C:\Time.Txt"
MsgBox ServerTimeInfo
End Sub
lxcc 2003-09-17
  • 打赏
  • 举报
 回复
唉!

shell "cmd /c net time \\机器名称>c:\time.txt"，然后分析time.txt
zhuqingxipy 2003-09-17
  • 打赏
  • 举报
 回复
C:>net time //IP地址

我怎样将它放入一个变量中
现在还是人类 2003-09-17
  • 打赏
  • 举报
 回复
Net命令可以实现
C:>net time //IP地址
viena 2003-09-17
  • 打赏
  • 举报
 回复
now函数
blasterboy 2003-09-17
  • 打赏
  • 举报
 回复
up
prok 2003-09-17
  • 打赏
  • 举报
 回复
up
flxa 2003-09-17
  • 打赏
  • 举报
 回复
可以!!!

up
liul17 2003-09-17
  • 打赏
  • 举报
 回复
用我上面的这个不就行了吗？
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:="不能得到远程机器时间"
End If
End Function

'要运行该程序，通过如下方式调用。
Private Sub Command1_Click()
Dim d As Date
d = getRemoteTOD("\\机器名称")
MsgBox d
End Sub
zhuqingxipy 2003-09-17
  • 打赏
  • 举报
 回复
shell "cmd /c net time \\机器名称>c:\time.txt"，然后分析time.txt
能不能解释一下这句代码吗，为什么出现文件没找到，我已建立了C:\time.txt,还有能不能不让出现MS-dos运行命令窗口
yoki 2003-09-16
  • 打赏
  • 举报
 回复
strSql="select convert(varchar(10),getdate(),120)as 日期,convert(varchar(13),getdate(),114) as 时间,getdate() as 日期时间"

rs.open strsql,cn,1,1
yijiansong 2003-09-16
  • 打赏
  • 举报
 回复
strSql="SELECT GETDATE() AS curDate"
rs.open strsql,cn,1,1
msgbox "" & rs("curDate")
zhuqingxipy 2003-09-16
  • 打赏
  • 举报
 回复
如果没有SQL Server且不用类似winsock那样的C/S结构,该怎么做？
lxcc 2003-09-16
  • 打赏
  • 举报
 回复
如果服务器上安装有SQLSERVER
那么执行
strSql="SELECT GETDATE() AS curDate"
rs.open strsql,cn,1,1
msgbox "" & rs("curDate")

以下两种方法要求OS为2K以上
如果没有还可以用
shell "cmd /c net time \\机器名称>c:\time.txt"，然后分析time.txt

或者用如下代码：
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("\\机器名称")
MsgBox d
End Sub
liul17 2003-09-16
  • 打赏
  • 举报
 回复
以上共两个获取方法
1。服务器上有 sqlserver
2。无sqlserver
liul17 2003-09-16
  • 打赏
  • 举报
 回复
也可通过 winsock 编写c/s程序来获得
liul17 2003-09-16
  • 打赏
  • 举报
 回复
Public adoCN As New ADODB.Connection '定义数据库的连接存放数据和代码

Public SqlCommand As New ADODB.Command '定义 SQL 命令

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

'***********************************************************************
'* 功能：与 SQL SERVER 数据库建立连接并取出服务器时间
'***********************************************************************
Public Function OpenConnection() As String '打开数据库
On Error GoTo SQLConErr
With adoCN
.CursorLocation = adUseClient
.Provider = "sqloledb"
.Properties("Data Source").Value = cNtServerName
.Properties("Initial Catalog").Value = cDatabaseName
.Properties("User ID") = cSQLUserName
.Properties("Password") = cSQLPassword
.Properties("prompt") = adPromptNever
.ConnectionTimeout = 15 '可以改这个时间
.Open

If .State = adStateOpen Then
adoDateTime.Open "select getdate()", adoCN, adOpenStatic, adLockOptimistic
cServerDate = Format(adoDateTime(0), "yyyy-mm-dd")
cServertime = Mid(adoDateTime(0), 10)
Else
MsgBox "数据库连接失败，请找系统管理员进行检查 ！", 16, cProgramName
End
End If
End With

SqlCommand.ActiveConnection = adoCN
SqlCommand.CommandType = adCmdText
Exit Function
SQLConErr:
Select Case Err.Number
Case -2147467259
MsgBox "找不到指定的SQL Server服务器或者数据库不存在，请重新设置！", vbExclamation
F_SetSystem.Show 1
Case -2147217843
MsgBox "指定的SQL Server数据库用户不存在或口令错误，请重新设置！", vbExclamation
F_SetSystem.Show 1
Case Else
MsgBox "数据环境连接失败，请找系统管理员进行检查 ！", 16, cProgramName
End Select
OpenConnection
End Function


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:="不能得到远程机器时间"
End If
End Function

'要运行该程序，通过如下方式调用。
Private Sub Command1_Click()
Dim d As Date
d = getRemoteTOD("\\机器名称")
MsgBox d
End Sub
获得服务器时间
获得服务器时间，VB6源代码，非常有用。
VB时间同步程序源代码
基于V的B时间同步程序源代码，可以让你的电脑同步时间服务器的标准时间，前提是你的电脑必需连入网络，这是一个同步时间的实例，或许在你编程某些软件的时候有用处！
VB管理信息系统开发实战
VB管理信息系统开发实战本系统以汽车报废回收系统为例，拆解厂 和 车管所 两种用户权限 实现汽车报废回收过程的信息管理，包含了打印报表的设计开发主要功能实现添加车辆、车辆查询、车辆送达、拆解、报废过程的处理，动态的打印报表设计车辆状态：未送达、已送达、已拆解、已报废 四种；
VB基础类

7,762

社区成员

197,608

社区内容

发帖
与我相关
我的任务
社区描述
VB 基础类
社区管理员
  • VB基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今

加载中

查看更多榜单
社区公告
暂无公告

试试用AI创作助手写篇文章吧

+ 用AI写文章