Uwe,
One question about the tool getip: It can get the information of another machine, running into my machine?
C:\>ping PC1
Anser,
I assume a ping into another machine on your network, by the name it, responds as it should?
Sorry for my insistence, but we need to test all of situations to resolve this problem...
I assume a ping into another machine on your network, by the name it, responds as it should?
// 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
Uwe,
This function is wonderful! I think yes, it's possible translate to FWH language! Let's go to work! 
// 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#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"Thank you Mr.Rochinha,
I tested and It is working
Regards
Anser
Rochinha,
Wonderful! Perfect function!
Maravilhoso! Função perfeita meu garoto!
Resolveu muitos dos problemas com teste de conexão aqui no nosso sistema! Valeu!
Hey Guys,
Sorry but I can not get this to work on my Wndows Vista computer. It compiles ok, but the exe just does not do anything. Do you have a running sample?
Patrick
#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_#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<%response.write( Request.ServerVariables("REMOTE_ADDR") )%>#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"