اعمل على نظام فيجول بسيك واريد احضار تاريخ السيرفر بدلا من تاريخ الجهاز في لاستخدامة في احد الفورمات
كيف يمكنى قراءة التاريخ من السيرفر
مغلق
هذا الكود المطلوب ولكنه لايعمل على 97
Option Explicit
Public Declare Function NetRemoteTOD Lib "Netapi32.dll" (ByVal yServer As Long, ByRef pBuffer As Long) As Long
Public Declare Sub CopyTimeValue Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, ByVal Source As Long, ByVal Length As Long)
Public Declare Function IsBadPointer Lib "kernel32" Alias "IsBadReadPtr" (ByVal lp As Long, ByVal ucb As Long) As Long
Public Declare Function NetApiBufferFree Lib "Netapi32.dll" (ByVal lpBuffer As Long) As Long
Private Type TIME_OF_DAY_INFO
TOD_ELAPSED 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 Const NERR_Succes = 0
Public Function GetServerDateTime(ServerName As String) As String
On Error GoTo GetServerDateTimeError
Dim TOD As TIME_OF_DAY_INFO
Dim MemoryPointer As Long
'check to make sure we have at least something
If Trim(ServerName) = vbNullString Then Exit Function
'make sure it address is good
If IsBadPointer(StrPtr(ServerName), Len(ServerName)) > 0 Then
'error reading memory address
Exit Function
End If
'Retrieve the servers date time
If NetRemoteTOD(StrPtr(ServerName), MemoryPointer) = NERR_Succes Then
'make sure we have valid data
If IsBadPointer(MemoryPointer, Len(TOD)) > 0 Then
'must be bad data
Exit Function
End If
'lets get the data into our udt so we can use it
Call CopyTimeValue(TOD, MemoryPointer, Len(TOD))
'now we have the date and time
GetServerDateTime = CStr(TOD.TOD_MONTH) & "/" & CStr(TOD.TOD_DAY) & "/" & CStr(TOD.TOD_YEAR) & " " & Format(TOD.TOD_HOURS, "00") & ":" & Format(TOD.TOD_MINS, "00") & ":" & Format(TOD.TOD_SECS, "00")
'but we must adjust for the time zone
GetServerDateTime = DateAdd("n", -1 * TOD.TOD_TIMEZONE, GetServerDateTime)
'now we need to free the memory allocated by the system
If Not NetApiBufferFree(MemoryPointer) = NERR_Succes Then
'bad news we have just created a memory leak. as long as this function is not call constantly it should not be that bad (Yeah right!)
Exit Function
End If
Else
'some error getting the time
Exit Function
End If
Exit Function
GetServerDateTimeError:
MsgBox Err.Description
End Function
تحياتي
من سار على الدرب وصل
هذا الموضوع مغلق.