我创建了一个Ping函数,它使用Indy TIdIcmpClient对象。多年来一直运行得很好。从XE3升级到XE4后,相同的代码现在生成错误10040(消息太长)。
我阅读了其他帖子关于此错误和提出的解决方案,但它们中没有一个能够百分之百成功。
我已将数据包大小减小到32、24、12甚至0,但仍然会出现10040错误。
我尝试使用可选参数“Buffer”,这有点有效,但偶尔会引起其他异常。
有人有任何想法如何解决这个问题吗?
以下是我的代码:
感谢您的时间, Tad
我阅读了其他帖子关于此错误和提出的解决方案,但它们中没有一个能够百分之百成功。
我已将数据包大小减小到32、24、12甚至0,但仍然会出现10040错误。
我尝试使用可选参数“Buffer”,这有点有效,但偶尔会引起其他异常。
有人有任何想法如何解决这个问题吗?
以下是我的代码:
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;
感谢您的时间, Tad