Como saber se um IP esta valido ativo?

[Edmar Frazao]

preciso saber se o IP do servidor esta ativo.

Como fazer?

usando o inet não funciona

ChecaIP('10.1.1.20')

Function Checaip(cAddress)

InetInit()

aHosts := InetGetHosts( cAddress )

IF aHosts == NIL .or. len(aHosts)=0

InetCleanup()

RETURN .f.

endif

FOR EACH cAddress IN aHosts

nRet:=.t.

NEXT

InetCleanup()

RETURN nRet

Editado por - edmarfrazao on 06/03/2012 10:03:32

[Edmar Frazao]

preciso saber se o IP do servidor esta ativo.

Como fazer?

usando o inet não funciona

ChecaIP('10.1.1.20')

Function Checaip(cAddress)

InetInit()

aHosts := InetGetHosts( cAddress )

IF aHosts == NIL .or. len(aHosts)=0

InetCleanup()

RETURN .f.

endif

FOR EACH cAddress IN aHosts

nRet:=.t.

NEXT

InetCleanup()

RETURN nRet

Editado por - edmarfrazao on 06/03/2012 10:03:32

[sambomb]

Pode tentar pelo comando ping do windows

Seria mais ou menos assim:

cIp := "192.168.10.2"

If VerificaIP( cIP )

MsgInfo("Ip válido")

else

MsgInfo("Ip inválido, verifique")

end

Function VerificaIP( cIP, nTentativas )

Local Result := .F., nPos := 0, cTentativas := "", cPerdidos := ""

Default cIp := "192.168.10.2", nTentativas := 10

fErase("C:\Ping.txt")

Winexec( "ping " + cIp + " -n " + AllTrim(Str(nTentativas)) + " > C:\Ping.txt" )

While !File("C:\Ping.txt")

Pause(1)

SysRefresh()

end

cTexto := MemoRead("C:\Ping.txt")

nPos := At("Enviados = ",cTexto)

cTentativas := SubStr(cTexto,nPos+11,2)

nPos := At("Perdidos = ",cTexto)

cPerdidos := SubStr(cTexto,nPos+11,2)

If cTentativas = cPerdidos

Result := .F.

else

Result := .T.

end

Return Result

id=code>id=code>

RCA Sistemas - Itaocara - RJ

[Edmar Frazao]

o comando nao funciona ou seja não grava no txt

[roberio]

tente assim:

*-------------------

Function TestIP()

LOCAL cIp, cRet

WsaStartUp()

cIp := GETHOSTBYNAME( "NOME_DO_COMPUTADOR_SEM_O_\\" )

WsaCleanUp()

If cIp = "0.0.0.0"

msgalert("nao deu certo")

cRet := .f.

Else

msgalert(cIp) // acho o computador e retorna o IP

cRet := .t.

Endif

Return cRet

id=code>id=code>

Editado por - roberio on 06/03/2012 11:16:49

[Edmar Frazao]

uso xharbour.com +hwgui

não tenho estas funções.

[microfly]

Bom dia , veja se te serve

Function VerIp()

local cIp

If WSaStartup() == 0

cIp := ServerIp()

WSaCleanUp()

Endif

Return (cIp)

*-----------------------------------------------------------

Luiz Carlos (Batata)

www.microfly.com.br

São Paulo - Zona Norte

Luiz Carlos

[gss200610]

USO ESSA NO MEU SISTEMA E FUNCIONA MELHOR QUE QUALQUER OUTRA. POIS DISPARA VIA API.

#pragma BEGINDUMP

#include

#include

#include

#include

int hb_Ping( const char * cp )

