Question

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

我阅读了有关此错误和建议的解决方案的其他帖子，但没有一个能够100％成功。

我将数据包大小减少到32,24,12甚至0，但仍然会出现10040错误。

我尝试使用可选参数“缓冲区”，它有点工作但偶尔会导致其他异常。

任何人对如何解决这个问题都有任何想法？

这是我的代码：

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;

感谢您的时间，

泰德

Answer 1

TIdIcmpClient的修正已经在进行中，但尚未发布，目前我还没有针对该版本的ETA。

Answer 2

你必须设置ABuffer，例如：

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

扬

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

2 个答案: