Delphi 實現專線狀態探測：基於 ICMP.DLL 的 Ping 監控方案

需求背景

網管需實時監測專線節點連通性，傳統手工 ping/tracert 效率低。Windows 系統目錄下的 ICMP.DLL 封裝了完整 ICMP 協議，通過動態加載調用其導出函數，可在 Delphi 中實現無控制台、可定制的自動化探測程序。

核心 API 函數

實現步驟與關鍵代碼

1. 初始化 WinSock 並加載 ICMP.DLL

var
  wsadata: TWSAData;
  hICMPlib, hICMP: THandle;
  ICMPCreateFile: function: THandle; stdcall;
  IcmpCloseHandle: function(h: THandle): BOOL; stdcall;
  IcmpSendEcho: function(h: THandle; DestAddress: DWORD; RequestData: Pointer;
    RequestSize: Word; RequestOptions: PIPOptionInformation;
    ReplyBuffer: Pointer; ReplySize: DWORD; Timeout: DWORD): DWORD; stdcall;

procedure InitICMP;
begin
  if WSAStartup($101, wsadata) <> 0 then raise Exception.Create('WinSock 初始化失敗');
  hICMPlib := LoadLibrary('ICMP.DLL');
  if hICMPlib = 0 then raise Exception.Create('無法加載 ICMP.DLL');
  @ICMPCreateFile := GetProcAddress(hICMPlib, 'IcmpCreateFile');
  @IcmpCloseHandle := GetProcAddress(hICMPlib, 'IcmpCloseHandle');
  @IcmpSendEcho := GetProcAddress(hICMPlib, 'IcmpSendEcho');
  if not Assigned(ICMPCreateFile) or not Assigned(IcmpCloseHandle) or not Assigned(IcmpSendEcho) then
    raise Exception.Create('獲取 ICMP 函數地址失敗');
  hICMP := ICMPCreateFile;
  if hICMP = INVALID_HANDLE_VALUE then raise Exception.Create('無法創建 ICMP 句柄');
end;

2. 定時器驅動探測邏輯

procedure TForm1.Timer1Timer(Sender: TObject);
var net_ip: string; net_stat, net: Integer; I: Integer;
begin
  net := 0; // 全局異常標志
  Table1.First;
  while not Table1.Eof do
  begin
    net_ip := Table1.FieldByName('對端IP').AsString;
    TestPort(net_ip, net_stat); // 調用下方探測函數
    if net_stat = 0 then
    begin
      Table1.Edit; Table1.FieldByName('狀態').AsString := '中斷'; Table1.Post;
      if net = 0 then net := 1;
    end
    else
    begin
      Table1.Edit; Table1.FieldByName('狀態').AsString := '正常'; Table1.Post;
    end;
    Table1.Next;
  end;
  if net = 1 then for I := 1 to 10 do PlaySound('RINGIN', 0, SND_RESOURCE); // 報警
end;

3. 核心探測函數：TestPort

const Size = 56; TimeOut = 3000; // 56 字節數據包，3 秒超時
procedure TestPort(const IpStr: string; var Stat: Integer);
var
  Address: DWORD; HostName, HostIP: string; Phe: PHostEnt;
  BufferSize, nPkts: Integer; pReqData, pData: Pointer; pIPE: PIcmpEchoReply;
  IPOpt: TIPOptionInformation;
begin
  Stat := 0; // 默認異常
  Address := inet_addr(PAnsiChar(IpStr)); // 字符串 IP -> DWORD
  if Address = INADDR_NONE then Exit;
  Phe := gethostbyaddr(@Address, 4, PF_INET); // 反向解析 (可選)

  BufferSize := SizeOf(TIcmpEchoReply) + Size;
  GetMem(pReqData, Size); FillChar(pReqData^, Size, $AA); // 填充 0xAA 模式
  GetMem(pData, Size);
  GetMem(pIPE, BufferSize);
  pIPE^.Data := pData;
  FillChar(IPOpt, SizeOf(IPOpt), 0); IPOpt.TTL := 64;

  // 發送請求並等待回應
  nPkts := IcmpSendEcho(hICMP, Address, pReqData, Size, @IPOpt, pIPE, BufferSize, TimeOut);

  if nPkts > 0 then
  begin
    HostIP := string(inet_ntoa(TInAddr(pIPE^.Address))); // 回應源 IP
    if Trim(HostIP) = Trim(IpStr) then Stat := 1; // IP 匹配視為正常
  end;

  FreeMem(pIPE); FreeMem(pData); FreeMem(pReqData);
end;

4. 程序退出清理

procedure CleanupICMP;
begin
  IcmpCloseHandle(hICMP);
  FreeLibrary(hICMPlib);
  WSACleanup;
end;

功能擴展建議

1. 故障日誌表：記錄故障時間、節點 IP、恢復時間、處理人、處理措施。
2. 探測間隔配置表：支持不同節點差異化探測頻率（核心節點 10 秒，邊緣節點 60 秒）。
3. 節點庫維護模塊：增刪改查節點 IP、名稱、負責人、告警閾值。
4. 可視化增強：DBGrid 配合 OnDrawColumnCell 將異常行標紅、閃爍；系統托盤圖標顯示整體狀態。
5. 多線程並發探測：節點數大時，使用線程池並發 IcmpSendEcho，避免串行超時拖慢周期。

注意事項

• ICMP.DLL 為系統內部 DLL，未官方文檔化，但在 Windows 2000/XP/2003/Vista/7/10/11 上均穩定存在。
• 需管理員權限運行（原始套接字/ICMP 特權），或通過清單 requireAdministrator 提升。
• 防火牆可能阻攔 ICMP 回應，導致誤判斷斷。生產環境建議結合 TCP 端口探測雙重驗證。
• Delphi 2009+ 字符串為 Unicode，網絡 API 需 PAnsiChar/AnsiString，注意轉換。

總結

利用 ICMP.DLL 實現專線探測，無需外部依賴、無控制台彈出、可深度集成到 Delphi 管理系統中。結合數據庫驅動的節點配置、定時器調度、聲光報警，可快速構建輕量級網管監控模塊。