Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
testtest.bas
| Uploader: |  ThePuppetMaster |
| Datum/Zeit: | 04.10.2011 17:34:38 |
'##############################################################################################################
'TEST-PING für TSNE_V3
'##############################################################################################################
'##############################################################################################################
#include once "TSNE_V3.bi" 'Die TCP Netzwerkbibliotek integrieren
'##############################################################################################################
Private Function TSNE_PingX(ByVal V_IPA as String, ByRef R_Runtime as Double, ByVal V_TimeoutSecs as UByte = 10, ByVal V_ForceRAWPing as UByte = 0, ByVal V_FileIOMutex as Any Ptr = 0) as Integer
If V_IPA = "" Then Return TSNE_Const_IPAnotFound
#IF DEFINED(__FB_LINUX__)
If V_ForceRAWPing = 0 Then
If Dir("/bin/ping", -1) <> "" Then
If V_FileIOMutex <> 0 Then MutexLock(V_FileIOMutex)
Dim XFN as Integer = FreeFile
If Open Pipe ("/bin/ping -t " & Str(V_TimeoutSecs) & " -c 1 -qU " & V_IPA for Input as XFN) = 0 Then
If V_FileIOMutex <> 0 Then MutexUnLock(V_FileIOMutex)
Dim T as String
Dim TL as String
Do Until EOF(XFN)
Line Input #XFN, TL
If Trim(TL) <> "" Then T = TL
Loop
Close #XFN
XFN = InStr(1, T, "=")
If XFN = 0 Then Return TSNE_Const_InternalError
T = Trim(Mid(T, XFN + 1))
XFN = InStr(1, T, "/")
If XFN = 0 Then Return TSNE_Const_InternalError
R_Runtime = Val(Trim(Left(T, XFN - 1))) / 1000
Return TSNE_Const_NoError
End If
If V_FileIOMutex <> 0 Then MutexUnLock(V_FileIOMutex)
End If
End If
#ELSEIF DEFINED(__FB_WIN32__)
If V_ForceRAWPing = 0 Then
If V_FileIOMutex <> 0 Then MutexLock(V_FileIOMutex)
Dim XFN as Integer = FreeFile
If Open Pipe ("ping -w " & Str(V_TimeoutSecs) & " -n 1 " & V_IPA for Input as XFN) = 0 Then
If V_FileIOMutex <> 0 Then MutexUnLock(V_FileIOMutex)
Dim T as String
Dim TL as String
Do Until EOF(XFN)
Line Input #XFN, TL
If Trim(TL) <> "" Then T = TL
Loop
Close #XFN
XFN = InStr(1, T, "=")
If XFN = 0 Then Return TSNE_Const_InternalError
T = Trim(Mid(T, XFN + 1))
XFN = InStr(1, T, "ms")
If XFN = 0 Then Return TSNE_Const_InternalError
R_Runtime = Val(Trim(Left(T, XFN - 1))) / 1000
Return TSNE_Const_NoError
End If
If V_FileIOMutex <> 0 Then MutexUnLock(V_FileIOMutex)
End If
#ENDIF
If InStr(1, V_IPA, ":") > 0 Then Return TSNE_Const_NoIPV6
Dim TADDRIN as in_addr
Dim RV as Integer = TSNE_INT_GetHostEnd(V_IPA, TADDRIN)
If RV <> TSNE_Const_NoError Then Return RV
Dim TADDR as SOCKADDR_IN
With TADDR
.sin_family = AF_INET
.sin_addr = TADDRIN
End With
Dim TSock as Socket = opensocket(PF_INET, SOCK_RAW, IPPROTO_ICMP)
If TSock = INVALID_SOCKET Then
Return TSNE_Const_CantCreateSocket
' Select Case errno
' Case EMFILE, ENFILE, ENOMEM: Return TSNE_Const_CantCreateSocketLimit
' Case Else: Return TSNE_Const_CantCreateSocket
' End Select
End If
#IF DEFINED(__FB_LINUX__)
Dim XFlag as Integer = fcntl(TSock, F_GETFL, 0)
If XFlag = -1 Then close_(TSock): Return TSNE_Const_ReturnErrorInCallback
' If fcntl(TSock, F_SETFL, XFlag or O_NONBLOCK) = -1 Then close_(TSock): Return TSNE_Const_ReturnErrorInCallback
If fcntl(TSock, F_SETFL, XFlag) = -1 Then close_(TSock): Return TSNE_Const_ReturnErrorInCallback
#ELSEIF DEFINED(__FB_WIN32__)
Dim XFlag as Integer = ioctlsocket(TSock, FIONBIO, Cast(Any Ptr, 1))
#ENDIF
Dim TICMP as ICMP
With TICMP
.icmp_type = ICMP_ECHO
.icmp_code = 0
.icmp_seq = 1
.icmp_id = 0
End With
Dim TUBP as UByte Ptr = Cast(UByte Ptr, @TICMP)
Dim TSum as UInteger
For X as UInteger = 0 To SizeOf(ICMP) -1
TSum += *(TUBP + X)
Next
TSum = (TSum shr 16) + (TSum and &HFFFF)
TSum += (TSum shr 16)
TSum = &HFFFF - TSum
TICMP.icmp_cksum = TSum
Dim TBuffer as ZString * TSNE_INT_BufferSize
Dim TLenB as Integer
Dim TFDSet as fd_Set
Dim TTLen as UInteger = SizeOf(TADDR)
Dim TTV AS TimeVal
With TTV
.tv_sec = CUInt(V_TimeoutSecs)
.tv_usec = 0
End With
fd_set_(TSock, @TFDSet)
Dim TRTT as Double = Timer()
RV = sendto(TSock, Cast(UByte Ptr, @TICMP), SizeOf(ICMP), 0, Cast(SOCKADDR Ptr, @TADDR), SizeOf(SOCKADDR_IN))
If RV <> SizeOf(ICMP) Then close_(TSock): Return TSNE_Const_ErrorSendingData
Do
RV = select_(TSock + 1, @TFDSet, 0, 0, @TTV)
If RV <> 1 Then close_(TSock): Return TSNE_Const_CantConnectToRemote
If TSock = INVALID_SOCKET Then close_(TSock): Return TSNE_Const_InternalError
TLenB = recvfrom(TSock, StrPtr(TBuffer), TSNE_INT_BufferSize, 0, Cast(SOCKADDR Ptr, @TADDR), @TTLen)
If TLenB <= 0 Then close_(TSock): Return TSNE_Const_InternalError
If TLenB >= 2 Then
If (((TBuffer[0] and &B11110000) shr 4) = &H4) and (TBuffer[1] = &H00) Then
Dim TIHL as UInteger = (TBuffer[0] and &B00001111) * 4
If TIHL >= 16 Then
If TBuffer[TIHL + 0] = ICMP_ECHOREPLY Then
Dim TSN as UShort = (TBuffer[TIHL + 6] shl 8) or TBuffer[TIHL + 7]
If TSN = 256 Then
close_(TSock)
R_Runtime = Timer() - TRTT
Return TSNE_Const_NoError
End If
End If
End If
End If
End If
Loop
Return TSNE_Const_CantConnectToRemote
End Function
'##############################################################################################################
Dim TRunTime as Double
Dim RV as Integer
'Ping Ausführen
RV = TSNE_PingX("google.com", TRunTime)
'Statusrückgabe auswerten
If RV <> TSNE_Const_NoError Then
Print "[FEHLER] " & TSNE_GetGURUCode(RV) 'Fehler ausgeben
End -1 'Programmbeenden
End If
Print "Runtime: "; Str(TRunTime); " seconds"
End 0