GetAdaptersInfo无法在Delphi XE6上运行

时间:2014-05-09 11:52:01

标签: delphi delphi-xe6

我终于咬了一口并购买了XE6,正如预期的那样,Unicode转换变成了一个噩梦。因此,如果有人能够告诉我为什么这个简单的Windows API调用失败,那将是非常感激的。该函数不返回错误,第一次调用获取正确的缓冲区长度,第二次调用用垃圾填充记录。

这在Delphi 2007下运行正常,但在pAdapterinfo返回记录中使用unicode垃圾在XE6上失败,即使它在IpTypes.pas中使用AnsiString显式声明

系统是Win7(64),但编译为32位。

uses iphlpapi, IpTypes;

function GetFirstAdapterMacAddress:AnsiString;
var pAdapterInfo:PIP_ADAPTER_INFO;
    BufLen,Status:cardinal; i:Integer;
begin
  result:='';
  BufLen:= sizeof(IP_ADAPTER_INFO);
  GetAdaptersInfo(nil, BufLen);
  pAdapterInfo:= AllocMem(BufLen);
  try
    Status:= GetAdaptersInfo(pAdapterInfo,BufLen);
    if (Status <> ERROR_SUCCESS) then
    begin
      case Status of
        ERROR_NOT_SUPPORTED: raise exception.create('GetAdaptersInfo is not supported by the operating ' +
                                     'system running on the local computer.');
        ERROR_NO_DATA: raise exception.create('No network adapter on the local computer.');
      else
        raiselastOSerror;
      end;
      Exit;
    end;
    while (pAdapterInfo^.AddressLength=0) and (pAdapterInfo^.next<>nil) do
     pAdapterInfo:=pAdapterInfo.next;
    if pAdapterInfo^.AddressLength>0 then
    for i := 0 to pAdapterInfo^.AddressLength - 1 do
      result := result + IntToHex(pAdapterInfo^.Address[I], 2);
  finally
    Freemem(pAdapterInfo);
  end;
end;

更新:

我做了一些检查。我用一个表单和一个按钮创建了一个新的简单应用程序,并在按下按钮时调用例程。它可以工作。

差异是......在工作形式中,IP_ADAPTER_INFO的大小是640字节。

在更复杂的应用程序中使用此例程时,它会失败,并且IP_ADAPTER_INFO的大小显示为1192字节。

此时,似乎编制者单方面决定将结构中的ansi字符类型更改为unicode字符。调试器以unicode形式显示AdapterName和description字段。我做了系统源代码的grep,除了Indy库之外,库代码中没有声明这种数据类型的其他版本,这只是重复。

这是IPtypes中的数据结构定义

  PIP_ADAPTER_INFO = ^IP_ADAPTER_INFO;
  {$EXTERNALSYM PIP_ADAPTER_INFO}
  _IP_ADAPTER_INFO = record
    Next: PIP_ADAPTER_INFO;
    ComboIndex: DWORD;
    AdapterName: array [0..MAX_ADAPTER_NAME_LENGTH + 3] of AnsiChar;
    Description: array [0..MAX_ADAPTER_DESCRIPTION_LENGTH + 3] of AnsiChar;
    AddressLength: UINT;
    Address: array [0..MAX_ADAPTER_ADDRESS_LENGTH - 1] of BYTE;
    Index: DWORD;
    Type_: UINT;
    DhcpEnabled: UINT;
    CurrentIpAddress: PIP_ADDR_STRING;
    IpAddressList: IP_ADDR_STRING;
    GatewayList: IP_ADDR_STRING;
    DhcpServer: IP_ADDR_STRING;
    HaveWins: BOOL;
    PrimaryWinsServer: IP_ADDR_STRING;
    SecondaryWinsServer: IP_ADDR_STRING;
    LeaseObtained: time_t;
    LeaseExpires: time_t;
  end;

看起来像编译器错误。

3 个答案:

答案 0 :(得分:3)

