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

我创建了一个Ping函数，它利用Indy TIdIcmpClient对象。多年来，它一直工作得完美无缺。从XE3升级到XE4后，相同的代码现在生成错误10040（消息太长）

我读过其他关于这个错误和建议解决方案的帖子，但没有一篇是100%成功的

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

TIdIcmpClient的修复程序已在进行中，但尚未发布，目前我还没有该版本的预计到达时间。

您必须设置一个选项，例如：

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

---

Jan

我可以确认，至少在Remy和他的团队发布他们自己的修复程序之前，IDICMPClient组件已经起到了作用。不幸的是，我已经这样做了（在上面的代码中）。这是大多数时候的工作，但偶尔会引起例外。@ ReMyLeBeAu，现在是FEB，2014，我使用的是C++ +Builder XE5，用的是YNY10<代码> TIdiMPPosiple Pin（）/<代码>，这个问题仍然存在。你们是在做这件事还是已经发布了更新/修复程序？对不起，我还没有任何空闲时间来处理这个问题。在我的日常工作和我的家庭之间，我忙得不可开交，没有以前那样的业余时间。它仍然在我的待办事项清单上。我对

TIdIcmpClient

做了一些更改，但还没有测试它们。