3

Indy TIdIcmpClient オブジェクトを利用する Ping 関数を作成しました。それは何年もの間完璧に機能しました。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;

御時間ありがとうございます、

少し

4

2 に答える 2

1

の修正TIdIcmpClientは既に進行中ですが、まだリリースされておらず、現時点でそのリリースの ETA はありません。

于 2013-06-12T16:33:54.363 に答える