{

HANDLE hIcmpFile;

unsigned long ipaddr;

DWORD dwRetVal;

char SendData[32] = "Data Buffer";

LPVOID ReplyBuffer;

DWORD ReplySize;

ipaddr = inet_addr( cp );

if (ipaddr == INADDR_NONE)

return 1;

hIcmpFile = IcmpCreateFile();

if (hIcmpFile == INVALID_HANDLE_VALUE)

return 2;

ReplySize = sizeof(ICMP_ECHO_REPLY) + sizeof(SendData);

ReplyBuffer = (VOID*) malloc(ReplySize);

if (ReplyBuffer == NULL)

return 3;

dwRetVal = IcmpSendEcho(hIcmpFile, ipaddr, SendData, sizeof(SendData),

NULL, ReplyBuffer, ReplySize, 1000);

if (dwRetVal == 0)

return 4;

return 0;

}

HB_FUNC( HB_PING )

{

hb_retni( hb_Ping( hb_parc( 1 ) ) );

}

#pragma ENDDUMP

IF hb_Ping( GetHostByName( ALLTRIM( cServer) ) ) == 0

cMsg := "Conexão estabelecida com Sucesso. " + CRLF + "Servidor : " + cServer + CRLF + "IP : " + AllTrim( GetHostByName( ALLTRIM(cServer) ) )

ELSE

cMsg := "Falha ao Conectar com o Servidor " + CRLF + cServer + CRLF + "Verifique a Rede!!"

ENDIF

Gilmar Silva Santos

Programador - Goiânia Go

Não Recuarei, Nada Temerei, Comigo Está o Senhor.

Email : gilmarss2010@gmail.com

FWH 10.8, DBF, MED EDITOR, UESTUDIO, XHB 1.2, BCC 5.82

[sambomb]

citação:

o comando nao funciona ou seja não grava no txt

---

id=quote>id=quote>

Tente usar assim:

//Winexec( "ping " + cIp + " -n " + AllTrim(Str(nTentativas)) + " > C:\Ping.txt" )

CmdRun( "ping " + cIp + " -n " + AllTrim(Str(nTentativas)) + " > C:\Ping.txt",,.F. )

****************************************************************************

function CmdRun(xLinhaComando, bEval, lExibe)

****************************************************************************

*

* Rodar uma linha de comando no prompt do DOS

* Parametros: xLinhaComando

* Retorno: Nenhum

*

* Autor: Samir

* 06/12/2011 - 09:33:25

*

****************************************************************************

local cFileBat := "", cTextoBat := "", i := 0, lResult := .F.

Default lExibe := .F.

//-- Verifica se é uma única linha

If ValType(xLinhaComando) = "C"

cTextoBat := xLinhaComando

//-- Verifica se são múltiplas linhas

elseIf ValType(xLinhaComando) = "A"

For i := 1 to Len(xLinhaComando)

if !Empty(cTextoBat)

cTextoBat += CRLF

end

cTextoBat += xLinhaComando

end

//-- Tratamento para parâmetro inválido

else

MsgInfo("Parâmetro inválido","CMDRUN")

Return lResult

end

//-- Gerar o nome do arquivo bat a ser executado

cFileBat := DirExe() + "CMDRUN_"+DToS(Date())+"_"+StrTran(Now(),":") + ".BAT"

//-- Roda um loop para apagar o arquivo

i := 0

While File(cFileBat)

SysRefresh()

If fErase(cFileBat) != 0

Pause(0.5)

//-- 3 tentativas "silenciosas"

If i < 3

i++

loop

end

//-- Mensagem de erro

If MsgYesNo("Erro " + UT( fError() ) + " ao apagar o arquivo: " + CRLF +;

cFileBat + CRLF +;

"Tentar novamente?")

loop

else

exit

end

else

exit

end

end

//-- Se o arquivo não existe

If !File(cFileBat)

//-- Tenta criar o arquivo bat

If CreateTxt(cFileBat,cTextoBat)

//-- Verifica se criou

i := 0

While !File(cFileBat)

SysRefresh()

Pause(0.5)

//-- 3 tentativas "silenciosas"

If i < 3

i++

loop

end

If MsgYesNo("Arquivo ainda não foi criado " + CRLF +;

"Deseja aguardar")

loop

else

exit

end

end

//-- Verifica se o arquivo foi criado com sucesso