您的代码存在一些问题:

  1. 在计算缓冲区长度的第一次调用中,您根本没有进行任何错误处理。你甚至不需要那个电话,所以要摆脱它。

  2. 您在后续调用中没有进行足够的错误处理,特别是当ERROR_BUFFER_OVERFLOW需要您分配比现有内存更多的内存时,您没有处理GetAdaptersInfo()条件。您只为一个适配器分配了足够的内存,但GetAdaptersInfo()返回所有适配器的信息,因此需要一个足够的缓冲区来同时保存所有适配器。

  3. GetAdaptersInfo()未使用GetLastError(),因此您需要在致电SetLastError()之前致电RaiseLastOSError()

  4. 使用用于分配列表的原始指针循环遍历适配器列表,因此如果第一个适配器没有MAC地址,则会导致内存泄漏。您需要使用单独的变量作为循环迭代器,以便保留原始指针,以便可以正确释放它。

  5. 您没有考虑到所有适配器都没有MAC地址的可能性,因此您将在nil循环退出后最终访问while指针。

  6. 您的计算机上似乎有IpTypes个单元的多个版本,并且编译器正在Char中找到恰好使用AnsiChar而不是IP_ADAPTER_INFO的版本1}}记录所以它的大小和字段偏移是错误的。

  7. 话虽如此,试试这个:

    uses
      Winapi.iphlpapi, Winapi.IpTypes;
    
    function GetFirstAdapterMacAddress: String;
    var
      pAdapterList, pAdapter: PIP_ADAPTER_INFO;
      BufLen, Status: DWORD;
      I: Integer;
    begin
      Result := '';
      BufLen := 1024*15;
      GetMem(pAdapterList, BufLen);
      try
        repeat
          Status := GetAdaptersInfo(pAdapterList, BufLen);
          case Status of
            ERROR_SUCCESS:
            begin
              // some versions of Windows return ERROR_SUCCESS with
              // BufLen=0 instead of returning ERROR_NO_DATA as documented...
              if BufLen = 0 then begin
                raise Exception.Create('No network adapter on the local computer.');
              end;
              Break;
            end;
            ERROR_NOT_SUPPORTED:
            begin
              raise Exception.Create('GetAdaptersInfo is not supported by the operating system running on the local computer.');
            end;
            ERROR_NO_DATA:
            begin
              raise Exception.Create('No network adapter on the local computer.');
            end;
            ERROR_BUFFER_OVERFLOW:
            begin
              ReallocMem(pAdapterList, BufLen);
            end;
          else
            SetLastError(Status);
            RaiseLastOSError;
          end;
        until False;
    
        pAdapter := pAdapterList;
        while pAdapter <> nil do
        begin
          if pAdapter^.AddressLength > 0 then
          begin
            for I := 0 to pAdapter^.AddressLength - 1 do begin
              Result := Result + IntToHex(pAdapter^.Address[I], 2);
            end;
            Exit;
          end;
          pAdapter := pAdapter^.next;
        end;
      finally
        FreeMem(pAdapterList);
      end;
    end;
    

答案 1 :(得分:1)

解释是,您的第三方IpTypes单元中声明的类型使用Char。这是Unicode前Delphi中AnsiChar的别名,Unicode Delphi中是WideChar的别名。这可以解释当您检查记录内容时看到非ANSI文本的事实。

解决方案是修复IpTypes以在适当的位置使用AnsiChar代替Char。最好的方法是使用Delphi附带的IpTypes而不是第三方版本。

最重要的是,第一次调用GetAdaptersInfo是错误的。您不仅无法检查返回值,而且还为缓冲区传递了nil,并且还传递了非零长度。我认为它应该是这样的:

BufLen := 0;
if GetAdaptersInfo(nil, BufLen) <> ERROR_BUFFER_OVERFLOW then
  raise ....

当然,你的方式会起作用,但我在这里只是一个小小的迂腐。调用API函数时,请务必检查错误。

答案 2 :(得分:0)

结束这个话题。

将IPtypes更改为winapi.IPtypes为我解决了这个问题。

我认为第三方组件正在做一些事情来混淆编译器并给予完整链接修复它。