Delphi Indy Ping 在从 XE3 升级到 XE4 后出现 Error 10040 错误

Question

我创建了一个Ping函数，它使用Indy TIdIcmpClient对象。多年来一直运行得很好。从XE3升级到XE4后，相同的代码现在生成错误10040（消息太长）。

我阅读了其他帖子关于此错误和提出的解决方案，但它们中没有一个能够百分之百成功。

我已将数据包大小减小到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

- Tad Adams

Answer 1

你必须设置ABuffer，例如：

            Host := 'some.server.net';
            PacketSize := 24;
            ReceiveTimeout := 200;
            ABuffer := Host + StringOfChar(' ', 255);
            Ping(ABuffer);

Jan

- Jan

---

我可以确认，这个在IDICMPClient组件上是有效的，至少在Remy和他的团队发布自己的修复之前。 - Scott P

不幸的是，我已经在做这件事了（它在上面的代码中）。这通常可以工作，但偶尔会引起异常。 - Tad Adams

Answer 2

TIdIcmpClient 的修复正在进行中，但尚未发布，目前我无法确定发布时间。

- Remy Lebeau

---

@RemyLebeau，现在是2014年2月，我正在使用带有Indy10的C++ Builder XE5 TIdIcmpClient Ping()，这个问题仍然存在。你们正在处理这个问题吗？或者已经发布了更新/修复吗？ - Max Kielland

抱歉，我还没有任何空闲时间来解决这个问题。在我的日常工作和家庭之间，我很忙碌，没有以前那种闲暇时间。这仍然在我的待办列表上。我对TIdIcmpClient进行了一些更改，但尚未测试。 - Remy Lebeau