dcsimg
Results 1 to 8 of 8

Thread: [RESOLVED] NetRemoteTOD - Error or Timeout Function

  1. #1

    Thread Starter
    New Member
    Join Date
    Nov 2016
    Location
    Austria
    Posts
    8

    Resolved [RESOLVED] NetRemoteTOD - Error or Timeout Function

    Hy All

    I got a little Problem.
    I found the following code in the Net and it works fine.
    But i try to simulate a "Outage" of the Server or inserted a wrong server name in this case i can't find a way to handle this error an jump to a alternative Server.
    In each case the program doesnt respond anymore and crash

    Maybe somebody can help me.

    Code:
    Option Explicit
    
    'API Structures
    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
    
    'NetAPI Calls
    Public Declare Function NetRemoteTOD Lib "netapi32.dll" (yServer As Any, pBuffer As Long) As Long
    Private Declare Function NetApiBufferFree Lib "netapi32.dll" (ByVal pBuffer As Long) As Long
    'Kernel API Calls
    Private Declare Sub CopyMem Lib "kernel32.dll" Alias "RtlMoveMemory" (pTo As Any, uFrom As Any, ByVal lSize As Long)
    
    
    
    'Return the Time and Date of a specified Machine on the Net
    Public Function GetRemoteTime(servername As String) As Date
        Dim lpBuffer As Long
        Dim t_struct As TIME_OF_DAY_INFO
        Dim ret As Long
        Dim bServer() As Byte
        On Error GoTo Fehler
        
        If Trim(servername) = "" Then
            'Local machine
            ret = NetRemoteTOD(vbNullString, lpBuffer)
        Else
            'Check the syntax of the ServerName string
            If InStr(servername, "\\") = 1 Then
                bServer = servername & vbNullChar
            Else
                bServer = "\\" & servername & vbNullChar
            End If
            ret = NetRemoteTOD(bServer(0), lpBuffer)
        End If
        CopyMem t_struct, ByVal lpBuffer, Len(t_struct)
        If lpBuffer Then
            Call NetApiBufferFree(lpBuffer)
        End If
        GetRemoteTime = DateSerial(t_struct.tod_year, t_struct.tod_month, t_struct.tod_day) + TimeSerial(t_struct.tod_hours, t_struct.tod_mins - t_struct.tod_timezone, t_struct.tod_secs)
    
    Exit Function
    Fehler:
    error_logfile_schreiben (Err.Description & " Modul:Zeitserver Sub: GetRemoteTime")
    Resume Next
    End Function
    BR Fuchsi

  2. #2
    PowerPoster
    Join Date
    Feb 2012
    Location
    West Virginia
    Posts
    13,023

    Re: NetRemoteTOD - Error or Timeout Function

    Have you tried using break when the program seems to be hung to see which line it is hanging on?

    If not then try running the program in the IDE and trigger the problem. Hit the break key and it should bring up the code and show the execution point. Once it does this then hit F8 to see if the code moves to the next line. If it does then hit F8 again to single step through the code and see what is happening.

  3. #3

    Thread Starter
    New Member
    Join Date
    Nov 2016
    Location
    Austria
    Posts
    8

    Re: NetRemoteTOD - Error or Timeout Function

    Quote Originally Posted by DataMiser View Post
    Have you tried using break when the program seems to be hung to see which line it is hanging on?

    If not then try running the program in the IDE and trigger the problem. Hit the break key and it should bring up the code and show the execution point. Once it does this then hit F8 to see if the code moves to the next line. If it does then hit F8 again to single step through the code and see what is happening.

    Sorry for the late replay ->

    If i simulate a wrong/unavailable timesource the program crashes @
    Code:
    ret = NetRemoteTOD(bServer(0), lpBuffer)
    Is there any way to check in front the availability of the Timesource to avoid the program crash an use computertime in this case ?

    BR

  4. #4
    PowerPoster
    Join Date
    Feb 2012
    Location
    West Virginia
    Posts
    13,023

    Re: NetRemoteTOD - Error or Timeout Function

    Not clear from your response if you are talking about running the exe or running from the IDE.

  5. #5

    Thread Starter
    New Member
    Join Date
    Nov 2016
    Location
    Austria
    Posts
    8

    Re: NetRemoteTOD - Error or Timeout Function

    Quote Originally Posted by DataMiser View Post
    Not clear from your response if you are talking about running the exe or running from the IDE.
    I tryed it compiled as Exe and direct from VB6 IDE

  6. #6
    PowerPoster
    Join Date
    Feb 2012
    Location
    West Virginia
    Posts
    13,023

    Re: NetRemoteTOD - Error or Timeout Function

    Quote Originally Posted by slider83 View Post
    I tryed it compiled as Exe and direct from VB6 IDE
    And when you tried it directly from VB did you try using break and seeing what it was doing?

    I am also a bit confused when you say its not responding and crash. How long is it not responding before the crash and what is the error message or what happens when it crashes.

  7. #7
    PowerPoster
    Join Date
    Feb 2006
    Posts
    20,787

    Re: NetRemoteTOD - Error or Timeout Function

    You need to check the return value for success before trying to use the pointer. If the call fails the pointer is not assigned a value, so there is nothing to copy and calculate a TOD value from.

  8. #8

    Thread Starter
    New Member
    Join Date
    Nov 2016
    Location
    Austria
    Posts
    8

    Re: NetRemoteTOD - Error or Timeout Function

    Thanks @ All

    It was so easy

    Code:
    'Return the Time and Date of a specified Machine on the Net
    Public Function GetRemoteTime(servername As String) As Date
        Dim lpBuffer As Long
        Dim t_struct As TIME_OF_DAY_INFO
        Dim ret As Long
        Dim bServer() As Byte
        On Error GoTo Fehler
    Start:
        If Trim(servername) = "" Then
            'Local machine
            ret = NetRemoteTOD(vbNullString, lpBuffer)
            error_logfile_schreiben ("Zeitserver falsch oder nicht erreichbar")
            MsgBox "Zeitserver nicht erreichbar - lokale Zeit wird verwendet"
        Else
            'Check the syntax of the ServerName string
            If InStr(servername, "\\") = 1 Then
                bServer = servername & vbNullChar
            Else
                bServer = "\\" & servername & vbNullChar
            End If
            ret = NetRemoteTOD(bServer(0), lpBuffer)
        End If
        
        If ret = 0 Then
            CopyMem t_struct, ByVal lpBuffer, Len(t_struct)
            If lpBuffer Then
                Call NetApiBufferFree(lpBuffer)
            End If
            GetRemoteTime = DateSerial(t_struct.tod_year, t_struct.tod_month, t_struct.tod_day) + TimeSerial(t_struct.tod_hours, t_struct.tod_mins - t_struct.tod_timezone, t_struct.tod_secs)
        Else
            servername = ""
            GoTo Start
        End If

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Featured


Click Here to Expand Forum to Full Width