If File(cFileBat)

lResult := .T.

//-- Executa o BAT

If lExibe

WaitRun(cFileBat,1)

else

WaitRun(cFileBat,0)

end

//-- Caso tenha sido passada uma validação, executa

If ValType(bEval) = "B"

lResult := Eval(bEval)

end

end

//-- Apaga o arquivo BAT para não deixar resíduos

i := 0

While File(cFileBat)

SysRefresh()

If fErase(cFileBat) != 0

Pause(0.5)

//-- 3 tentativas "silenciosas"

If i < 3

i++

loop

end

If MsgYesNo("Erro " + UT( fError() ) + " ao apagar o arquivo: " + CRLF +;

cFileBat + CRLF +;

"Tentar novamente?")

loop

else

exit

end

else

exit

end//If fErase(cFileBat) != 0

end//While File(cFileBat)

end//If CreateTxt(cFileBat,cTextoBat)

end//If !File(cFileBat)

Return lResult

/*------------------------------------------------------------------------*/

****************************************************************************

function CreateTxt(pcFileName, pcTxt)

****************************************************************************

/* */

/* Criar arquivo texto atraves da funcao FCreate */

/* */

****************************************************************************

local fArq, Result := .t. , nErro := 0, nCount := 3

repeat

Result := .t.

fArq := FCREATE(pcFileName)

nErro := FError()

if nErro > 0

if nCount <= 0

Msg("Erro ao criar o arquivo!;;" + MsgTxtError(nErro,pcFileName) )

end

Result := .f.

else

FWrite(fArq,pcTxt)

if FError() > 0

if nCount <= 0

Msg("Erro ao escrever no arquivo!;;" + MsgTxtError(nErro,pcFileName) )

end

Result := .f.

end

if .not. FClose(fArq)

nErro := FError()

if nCount <= 0

Msg("Erro ao fechar o arquivo!;;" + MsgTxtError(nErro,pcFileName) )

end

Result := .f.

end

end

nCount -= 1

until (nCount <= 0) .or. (nErro <= 0)

Return Result

/*------------------------------------------------------------------------*/

id=code>id=code>

RCA Sistemas - Itaocara - RJ

[Edmar Frazao]

windows 7 64 não funciona.

[sambomb]

citação:

windows 7 64 não funciona.

---

id=quote>id=quote>

aqui é win 7 32 e rodou

RCA Sistemas - Itaocara - RJ

[Edmar Frazao]

consegui usando "WScript.Shell" )

mas quando o servidor esta desligado demora uns 3 segundos.

preciso de algo mais rápido.

cip:='192.168.50.77'

nTentativas:=0

cServer:=cIP

ePING(cip,2)

****************************************************************************

function ePING(IP,xNoTentativas)

Local xArq:='C:\PING.TXT'

Local xComando:="ping " + IP + " -n " + AllTrim(Str(xNoTentativas)) + " >"+xArq

ferase(xArq)

//Funciona mas em XP tem problema nao lembro o motivo

eRun(xcomando)

//win exe não funciona win 64

//eRun2(xcomando)

//Funciona mais abre janela dos

//eRun3(xcomando)

X:=MEMOREAD(xArq)

IF 'bytes='$x

msginfo('ok')

elseIF 'inacess'$x

msginfo('Host Inacessivel')

else

MSGINFO(X)

endif

Return lResult

Function eRun(xComando)

local oShell, RET

oShell := CreateObject( "WScript.Shell" )

RET := oShell:Run( "%comspec% /c " + xComando, 0, .T. )

oShell := NIL

return

Function eRun2(xComando)

RET:=WINEXEC(xComando,1)

return

Function eRun3(xComando)

run (xcomando)

return

[Edmar Frazao]

não tenho o #include

poderia postar?

citação:

USO ESSA NO MEU SISTEMA E FUNCIONA MELHOR QUE QUALQUER OUTRA. POIS DISPARA VIA API.

#pragma BEGINDUMP

#include

#include

#include

#include

