william007
asked on
How to deal with remote directory not exist?
'======Code start=====================
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) '<----------The problem is here
'
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("williamcom")
MsgBox d
End Sub
'======Code End=======================
The problem is, if the server name is not exist (Here is "williamcom"), the
lRet = NetRemoteTOD(tServer(0), lpbuff)
will run forever, and the computer appear to be hang,
is there anyway to get around this?
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) '<----------The problem is here
'
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("williamcom")
MsgBox d
End Sub
'======Code End=======================
The problem is, if the server name is not exist (Here is "williamcom"), the
lRet = NetRemoteTOD(tServer(0), lpbuff)
will run forever, and the computer appear to be hang,
is there anyway to get around this?
ASKER
Thanks, but the function that I stated above is working well. Only in the case that when the remote server is down or not there, it appears to be hang(No error code).
You can cut and paste the code and run, change the williamcom to the remote machine name that you shared in the LAN, and when you click on the button, it is getting the remote machine date and time. Only if the machine is not exist, it will be hang. My objective is to prevent the hang situation.
Note: Pls be prepare the application to be hang if the machine name no exist...make sure your ctrl and alt and delete key is not malfunction=)
You can cut and paste the code and run, change the williamcom to the remote machine name that you shared in the LAN, and when you click on the button, it is getting the remote machine date and time. Only if the machine is not exist, it will be hang. My objective is to prevent the hang situation.
Note: Pls be prepare the application to be hang if the machine name no exist...make sure your ctrl and alt and delete key is not malfunction=)
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
You could ping the server and then only run the code if you get a response.
If you need some VB code to do the ping then please post a comment and I'll post the code.
Bill
If you need some VB code to do the ping then please post a comment and I'll post the code.
Bill
ASKER
Hi, is there a EASY way to ping a server by not showing the command prompt windows?
I need to use it in Windows 2000 and Windows XP
I don't quite understand the code that is accepted in
https://www.experts-exchange.com/questions/21214528/ping-in-vbscript.html
I need to use it in Windows 2000 and Windows XP
I don't quite understand the code that is accepted in
https://www.experts-exchange.com/questions/21214528/ping-in-vbscript.html
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Imports System.Management
Module modPingTargets
Dim objStatus As ManagementObject
Dim pingResults as string
Public Sub Ping0()
On Error Resume Next
Dim objPing As New SelectQuery("Select StatusCode from Win32_PingStatus WHERE Address = 'www.yahoo.com'")
Dim Search As New ManagementObjectSearcher(o
For Each objStatus In Search.Get()
pingResults = objStatus("StatusCode").To
Next
objPing = Nothing
Search = Nothing
End Sub
End Module
Module modPingTargets
Dim objStatus As ManagementObject
Dim pingResults as string
Public Sub Ping0()
On Error Resume Next
Dim objPing As New SelectQuery("Select StatusCode from Win32_PingStatus WHERE Address = 'www.yahoo.com'")
Dim Search As New ManagementObjectSearcher(o
For Each objStatus In Search.Get()
pingResults = objStatus("StatusCode").To
Next
objPing = Nothing
Search = Nothing
End Sub
End Module
Will need a reference to WMI
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Thanks:-)
http://www.pcreview.co.uk/forums/thread-1100875.php