| Author | Topic: InternetCheckConnectionA() doubt | |
|---|---|---|
 | Carlos A Beling | InternetCheckConnectionA() doubt on Thu, 17 Oct 2019 11:33:27 -0300 |
| Konstantin Lebedev | Re: InternetCheckConnectionA() doubt on Thu, 24 Oct 2019 20:58:57 +0200 |
| Carlos A Beling | Re: InternetCheckConnectionA() doubt on Thu, 24 Oct 2019 18:08:48 -0300 Hi Constantin: good evening. Many thanks. Now I use the function attached and it is very quick. Fraternally Beling On 24/10/2019 15:58, Konstantin Lebedev wrote: > Carlos A Beling <beling@bipbip.com.br> wrote in message news:17ec5d54$76c54cc$5acdf@news.alaska-software.com... >> Good day. >> Is it safe using the API InternetCheckConnectionA >> (https://docs.microsoft.com/en-us/windows/win32/api/wininet/nf-wininet-internetcheckconnectiona) >> for testing if the host is available? >> >> Fraternally >> Beling > > Hi, Carlos! > I don'd remember from what source (may be https://www.xbaseforum.de) I pick up this class. > P.S. Function is mine) > > It's really work for "ping" IP before attempt to connect it (depend with loooong timeourt in my case). > > > > #include "ot4xb.ch" > --------------------------------------------------------------------------- > CLASS TPing > EXPORTED: > CLASS VAR afp > VAR pBuffer,hIcmp > VAR cIp,nIp,nStatus,nTime,nTtl > -------------------------------------------------------------------- > INLINE CLASS METHOD initclass() > @ws2_32:WSAStartup(0x0101,Chrr(0,1024)) > ::_afp_ := Array(3) > ::_afp_[1] := nGetProcAddress("IpHlpApi", "IcmpCreateFile" ) > if Empty( ::_afp_[1] ) Win2K > ::_afp_[1] := nGetProcAddress("Icmp", "IcmpCreateFile" ) > ::_afp_[2] := nGetProcAddress("Icmp", "IcmpCloseHandle" ) > ::_afp_[3] := nGetProcAddress("Icmp", "IcmpSendEcho" ) > else > ::_afp_[2] := nGetProcAddress("IpHlpApi", "IcmpCloseHandle" ) > ::_afp_[3] := nGetProcAddress("IpHlpApi", "IcmpSendEcho" ) > end > return Self > -------------------------------------------------------------------- > INLINE CLASS METHOD ntoa(n) ; return FpQCall({"Ws2_32","inet_ntoa"},"c_sz__sl",n) > -------------------------------------------------------------------- > > INLINE CLASS METHOD cHostByName(cHost) > local pHost > local aAddr > if Valtype(cHost) != "C" ; return NIL ; end > @ws2_32:WSASetLastError(0) > pHost := @Ws2_32:gethostbyname(cHost) > if Empty(pHost) ; return NIL ; end > aAddr := PeekByte(PeekDWord(PeekDWord(pHost,12)),0,4) > return cPrintf("%i.%i.%i.%i",aAddr[1],aAddr[2],aAddr[3],aAddr[4]) > -------------------------------------------------------------------- > INLINE CLASS METHOD nHostByName(cHost) > local pHost > local aAddr > if Valtype(cHost) != "C" ; return NIL ; end > @ws2_32:WSASetLastError(0) > pHost := @Ws2_32:gethostbyname(cHost) > if Empty(pHost) ; return NIL ; end > return PeekDWord(PeekDWord(PeekDWord(pHost,12))) > -------------------------------------------------------------------- > INLINE CLASS METHOD IcmpCreateFile() ; return nFpCall( ::_afp_[1] ) > -------------------------------------------------------------------- > INLINE CLASS METHOD IcmpCloseHandle(h) ; return FpQCall(::_afp_[2],"__sl__sl",h) > -------------------------------------------------------------------- > INLINE CLASS METHOD IcmpSendEcho(p1,p2,p3,p4,p5,p6,p7,p8) > return FpQCall( ::_afp_[3] ,"__sl__sl__sl__pt__us__pt__pt__sl__ul",; > p1,p2,p3,p4,p5,@p6,p7,p8; > ) > -------------------------------------------------------------------- > INLINE METHOD init() > ::Destroy() > ::hIcmp := ::IcmpCreateFile() > if ::hIcmp == -1 > ::hIcmp := NIL > else > ::pBuffer := _xgrab( 1024 ) > end > return Self > -------------------------------------------------------------------- > INLINE METHOD Destroy() > if ::hIcmp != NIL ; ::IcmpCloseHandle(::hIcmp) ; ::hIcmp := NIL ; end > if ::pBuffer != NIL ; _xfree( ::pBuffer ) ; ::pBuffer := NIL ; end > return Self > -------------------------------------------------------------------- > INLINE METHOD reset() > ::cIp := ::nIp := ::nStatus := ::nTime := ::nTtl := NIL > if ::pBuffer != NIL ; _bset(::pBuffer,0,1024) ; end > return Self > -------------------------------------------------------------------- > INLINE METHOD Ping( cHost , nTimeOut ) > local p := ::pBuffer > local nHost,cReq,dw > ::reset() > if ::hIcmp == NIL ; return .F. ; end > nHost := ::nHostByName( cHost ) > if nHost == NIL ; return .F. ; end > DEFAULT nTimeOut := 5000 > cReq := cGenRndStr(32,.T.) > dw := ::IcmpSendEcho(::hIcmp,nHost,cReq,Len(cReq),0,p,1024,nTimeOut) > if (dw == 0 ) ; return .F. ; end > ::nIp := PeekDWord(p,0) > ::cIp := ::ntoa(::nIp) > ::nStatus := PeekDWord(p,4) > ::nTime := PeekDWord(p,8) > ::nTtl := PeekByte(p,20) > return .T. > -------------------------------------------------------------------- > ENDCLASS > > Пропинговать IP адрес. > > function PingIP( cHost) > local o := TPing():New() > LOCAL nTimeOut := 500 > local cStr,cIp, lRet > > cHost := LTRIM(cHost) > if UPPER(LEFT(cHost, 7)) == "HTTP://" > cHost := SUBSTR(cHost, 8, LEN(cHost)) > end > > cHost := LEFT(cHost, AT(":", cHost) - 1) > > cIp := TPing():cHostByName(cHost, nTimeOut) > DEFAULT cIp := "" > lRet := o:Ping(cHost) > o:Destroy() > return lRet > - >  TestCon.prg |