int hb_Ping( const char * cp )

{

HANDLE hIcmpFile;

unsigned long ipaddr;

DWORD dwRetVal;

char SendData[32] = "Data Buffer";

LPVOID ReplyBuffer;

DWORD ReplySize;

ipaddr = inet_addr( cp );

if (ipaddr == INADDR_NONE)

return 1;

hIcmpFile = IcmpCreateFile();

if (hIcmpFile == INVALID_HANDLE_VALUE)

return 2;

ReplySize = sizeof(ICMP_ECHO_REPLY) + sizeof(SendData);

ReplyBuffer = (VOID*) malloc(ReplySize);

if (ReplyBuffer == NULL)

return 3;

dwRetVal = IcmpSendEcho(hIcmpFile, ipaddr, SendData, sizeof(SendData),

NULL, ReplyBuffer, ReplySize, 1000);

if (dwRetVal == 0)

return 4;

return 0;

}

HB_FUNC( HB_PING )

{

hb_retni( hb_Ping( hb_parc( 1 ) ) );

}

#pragma ENDDUMP

IF hb_Ping( GetHostByName( ALLTRIM( cServer) ) ) == 0

cMsg := "Conexão estabelecida com Sucesso. " + CRLF + "Servidor : " + cServer + CRLF + "IP : " + AllTrim( GetHostByName( ALLTRIM(cServer) ) )

ELSE

cMsg := "Falha ao Conectar com o Servidor " + CRLF + cServer + CRLF + "Verifique a Rede!!"

ENDIF

Gilmar Silva Santos

Programador - Goiânia Go

Não Recuarei, Nada Temerei, Comigo Está o Senhor.

Email : gilmarss2010@gmail.com

FWH 10.8, DBF, MED EDITOR, UESTUDIO, XHB 1.2, BCC 5.82

---

id=quote>id=quote>

[Geraldo_Andrade]

Servnome := NetName()

WsaStartUp() ; cServirIP := getHostByName( servNome ) ; WsaCleanUp()

Danet := "0.0.0.0"

if !VerificaIP(Danet,4)

Danet := Sc(ServNome,cClientIP)

if !VerificaIP(Danet,4)

Danet := "localhost"

if cServirIP <> cClientIP

lMySql := .f.

endif

endif

Endif

Function VerificaIP( cIP, nTentativas )

Local Result := .F., nPos := 0, cTentativas := "", cPerdidos := ""

Local oTL := TLAGUARDE("Verificando "+cIp,"Aguarde...")

Default cIp := "192.168.1.2", nTentativas := 10

fErase(Dirt+"\RetIp.txt")

SysRefresh()

************************************************************************************************************

cZecuta := "ping " + cIp + " -n " + AllTrim(Str(nTentativas)) + " > RetIp.txt" //"+Dirt+"\RetIp.txt"

RUN(cZecuta)

*WinExec(cZecuta)

*Esperar(nTentativas)

************************************************

cTexto := MemoRead(Dirt+"\RetIp.txt")

nPos := At("Enviados = ",cTexto)

cTentativas := sonumero(SubStr(cTexto,nPos+11,2))

nPos := At("Perdidos = ",cTexto)

cPerdidos := sonumero(SubStr(cTexto,nPos+11,2))

If cTentativas = cPerdidos

Result := .F.

else

Result := .T.

end

oTl:End()

Return( Result )

****************

Usando winexec(...), nao grava o arquivo de texto, usando o velho run() ele grava a desvantagem e a tela do simulador de D.O.S. que aparece enquanto executa.

Geraldo Andrade

geraldo_andrade@hotmail.com

[Geraldo_Andrade]

Servnome := NetName()

WsaStartUp() ; cServirIP := getHostByName( servNome ) ; WsaCleanUp()

Danet := "0.0.0.0"

if !VerificaIP(Danet,4)

Danet := Sc(ServNome,cClientIP)

if !VerificaIP(Danet,4)

Danet := "localhost"

if cServirIP <> cClientIP

