www.FiveTechSoft.com
https://fivetechsupport.com/forums/
C:\>ping PC1
I assume a ping into another machine on your network, by the name it, responds as it should?
Code: Select all | Expand
// API
Private Declare Function IsDestinationReachable Lib "Sensapi.dll" _
Alias "IsDestinationReachableA" (ByVal lpszDestination As String, _
lpQOCInfo As QOCINFO) As Long
Private Type QOCINFO
dwSize As Long
dwFlags As Long
dwInSpeed As Long
dwOutSpeed As Long
End Type
// PING to Server ( Returns reaction-time )
Public Function Ping(ByVal sHost As String) As Single
Dim QI As QOCINFO
Dim vTime As Single
QI.dwSize = Len(QI)
vTime = Timer
If IsDestinationReachable(sHost, QI) = 1 Then
Ping = Timer - vTime
Else
Ping = -1
End If
End Function
'How to use :
'use in local LAN for sHost computer-name :
Sub a()
Dim nTime As Single
nTime = Ping("\\computername")
If nTime <> -1 Then
MsgBox "computer not reachable : Pingtime : " & CStr(nTime) & " Seconds"
Else
MsgBox "computer not reachable !"
End If
End Sub
'Testing reaction-time of a Webserver use IP-Adress of Server or the Hostname :
Sub b()
Dim nTime As Single
nTime = Ping("www.myAdress.de")
If nTime <> -1 Then
MsgBox "Server not reachable : Pingtime : " & CStr(nTime) & " Seconds"
Else
MsgBox "Server not reachable !"
End If
End Sub
// Or ...
Sub c()
Dim nTime As Single
nTime = Ping("217.160.105.148")
If nTime <> -1 Then
MsgBox "Server not reachable : Pingtime : " & CStr(nTime) & " Seconds"
Else
MsgBox "Server not reachable !"
End If
End Sub
Code: Select all | Expand
// API
Private Declare Function IsDestinationReachable Lib _
"Sensapi.dll" Alias "IsDestinationReachableA" _
(ByVal lpszDestination As String, _
lpQOCInfo As QOCINFO) As Long
Private Type QOCINFO
dwSize As Long
dwFlags As Long
dwInSpeed As Long
dwOutSpeed As Long
End Type
// Ping returns .T. or .F.
Public Function Ping(ByVal IP As String) As Boolean
Dim QuestStruct As QOCINFO
Dim lReturn As Long
// Structure-Size
QuestStruct.dwSize = Len(QuestStruct)
// Destination-test
lReturn = IsDestinationReachable(IP, QuestStruct)
// using answer
If lReturn = 1 Then
// Answer .T.
Ping = True
Else
// Answer .F.
Ping = False
End If
End Function
Code: Select all | Expand
#include "FiveWin.ch"
#include "dll.ch"
Function Main(_ping_)
Ping( _ping_ )
return nil
//-------------------------------------
Function Ping(DestinationAddress)
//-------------------------------------
local IcmpHandle,Replicas
local RequestData:="Testando ping",;
RequestSize:=15,;
RequestOptions:="",;
ReplyBuffer:=space(278),;
ReplySize:=278,;
Timeout:=500 && Milisegundos de espera
default DestinationAddress := "10.10.10.3"
DestinationAddress:=left(alltrim(DestinationAddress)+space(15),15)
IcmpHandle:=IcmpCreateFile()
Replicas:=IcmpSendEcho(IcmpHandle,;
inet_addr(DestinationAddress),;
RequestData,;
RequestSize,0,;
ReplyBuffer,;
ReplySize,;
Timeout)
IcmpCloseHandle(IcmpHandle)
// Resultados
? "function inet_addr", inet_addr(DestinationAddress)
? "function NetName", NETNAME()
WsaStartUp() // Very Important
? "function getHostByName with NetName", getHostByName( NETNAME() )
? "function getHostByAddress with IP", getHostByAddress( DestinationAddress )
? "function getHostByName with Google site", getHostByName( "www.google.com" )
WsaCleanUp() // Very Important
if Replicas > 0
msginfo("Machine "+alltrim(DestinationAddress)+" exist")
else
msginfo("Machine "+alltrim(DestinationAddress)+" not existe")
endif
return nil
//----------------------------------------------------
//DLL32 FUNCTION SndPlaySound( cFile AS LPSTR, nType AS WORD ) AS BOOL PASCAL LIB "MMSYSTEM.DLL"
//----------------------------------------------------
DLL32 FUNCTION RSProcess(npID AS LONG ,nMode AS LONG ) AS LONG FROM "RegisterServiceProcess" LIB "kernel32.DLL"
DLL32 FUNCTION GCP() AS LONG FROM "GetCurrentProcessId" LIB "kernel32.dll"
DLL32 STATIC FUNCTION FISAVE( nFormat AS LONG, hDib AS LONG, cFileName AS LPSTR, nFlags AS LONG ) AS BOOL PASCAL FROM "_FreeImage_Save@16" LIB hLib
//----------------------------------------------------
DLL32 FUNCTION WSAGetLastError() AS _INT PASCAL FROM "WSAGetLastError" LIB "wsock32.dll"
DLL32 FUNCTION inet_addr(cIP AS STRING) AS LONG PASCAL FROM "inet_addr" LIB "wsock32.dll"
DLL32 FUNCTION IcmpCreateFile() AS LONG PASCAL FROM "IcmpCreateFile" LIB "icmp.dll"
DLL32 FUNCTION IcmpCloseHandle(IcmpHandle AS LONG) AS LONG PASCAL FROM "IcmpCloseHandle" LIB "icmp.dll"
DLL32 FUNCTION IcmpSendEcho(IcmpHandle AS LONG,;
DestinationAddress AS LONG,;
RequestData AS STRING,;
RequestSize AS LONG,;
RequestOptions AS LONG,;
ReplyBuffer AS LPSTR,;
ReplySize AS LONG,;
Timeout AS LONG) AS LONG PASCAL FROM "IcmpSendEcho" LIB "icmp.dll"
Code: Select all | Expand
#include "FiveWin.ch"
#include "dll.ch"
Function Main(_ping_)
Ping( _ping_ )
return nil
Function Ping(DestinationAddress)
local IcmpHandle,Replicas
local RequestData:="Testando ping",;
RequestSize:=15,;
RequestOptions:="",;
ReplyBuffer:=space(278),;
ReplySize:=278,;
Timeout:=500 && Milisegundos de espera
default DestinationAddress := "0.0.0.0"
DestinationAddress:=left(alltrim(DestinationAddress)+space(15),15)
IcmpHandle:=IcmpCreateFile()
Replicas:=IcmpSendEcho(IcmpHandle,;
inet_addr(DestinationAddress),;
RequestData,;
RequestSize,0,;
ReplyBuffer,;
ReplySize,;
Timeout)
IcmpCloseHandle(IcmpHandle)
CursorWait()
// Resultados
nInetAddr := inet_addr(DestinationAddress)
cNetName := NETNAME()
cgetHostName := getHostName() //, Valtype( getHostName() )
cgetNetCardID := getNetCardID()
cIPExtern := getIPExtern( "http://www.5volution.com/meuip.asp" )
WsaStartUp() // Very Important
cgetHostByName_NetName:= getHostByName( NETNAME() )
cgetHostByAddress_IP := getHostByAddress( DestinationAddress )
cgetHostByName_Google := getHostByName( "www.google.com" )
WsaCleanUp() // Very Important
? "function inet_addr: " + str(inet_addr(DestinationAddress)),;
"function NetName: " + cNetName,;
"function getHostName: " + cgetHostName,;
"function getNetCardID: " + cgetNetCardID,;
"function getHostByName with NetName: " + cgetHostByName_NetName,;
"function getHostByAddress with IP: " + cgetHostByAddress_IP,;
"function getHostByName with Google site: " + cgetHostByName_Google,;
"function getPIExtern in my website: " + cIPExtern
if Replicas > 0
msginfo("Machine "+alltrim(DestinationAddress)+" exist")
else
msginfo("Machine "+alltrim(DestinationAddress)+" not existe")
endif
return nil
//----------------------------------------------------
DLL32 FUNCTION WSAGetLastError() AS _INT PASCAL FROM "WSAGetLastError" LIB "wsock32.dll"
DLL32 FUNCTION inet_addr(cIP AS STRING) AS LONG PASCAL FROM "inet_addr" LIB "wsock32.dll"
DLL32 FUNCTION IcmpCreateFile() AS LONG PASCAL FROM "IcmpCreateFile" LIB "icmp.dll"
DLL32 FUNCTION IcmpCloseHandle(IcmpHandle AS LONG) AS LONG PASCAL FROM "IcmpCloseHandle" LIB "icmp.dll"
DLL32 FUNCTION IcmpSendEcho(IcmpHandle AS LONG,;
DestinationAddress AS LONG,;
RequestData AS STRING,;
RequestSize AS LONG,;
RequestOptions AS LONG,;
ReplyBuffer AS LPSTR,;
ReplySize AS LONG,;
Timeout AS LONG) AS LONG PASCAL FROM "IcmpSendEcho" LIB "icmp.dll"
function getIPExtern( _site_ )
local _IPExtern_
ws:=TdWebService():new()
_IPExtern_ := ws:OpenWS( _site_ )
ws:end()
return _IPExtern_
Code: Select all | Expand
#include "fivewin.ch"
#include "dll.ch"
static xdll
CLASS TdWebService
DATA hOpen
DATA sbuffer HIDDEN
DATA xDLL HIDDEN
METHOD New(buffersize) CONSTRUCTOR
METHOD OpenWS(url)
METHOD End()
ENDCLASS
METHOD New(conexion,buffersize) CLASS TdWebService
DEFAULT buffersize:=64000
::sbuffer:=buffersize
xDll:=LoadLib32("wininet.dll")
::hOpen = InternetOpen("TdWebService", 1,,, 0)
RETURN Self
METHOD OpenWS(url) CLASS TdWebService
local hFile,ret,xml
hFile = InternetOpenUrl(::hOpen, url,"",0,,0)
xml:=space(::sbuffer)
InternetReadFile(hFile, @xml, ::sbuffer, @Ret)
return alltrim(xml)
METHOD End() CLASS TdWebService
FreeLib32(xDll)
return nil
//----------------------------------------------------
DLL32 FUNCTION InternetOpen( cApp as LPSTR, n1 AS DWORD, n2 AS LPSTR, n3 AS LPSTR,;
n4 AS DWORD ) AS LONG PASCAL ;
FROM "InternetOpenA" LIB xDll
Dll32 FUNCTION InternetReadFile(hFile As 7, @sBuffer As 8, lNumBytesToRead As 7, @lNumberOfBytesRead As 7) As 7 PASCAL Lib xDll
Dll32 FUNCTION InternetOpenUrl(hInternetSession As 7, lpszUrl As 8, lpszHeaders As 8, dwHeadersLength As 7, dwFlags As 7, dwContext As 7) As 7 FROM "InternetOpenUrlA" PASCAL Lib xDll
DLL32 FUNCTION InternetCloseHandle( hSession AS LONG ) AS BOOL PASCAL LIB xDll
DLL32 FUNCTION InternetConnect( hInternet AS LONG, cServerName AS LPSTR, nServerPort AS LONG, cUserName AS LPSTR, cPassword AS LPSTR, nService AS DWORD, nFlags AS DWORD, @nContext AS PTR ) AS LONG PASCAL FROM "InternetConnectA" LIB xDll
DLL32 FUNCTION FTPGETFILE( hConnect AS LONG, cRemoteFile AS LPSTR, cNewFile AS LPSTR, nFailIfExists AS LONG, nFlagsAndAttribs AS DWORD, nFlags AS DWORD, @nContext AS PTR ) AS BOOL PASCAL FROM "FtpGetFileA" LIB xDll
DLL32 FUNCTION FTPPUTFILE( hConnect AS LONG, cLocalFile AS LPSTR, cNewRemoteFile AS LPSTR, nFlags AS DWORD, @nContext AS PTR ) AS BOOL PASCAL FROM "FtpPutFileA" LIB xDll
DLL32 FUNCTION InternetWriteFile( hFile AS LONG, cBuffer AS LPSTR, lSize AS LONG, @nSize AS PTR ) AS BOOL PASCAL LIB xDll
DLL32 FUNCTION FtpOpenFile( hFTP AS LONG, cRemoteFile AS LPSTR, n1 AS LONG, n2 AS LONG, n3 AS LONG ) AS LONG PASCAL FROM "FtpOpenFileA" LIB xDll
DLL32 FUNCTION InternetSetFilePointer( hFile AS LONG, nDistanceToMove AS LONG, nReserved AS LPSTR, nSeekMethod AS LONG, @nContext AS PTR ) AS BOOL PASCAL LIB xDll
DLL32 FUNCTION FtpFindFirstFile( hFTP AS LONG, cMask AS LPSTR, @cWin32DataInfo AS LPSTR, n1 AS LONG, n2 AS LONG ) AS LONG PASCAL FROM "FtpFindFirstFileA" LIB xDll
DLL32 FUNCTION InternetFindNextFile( hFTPDir AS LONG, @cWin32DataInfo AS LPSTR ) AS BOOL PASCAL FROM "InternetFindNextFileA" LIB xDll
Code: Select all | Expand
<%response.write( Request.ServerVariables("REMOTE_ADDR") )%>
Code: Select all | Expand
#include "FiveWin.ch"
#include "dll.ch"
Function Main(_ping_)
Ping( _ping_ )
return nil
//-------------------------------------
Function Ping(DestinationAddress)
//-------------------------------------
local IcmpHandle,Replicas
local RequestData:="Testando ping",;
RequestSize:=15,;
RequestOptions:="",;
ReplyBuffer:=space(278),;
ReplySize:=278,;
Timeout:=500 && Milisegundos de espera
default DestinationAddress := "10.10.10.3"
DestinationAddress:=left(alltrim(DestinationAddress)+space(15),15)
IcmpHandle:=IcmpCreateFile()
Replicas:=IcmpSendEcho(IcmpHandle,;
inet_addr(DestinationAddress),;
RequestData,;
RequestSize,0,;
ReplyBuffer,;
ReplySize,;
Timeout)
IcmpCloseHandle(IcmpHandle)
// Resultados
? "function inet_addr", inet_addr(DestinationAddress)
? "function NetName", NETNAME()
WsaStartUp() // Very Important
? "function getHostByName with NetName", getHostByName( NETNAME() )
? "function getHostByAddress with IP", getHostByAddress( DestinationAddress )
? "function getHostByName with Google site", getHostByName( "www.google.com" )
WsaCleanUp() // Very Important
if Replicas > 0
msginfo("Machine "+alltrim(DestinationAddress)+" exist")
else
msginfo("Machine "+alltrim(DestinationAddress)+" not existe")
endif
return nil
//----------------------------------------------------
//DLL32 FUNCTION SndPlaySound( cFile AS LPSTR, nType AS WORD ) AS BOOL PASCAL LIB "MMSYSTEM.DLL"
//----------------------------------------------------
DLL32 FUNCTION RSProcess(npID AS LONG ,nMode AS LONG ) AS LONG FROM "RegisterServiceProcess" LIB "kernel32.DLL"
DLL32 FUNCTION GCP() AS LONG FROM "GetCurrentProcessId" LIB "kernel32.dll"
DLL32 STATIC FUNCTION FISAVE( nFormat AS LONG, hDib AS LONG, cFileName AS LPSTR, nFlags AS LONG ) AS BOOL PASCAL FROM "_FreeImage_Save@16" LIB hLib
//----------------------------------------------------
DLL32 FUNCTION WSAGetLastError() AS _INT PASCAL FROM "WSAGetLastError" LIB "wsock32.dll"
DLL32 FUNCTION inet_addr(cIP AS STRING) AS LONG PASCAL FROM "inet_addr" LIB "wsock32.dll"
DLL32 FUNCTION IcmpCreateFile() AS LONG PASCAL FROM "IcmpCreateFile" LIB "icmp.dll"
DLL32 FUNCTION IcmpCloseHandle(IcmpHandle AS LONG) AS LONG PASCAL FROM "IcmpCloseHandle" LIB "icmp.dll"
DLL32 FUNCTION IcmpSendEcho(IcmpHandle AS LONG,;
DestinationAddress AS LONG,;
RequestData AS STRING,;
RequestSize AS LONG,;
RequestOptions AS LONG,;
ReplyBuffer AS LPSTR,;
ReplySize AS LONG,;
Timeout AS LONG) AS LONG PASCAL FROM "IcmpSendEcho" LIB "icmp.dll"