| Exibir mensagem anterior :: Exibir próxima mensagem |
| Autor |
Mensagem |
Tchock
Colaborador
Registrado: Domingo, 18 de Julho de 2004
Mensagens: 1242
|
 Enviada: Ter Ago 27, 2013 11:45 am Assunto: Erro ao Dar um Ping |
 |
|
Pessoal estavo usando o delphi 2010 e resolvi mudar para o Delphi XE4 e estou com um problema em uma função abaixo
| Código: | function ExecutaPing(HostName: String): boolean;
var
PckEntregue : Array[1..3] of Integer;
ICMP : TIdIcmpClient;
begin
try
ICMP := TIdIcmpClient.Create(nil);
try
ICMP.Host := HostName;
ICMP.ReceiveTimeout := 500;
ICMP.Ping;
if ICMP.ReplyStatus.BytesReceived > 0 then
result := true
else
result := false;
except
result := false;
end;
finally
ICMP.Destroy;
end;
end; |
no D2010 funciona certinho no XE4 m retornar o erro Socket Error 10040 message too long
alguem saberia m dizer oq pode ser isso... |
|
| Voltar ao Topo |
|
 |
cyberdisk
Colaborador
Registrado: Domingo, 4 de Julho de 2010
Mensagens: 2391
Localização: São José dos Campos - SP
|
| Enviada: Ter Ago 27, 2013 7:30 pm Assunto: |
|
|
Socket Error 10040 message too long
Socket Error 10040 mensagem muito longa
| Código: | Function Ping(Host: String;Timeout: Integer;ShowError: Boolean; out ErrorText: String): Boolean;
var
IdIcmpClient1: TIdIcmpClient;
Reply: TReplyStatusTypes;
ErrorFlag: Boolean;
ABuffer: String;
begin
Result:=False;
ErrorText:='Success';
ErrorFlag:=False;
Reply:=rsEcho;
ABuffer:=Host+StringOfChar(' ',255);
IdIcmpClient1:=TIdIcmpClient.Create;
IdIcmpClient1.PacketSize:=32;
IdIcmpClient1.Host:=Host;
IdIcmpClient1.ReceiveTimeout:=Timeout;
try
try
IdIcmpClient1.Ping(ABuffer);
except
on E: Exception do
begin
ErrorFlag:=True;
ErrorText:=E.Message;
if ShowError then MessageDlg('Ping Error: '+E.Message, mtWarning, [mbOK], 0);
end;
end;
if not ErrorFlag then
begin
try
Reply:=IdIcmpClient1.ReplyStatus.ReplyStatusType;
except
on E: Exception do
begin
ErrorFlag:=True;
ErrorText:=E.Message;
if ShowError then MessageDlg('Ping Reply Error: '+ErrorText, mtWarning, [mbOK], 0);
end;
end;
end;
if not ErrorFlag then
begin
Result:=Reply=rsEcho;
if not Result then
begin
case Reply of
rsEcho: ErrorText:='rsEcho';
rsError: ErrorText:='rsError';
rsTimeOut: ErrorText:='rsTimeOut';
rsErrorUnreachable: ErrorText:='rsErrorUnreachable';
rsErrorTTLExceeded: ErrorText:='rsErrorTTLExceeded';
rsErrorPacketTooBig: ErrorText:='rsErrorPacketTooBig';
rsErrorParameter: ErrorText:='rsErrorParameter';
rsErrorDatagramConversion: ErrorText:='rsErrorDatagramConversion';
rsErrorSecurityFailure: ErrorText:='rsErrorSecurityFailure';
rsSourceQuench: ErrorText:='rsSourceQuench';
rsRedirect: ErrorText:='rsRedirect';
rsTimeStamp: ErrorText:='rsTimeStamp';
rsInfoRequest: ErrorText:='rsInfoRequest';
rsAddressMaskRequest: ErrorText:='rsAddressMaskRequest';
rsTraceRoute: ErrorText:='rsTraceRoute';
rsMobileHostReg: ErrorText:='rsMobileHostReg';
rsMobileHostRedir: ErrorText:='rsMobileHostRedir';
rsIPv6WhereAreYou: ErrorText:='rsIPv6WhereAreYou';
rsIPv6IAmHere: ErrorText:='rsIPv6IAmHere';
rsSKIP: ErrorText:='rsSkip';
else
ErrorText:='Unknown';
end;
if ShowError then MessageDlg('Ping Error: '+ErrorText, mtWarning, [mbOK], 0);
end;
end;
finally
IdIcmpClient1.Free;
end;
end;
|
_________________
O conhecimento abre muitas portas |
|
| Voltar ao Topo |
|
|
Tchock
Colaborador
Registrado: Domingo, 18 de Julho de 2004
Mensagens: 1242
|
| Enviada: Ter Ago 27, 2013 9:47 pm Assunto: |
|
|
| Não entendi o seu post essa é a solução para o XE4 ou esta acontecendo o mesmo erro com a sua função... |
|
| Voltar ao Topo |
|
|
cyberdisk
Colaborador
Registrado: Domingo, 4 de Julho de 2010
Mensagens: 2391
Localização: São José dos Campos - SP
|
| Enviada: Ter Ago 27, 2013 10:22 pm Assunto: |
|
|
teste essa função no XE4
abraço
_________________
O conhecimento abre muitas portas |
|
| Voltar ao Topo |
|
|
|
FAQ
Pesquisar
Membros
Grupos
Registrar
Perfil
Entrar e ver Mensagens Particulares
Entrar