lMySql := .f.

endif

endif

Endif

Function VerificaIP( cIP, nTentativas )

Local Result := .F., nPos := 0, cTentativas := "", cPerdidos := ""

Local oTL := TLAGUARDE("Verificando "+cIp,"Aguarde...")

Default cIp := "192.168.1.2", nTentativas := 10

fErase(Dirt+"\RetIp.txt")

SysRefresh()

************************************************************************************************************

cZecuta := "ping " + cIp + " -n " + AllTrim(Str(nTentativas)) + " > RetIp.txt" //"+Dirt+"\RetIp.txt"

RUN(cZecuta)

*WinExec(cZecuta)

*Esperar(nTentativas)

************************************************

cTexto := MemoRead(Dirt+"\RetIp.txt")

nPos := At("Enviados = ",cTexto)

cTentativas := sonumero(SubStr(cTexto,nPos+11,2))

nPos := At("Perdidos = ",cTexto)

cPerdidos := sonumero(SubStr(cTexto,nPos+11,2))

If cTentativas = cPerdidos

Result := .F.

else

Result := .T.

end

oTl:End()

Return( Result )

****************

Usando winexec(...), nao grava o arquivo de texto, usando o velho run() ele grava a desvantagem e a tela do simulador de D.O.S. que aparece enquanto executa.

Geraldo Andrade

geraldo_andrade@hotmail.com

[Geraldo_Andrade]

meubanc:= trim(Subpasta)

rMySql := "C:\ProgramData\MySQL\MySQL Server 5.5\data"

oKI := FOPEN(rMySql+"\"+alltrim(SubPasta)+"\LINE.ONL")

nEr := FERROR()

lMySql := nEr < 3

WsaStartUp() ; cServirIP := getHostByName( servNome ) ; WsaCleanUp()

WsaStartUp() ; cClientIP := getHostByName( netname()) ; WsaCleanUp()

Danet := "0.0.0.0"

if !VerificaIP(Danet,4)

Danet := Sc(ServNome,cClientIP)

if !VerificaIP(Danet,4)

Danet := "localhost"

if cServirIP <> cClientIP

lMySql := .f.

endif

endif

Endif

if lMySql

SQL CONNECT ON Danet ;

PORT 3306 ;

USER 'root' ;

DATABASE meubanc ;

PASSWORD '1234' ;

LIB 'MySQL' ;

IF SQLErrorNO() > 0

alert( 'Não conectou' )

return(.f.)

else

MsgWait("Conctado com Sucesso",'Ok!',1 )

endif

Else

MsgWait("Desconctado",'Atencao!',1 )

Endif

Return(nil)

**-------------------------------------------------------------------------**

Function VerificaIP( cIP, nTentativas )

Local Result := .F., nPos := 0, cTentativas := "", cPerdidos := ""

Local oTL := TLAGUARDE("Verificando "+cIp,"Aguarde...")

Default cIp := "192.168.1.2", nTentativas := 10

fErase(Dirt+"\RetIp.txt")

SysRefresh()

************************************************

cZecuta := "ping " + cIp + " -n " + AllTrim(Str(nTentativas)) + " > RetIp.txt" //"+Dirt+"\RetIp.txt"

RUN(cZecuta)

*WinExec(cZecuta)

*Esperar(nTentativas)

************************************************

cTexto := MemoRead(Dirt+"\RetIp.txt")

nPos := At("Enviados = ",cTexto)

cTentativas := sonumero(SubStr(cTexto,nPos+11,2))

nPos := At("Perdidos = ",cTexto)

cPerdidos := sonumero(SubStr(cTexto,nPos+11,2))

If cTentativas = cPerdidos

Result := .F.

else

Result := .T.

end

oTl:End()

Return( Result )

****************

Usando winexec(...), nao grava o arquivo de texto, usando o velho run() ele grava a desvantagem e a tela do simulador de D.O.S. que aparece enquanto executa.

Geraldo Andrade

geraldo_andrade@hotmail.com