Código: Selecionar todos
FUNCTION MAIN()
INETESTACONECTADA('ws.nomeservico.com.br')
RETURN NIL
FUNCTION INETESTACONECTADA(cAddress)
LOCAL cIp, lRET := .F.
Local cITME_START:=TIME()
LOCAL cITME_END :=''
IF cAddress = NIL
cAddress := "www.google.com"
ENDIF
WsaStartUp()
cIp := GETHOSTBYNAME( cAddress )
WsaCleanUp()
lRET:=cIp<>"0.0.0.0"
cITME_END :=TIME()
IF TimeToSec(ElapTime(cITME_START,cITME_END)) > 5
lRET:=.F.
ENDIF
Código: Selecionar todos
//-> Funcao para checar a Internet
FUNCTION IsInternet()
LOCAL cIp, cVret := .F.
WsaStartUp()
cIp := GETHOSTBYNAME( "microsoft.com" )
cIp := GETHOSTBYNAME( "microsoft.com" )
WsaCleanUp()
// Seguranca caso o provedor da microsoft esteja fora do ar...
IF ( cIp <= "0.0.0.0" )
WsaStartUp()
cIp := GetHostByName( "google.com" )
cIp := GetHostByName( "google.com" )
WsaCleanUp()
ENDIF
RETURN( cIp<>"0.0.0.0" )
Código: Selecionar todos
FUNCTION IsInternet( cUrl, nPort )
LOCAL lOk := .F. , aAddr
hb_Default( @cUrl, "www.google.com" )
hb_Default( @nPort, 80 )
aAddr := hb_socketResolveINetAddr( cUrl, nPort )
IF ! Empty( aAddr )
lOk := hb_socketConnect( hb_socketOpen(), aAddr, 2000 )
ENDIF
RETURN lOk
Código: Selecionar todos
cBuffer := oPg:responseText
lSuccesso := oXMLDoc:loadXML( cBuffer )
Código: Selecionar todos
FUNCTION IsInternet( cUrl, nPort )
LOCAL lOk := .F. , aAddr
hb_Default( @cUrl, "www.google.com" )
hb_Default( @nPort, 80 )
aAddr := hb_socketResolveINetAddr( cUrl, nPort )
IF ! Empty( aAddr )
lOk := hb_socketConnect( hb_socketOpen(), aAddr, 2000 )
ENDIF
RETURN lOk
Código: Selecionar todos
DLL32 FUNCTION WSAStartup(n AS LONG, pStruct AS LPSTR) AS LONG PASCAL FROM "WSAStartup" LIB "wsock32.dll"
DLL32 FUNCTION WSACleanup() AS LONG PASCAL FROM "WSACleanup" LIB "wsock32.dll"
DLL32 FUNCTION closesocket(af AS LONG) AS WORD PASCAL FROM "closesocket" LIB "wsock32.dll"
DLL32 FUNCTION MemCopy(dest AS LPSTR, src AS LPSTR, cb AS LONG ) AS VOID PASCAL FROM "RtlMoveMemory" LIB "Kernel32.dll"
DLL32 FUNCTION socket(af AS LONG, s_type AS LONG, protocol AS LONG ) AS LONG PASCAL FROM "socket" LIB "wsock32.dll"
DLL32 FUNCTION setsockopt(s AS LONG,level AS LONG,optname AS LONG,optval AS LPSTR,optlen AS LONG) AS LONG PASCAL FROM "setsockopt" LIB "wsock32.dll"
DLL32 FUNCTION getsockopt(s AS LONG,level AS LONG,optname AS LONG,optval AS LPSTR,optlen AS LONG) AS LONG PASCAL FROM "getsockopt" LIB "wsock32.dll"
DLL32 FUNCTION htonl(hostlong AS LONG) AS LONG PASCAL FROM "htonl" LIB "wsock32.dll"
DLL32 FUNCTION htons(hostshort AS LONG) AS WORD PASCAL FROM "htons" LIB "wsock32.dll"
DLL32 FUNCTION bind(s AS LONG, pStruct AS LPSTR,namelen AS LONG) AS LONG PASCAL FROM "bind" LIB "wsock32.dll"
DLL32 FUNCTION inet_addr(cp AS STRING) AS LONG PASCAL FROM "inet_addr" LIB "wsock32.dll"
DLL32 FUNCTION inet_ntoa(nip AS LONG) AS STRING PASCAL FROM "inet_ntoa" LIB "wsock32.dll"
DLL32 FUNCTION WSAAsyncSelect(s AS LONG, hWnd AS LONG, wMsg AS LONG, lEvent AS LONG) AS LONG PASCAL FROM "WSAAsyncSelect" LIB "wsock32.dll"
DLL32 FUNCTION recv(s AS LONG, Buf AS LPSTR, buflen AS LONG, flags AS LONG) AS LONG PASCAL FROM "recv" LIB "wsock32.dll"
DLL32 FUNCTION recvfrom(s AS LONG, Buf AS LPSTR, buflen AS LONG, flags AS LONG, pStruct AS LPSTR, namelen AS LONG) AS LONG PASCAL FROM "recvfrom" LIB "wsock32.dll"
DLL32 FUNCTION send(s AS LONG, Buf AS LPSTR, buflen AS LONG, flags AS LONG) AS LONG PASCAL FROM "send" LIB "wsock32.dll"
DLL32 FUNCTION sendto(s AS LONG, Buf AS LPSTR, buflen AS LONG, flags AS LONG, addr AS LPSTR, i AS LONG) AS LONG PASCAL FROM "sendto" LIB "wsock32.dll"
DLL32 FUNCTION WSAGetLastError() AS LONG PASCAL FROM "WSAGetLastError" LIB "wsock32.dll"
Código: Selecionar todos
oAutomacao := TOleAuto():New( "Microsoft.XMLHTTP" )
oAutomacao:Open( ... )
...
oAutomacao:Send( ... )
cStringJSON := oAutomacao:responseText
If oAutomacao:Status == 200
cAutomacaoStatus := "200-Success"
do While oAutomacao:readyState != 4 // 0-UNSENT: Um cliente foi criado. Mas o m?do open() n?foi chamado ainda. 1-OPENED: O m?do open() foi chamado. 2-HEADERS_RECEIVED: o m?do send() foi chamado e os cabe?hos e status est?dispon?is. 3-LOADING: Baixando e responseText contem os dados parciais. 4-DONE: Opera? conclu?.
oAutomacao:WaitForResponse(1000)
Enddo
? cAutomacaoStatus,,cAutomacao:responseText
ElseIf oAutomacao:Status == 400
cAutomacaoStatus := "400-Requisição Mal Formada"
? cAutomacaoStatus,,oAutomacao:responseText
ElseIf oAutomacao:Status == 401
cAutomacaoStatus := "401-Requisição Requer Autenticação"
? cAutomacaoStatus,,oAutomacao:responseText
ElseIf oAutomacao:Status == 403
cAutomacaoStatus := "403-Requisição Negada"
? cAutomacaoStatus,,oAutomacao:responseText
ElseIf oAutomacao:Status == 404
cAutomacaoStatus := "404-Recurso não Encontrado"
? cAutomacaoStatus,,oAutomacao:responseText
ElseIf oAutomacao:Status == 405
cAutomacaoStatus := "405-Método não Permitido"
? cAutomacaoStatus,,oAutomacao:responseText
ElseIf oAutomacao:Status == 408
cAutomacaoStatus := "408-Tempo esgotado para a requisição"
? cAutomacaoStatus,,oAutomacao:responseText
ElseIf oAutomacao:Status == 413
cAutomacaoStatus := "413-Requisição excede o tamanho máximo permitido"
? cAutomacaoStatus,,oAutomacao:responseText
ElseIf oAutomacao:Status == 415
cAutomacaoStatus := "415-Tipo de mídia inválida (falta de informar o content-type correto, ver JSON)"
? cAutomacaoStatus,,oAutomacao:responseText
ElseIf oAutomacao:Status == 429
cAutomacaoStatus := "429-Requisição excede a quantidade máxima de chamadas permitidas à API"
? cAutomacaoStatus,,oAutomacao:responseText
Else
cAutomacaoStatus := "No Error Configured"
cStringJSON := ""
Endif
...