使用 Delphi 检测互联网连接激活

2024-03-15

我使用 3G 无线卡已经有一段时间了,每次连接时,我的防病毒软件都会启动更新。

我想知道我可以使用哪些 Win32 API 函数集来获取通知或查询即将出现的 Internet 连接事件?

Delphi 已经有一组移植的标头了吗?


我参与了一个项目,每当用户通过 VPN 连接我们的网络时,就会运行用户的登录脚本。为此,我编写了一个辅助单元,用于检索适配器信息并将其存储到一个简单的记录中。

然后我设置了一个注册表通知,请参阅此处了解如何在 Delphi 中执行此操作 http://delphi.about.com/od/kbwinshell/l/aa052003a.htm

注册表通知已开启HKLM\SYSTEM\CurrentControlSet\Services\Tcpip\Parameters\Interfaces。每当 Windows 获取新的 IP 地址或对适配器连接信息进行任何类型的更改时,都会触发此通知事件。当此事件触发时,我调用该函数(在下面的代码中)来检索有关适配器的更新信息。我将这个新信息与之前记录的信息进行了比较...这意味着我必须保存之前的适配器信息查询才能知道是否有某些内容发生了变化。

无论如何,这是我的辅助单元:

unit uAdapterInfo;

interface

uses
  Classes,
  SysUtils;

const
  MAX_INTERFACE_NAME_LEN = $100;
  ERROR_SUCCESS   = 0;
  MAXLEN_IFDESCR  = $100;
  MAXLEN_PHYSADDR = 8;

  MIB_IF_OPER_STATUS_NON_OPERATIONAL = 0;
  MIB_IF_OPER_STATUS_UNREACHABLE = 1;
  MIB_IF_OPER_STATUS_DISCONNECTED = 2;
  MIB_IF_OPER_STATUS_CONNECTING  = 3;
  MIB_IF_OPER_STATUS_CONNECTED   = 4;
  MIB_IF_OPER_STATUS_OPERATIONAL = 5;

  MIB_IF_TYPE_OTHER    = 1;
  MIB_IF_TYPE_ETHERNET = 6;
  MIB_IF_TYPE_TOKENRING = 9;
  MIB_IF_TYPE_FDDI     = 15;
  MIB_IF_TYPE_PPP      = 23;
  MIB_IF_TYPE_LOOPBACK = 24;
  MIB_IF_TYPE_SLIP     = 28;

  MIB_IF_ADMIN_STATUS_UP      = 1;
  MIB_IF_ADMIN_STATUS_DOWN    = 2;
  MIB_IF_ADMIN_STATUS_TESTING = 3;

  _MAX_ROWS_ = 20;
  ANY_SIZE   = 1;


type
  MIB_IFROW = record
    wszName:    array[0 .. (MAX_INTERFACE_NAME_LEN * 2 - 1)] of ansichar;
    dwIndex:    longint;
    dwType:     longint;
    dwMtu:      longint;
    dwSpeed:    longint;
    dwPhysAddrLen: longint;
    bPhysAddr:  array[0 .. (MAXLEN_PHYSADDR - 1)] of byte;
    dwAdminStatus: longint;
    dwOperStatus: longint;
    dwLastChange: longint;
    dwInOctets: longint;
    dwInUcastPkts: longint;
    dwInNUcastPkts: longint;
    dwInDiscards: longint;
    dwInErrors: longint;
    dwInUnknownProtos: longint;
    dwOutOctets: longint;
    dwOutUcastPkts: longint;
    dwOutNUcastPkts: longint;
    dwOutDiscards: longint;
    dwOutErrors: longint;
    dwOutQLen:  longint;
    dwDescrLen: longint;
    bDescr:     array[0 .. (MAXLEN_IFDESCR - 1)] of ansichar;
  end;

type
  MIB_IPADDRROW = record
    dwAddr:      longint;
    dwIndex:     longint;
    dwMask:      longint;
    dwBCastAddr: longint;
    dwReasmSize: longint;
    unused1:     word;
    unused2:     word;
  end;

type
  _IfTable = record
    nRows: longint;
    ifRow: array[1.._MAX_ROWS_] of MIB_IFROW;
  end;

type
  _IpAddrTable = record
    dwNumEntries: longint;
    table: array[1..ANY_SIZE] of MIB_IPADDRROW;
  end;



function GetIfTable(pIfTable: Pointer; var pdwSize: longint; bOrder: longint): longint;
  stdcall;
function GetIpAddrTable(pIpAddrTable: Pointer; var pdwSize: longint;
  bOrder: longint): longint; stdcall;

function Get_if_type(iType: integer): string;
function Get_if_admin_status(iStatus: integer): string;
function Get_if_oper_status(iStatus: integer): string;


implementation

function GetIfTable; stdcall; external 'IPHLPAPI.DLL';
function GetIpAddrTable; stdcall; external 'IPHLPAPI.DLL';

function Get_if_type(iType: integer): string;
var
  sResult: string;
begin
  sResult := 'UNKNOWN';
  case iType of
    1: sResult   := 'Other';
    6: sResult   := 'Ethernet';
    9: sResult   := 'Tokenring';
    15: sResult  := 'FDDI';
    23: sResult  := 'PPP';
    24: sResult  := 'Local loopback';
    28: sResult  := 'SLIP';
    37: sResult  := 'ATM';
    71: sResult  := 'IEEE 802.11';
    131: sResult := 'Tunnel';
    144: sResult := 'IEEE 1394 (Firewire)';
  end;

  Result := sResult;
end;

function Get_if_admin_status(iStatus: integer): string;
var
  sResult: string;
begin
  sResult := 'UNKNOWN';

  case iStatus of
    1: sResult := 'UP';
    2: sResult := 'DOWN';
    3: sResult := 'TESTING';
  end;

  Result := sResult;
end;

function Get_if_oper_status(iStatus: integer): string;
var
  sResult: string;
begin
  sResult := 'UNKNOWN';

  case iStatus of
    0: sResult := 'NON_OPERATIONAL';
    1: sResult := 'UNREACHABLE';
    2: sResult := 'DISCONNECTED';
    3: sResult := 'CONNECTING';
    4: sResult := 'CONNECTED';
    5: sResult := 'OPERATIONAL';
  end;

  Result := sResult;
end;

end.

为了从另一个单元使用这个单元,我创建了以下函数,它填充了一个名为的自定义类型TAdapterInfo(在我的主单位声明):

type
  TAdapterInfo = array of record
    dwIndex:    longint;
    dwType:     longint;
    dwMtu:      longint;
    dwSpeed:    extended;
    dwPhysAddrLen: longint;
    bPhysAddr:  string;
    dwAdminStatus: longint;
    dwOperStatus: longint;
    dwLastChange: longint;
    dwInOctets: longint;
    dwInUcastPkts: longint;
    dwInNUcastPkts: longint;
    dwInDiscards: longint;
    dwInErrors: longint;
    dwInUnknownProtos: longint;
    dwOutOctets: longint;
    dwOutUcastPkts: longint;
    dwOutNUcastPkts: longint;
    dwOutDiscards: longint;
    dwOutErrors: longint;
    dwOutQLen:  longint;
    dwDescrLen: longint;
    bDescr:     string;
    sIpAddress: string;
    sIpMask:    string;
  end;

///////////////////

function Get_EthernetAdapterDetail(var AdapterDataFound: TAdapterInfo): boolean;
var
  pIfTable: ^_IfTable;
  pIpTable: ^_IpAddrTable;
  ifTableSize, ipTableSize: longint;
  tmp:      string;
  i, j, k, m: integer;
  ErrCode:  longint;
  sAddr, sMask: in_addr;
  IPAddresses, IPMasks: TStringList;
  sIPAddressLine, sIPMaskLine: string;
  bResult:  boolean;
begin
  bResult  := True; //default return value
  pIfTable := nil;
  pIpTable := nil;

  IPAddresses := TStringList.Create;
  IPMasks     := TStringList.Create;

  try
    // First: just get the buffer size.
    // TableSize returns the size needed.
    ifTableSize := 0; // Set to zero so the GetIfTabel function
    // won't try to fill the buffer yet,
    // but only return the actual size it needs.
    GetIfTable(pIfTable, ifTableSize, 1);
    if (ifTableSize < SizeOf(MIB_IFROW) + Sizeof(longint)) then
    begin
      bResult := False;
      Result  := bResult;
      Exit; // less than 1 table entry?!
    end;

    ipTableSize := 0;
    GetIpAddrTable(pIpTable, ipTableSize, 1);
    if (ipTableSize < SizeOf(MIB_IPADDRROW) + Sizeof(longint)) then
    begin
      bResult := False;
      Result  := bResult;
      Exit; // less than 1 table entry?!
    end;

    // Second:
    // allocate memory for the buffer and retrieve the
    // entire table.
    GetMem(pIfTable, ifTableSize);
    ErrCode := GetIfTable(pIfTable, ifTableSize, 1);

    if ErrCode <> ERROR_SUCCESS then
    begin
      bResult := False;
      Result  := bResult;
      Exit; // OK, that did not work. 
      // Not enough memory i guess.
    end;

    GetMem(pIpTable, ipTableSize);
    ErrCode := GetIpAddrTable(pIpTable, ipTableSize, 1);

    if ErrCode <> ERROR_SUCCESS then
    begin
      bResult := False;
      Result  := bResult;
      Exit;
    end;

    for k := 1 to pIpTable^.dwNumEntries do
    begin
      sAddr.S_addr := pIpTable^.table[k].dwAddr;
      sMask.S_addr := pIpTable^.table[k].dwMask;

      sIPAddressLine := Format('0x%8.8x', [(pIpTable^.table[k].dwIndex)]) +
        '=' + Format('%s', [inet_ntoa(sAddr)]);
      sIPMaskLine    := Format('0x%8.8x', [(pIpTable^.table[k].dwIndex)]) +
        '=' + Format('%s', [inet_ntoa(sMask)]);

      IPAddresses.Add(sIPAddressLine);
      IPMasks.Add(sIPMaskLine);
    end;

    SetLength(AdapterDataFound, pIfTable^.nRows); //initialize the array or records
    for i := 1 to pIfTable^.nRows do
      try
        //if pIfTable^.ifRow[i].dwType=MIB_IF_TYPE_ETHERNET then
        //begin
        m := i - 1;
        AdapterDataFound[m].dwIndex := 4;//(pIfTable^.ifRow[i].dwIndex);
        AdapterDataFound[m].dwType := (pIfTable^.ifRow[i].dwType);
        AdapterDataFound[m].dwIndex := (pIfTable^.ifRow[i].dwIndex);
        AdapterDataFound[m].sIpAddress :=
          IPAddresses.Values[Format('0x%8.8x', [(pIfTable^.ifRow[i].dwIndex)])];
        AdapterDataFound[m].sIpMask :=
          IPMasks.Values[Format('0x%8.8x', [(pIfTable^.ifRow[i].dwIndex)])];
        AdapterDataFound[m].dwMtu := (pIfTable^.ifRow[i].dwMtu);
        AdapterDataFound[m].dwSpeed := (pIfTable^.ifRow[i].dwSpeed);
        AdapterDataFound[m].dwAdminStatus := (pIfTable^.ifRow[i].dwAdminStatus);
        AdapterDataFound[m].dwOperStatus := (pIfTable^.ifRow[i].dwOperStatus);
        AdapterDataFound[m].dwInUcastPkts := (pIfTable^.ifRow[i].dwInUcastPkts);
        AdapterDataFound[m].dwInNUcastPkts := (pIfTable^.ifRow[i].dwInNUcastPkts);
        AdapterDataFound[m].dwInDiscards := (pIfTable^.ifRow[i].dwInDiscards);
        AdapterDataFound[m].dwInErrors := (pIfTable^.ifRow[i].dwInErrors);
        AdapterDataFound[m].dwInUnknownProtos := (pIfTable^.ifRow[i].dwInUnknownProtos);
        AdapterDataFound[m].dwOutNUcastPkts := (pIfTable^.ifRow[i].dwOutNUcastPkts);
        AdapterDataFound[m].dwOutUcastPkts := (pIfTable^.ifRow[i].dwOutUcastPkts);
        AdapterDataFound[m].dwOutDiscards := (pIfTable^.ifRow[i].dwOutDiscards);
        AdapterDataFound[m].dwOutErrors := (pIfTable^.ifRow[i].dwOutErrors);
        AdapterDataFound[m].dwOutQLen := (pIfTable^.ifRow[i].dwOutQLen);
        AdapterDataFound[m].bDescr := (pIfTable^.ifRow[i].bDescr);

        tmp := '';
        for j := 0 to pIfTable^.ifRow[i].dwPhysAddrLen - 1 do
        begin
          if Length(tmp) > 0 then
            tmp := tmp + '-' + format('%.2x', [pIfTable^.ifRow[i].bPhysAddr[j]])
          else
            tmp := tmp + format('%.2x', [pIfTable^.ifRow[i].bPhysAddr[j]]);
        end;

        if Length(tmp) > 0 then
        begin
          AdapterDataFound[m].bPhysAddr := tmp;
        end;
      except
        bResult := False;
        Result  := bResult;
        Exit;
      end;
  finally
    if Assigned(pIfTable) then
    begin
      FreeMem(pIfTable, ifTableSize);
    end;

    FreeAndNil(IPMasks);
    FreeAndNil(IPAddresses);
  end;

  Result := bResult;
end;

顺便说一句,我还使用这个单元和几乎完全相同的代码来创建一个副本ifconfig -a, which 可以在github上找到 https://github.com/MicksMix/ifconfig。我这样做主要是为了自学如何完成这项任务。

本文内容由网友自发贡献,版权归原作者所有,本站不承担相应法律责任。如您发现有涉嫌抄袭侵权的内容,请联系:hwhale#tublm.com(使用前将#替换为@)

使用 Delphi 检测互联网连接激活 的相关文章

随机推荐

  • 在 apache (ubuntu 12) 下将 python 脚本作为 cgi 运行时出现问题

    披露 我搜索了很多 我认为我的问题 针对我的配置 在这里没有得到解答 例如作为 cgi apache 服务器运行 python 脚本 https stackoverflow com questions 15878010 run python
  • Unity android 项目抛出“抱歉,您的硬件不支持此应用程序”错误

    我已经调查了2天了 我读了很多东西 总结一下我读到的内容 非 NEON 设备无法与 UNITY 5 版本一起使用 您应该将安装位置设置为 自动或强制内部 您应该将写入权限设置为 仅限内部 除了上述设置之外 我还尝试了这些纹理压缩设置 不要覆
  • 如何更改 actionPerformed() 内的 Swing Timer Delay

    所以我正在构建这个音乐播放器应用程序 它可以播放拖放到 JLabel 上的音符 当我按下播放按钮时 我希望每个音符都突出显示 并带有与该音符对应的延迟值 我为此使用了 Swing Timer 但问题是 它只是以构造函数中指定的恒定延迟循环
  • 返回元组时 GCC/Clang x86_64 C++ ABI 不匹配?

    当尝试时优化 x86 64 上的返回值 https stackoverflow com q 25381736 3919155 我注意到一个奇怪的事情 即 给定代码 include
  • 如何更快地加载JQuery?

    我有aspx 其中有jquery 由于加载 jquery 的延迟 我面临一些样式问题 请谁能告诉我如何快速加载jquery 我今天读了 Stackoverflow 上 Sam Saffron 撰写的关于此主题的博客文章 我还没有尝试过作者的
  • 上传到 iTunes Store 时出错

    我们确实需要一些帮助 在过去的两个月里 我们一直在与所有 Apple Mumbo Jumbo 进行斗争 但似乎无法在 APPStore 上获取我们的应用程序 现在我的问题是在验证存档编译并共享它之后 在提交过程中我得到 上传到 iTunes
  • 干净的条件格式 (Excel VBA)

    如果这个问题已经得到解答 但我无法找到它 我深表歉意 这就是我想要的 我们都知道删除范围 行和列会分割条件格式并使其变得丑陋 我想创建一个个人宏 1 Searches through all existing Conditional For
  • Errno::EACCES: 权限被拒绝@ rb_sysopen

    当我尝试运行 gem install json v 1 8 3 时 错误 执行 gem 时 Errno EACCES 权限被拒绝 rb sysopen home ulap10 gem gems json 1 8 3 tests test j
  • 我如何告诉编译器 MyCustomType 与 SomeOtherType 是 equal_comparable_with SomeOtherType ?

    假设我有一个MyCustomType与SomeOtherType struct SomeOtherType int value constexpr bool operator const SomeOtherType rhs const de
  • 使用 LINQ 查找对称差异

    我有两个收藏a and b 我想计算其中的一组项目a or b 但不能同时存在 逻辑异或 有了 LINQ 我可以想出这个 IEnumerable
  • R 中逻辑回归的致死剂量 (LD) 置信区间

    我想找到致命剂量 LD50 其置信区间为R Minitab SPSS SAS 等其他软件提供了此类置信区间的三种不同版本 我在任何包中都找不到这样的间隔R 我也用过findFn函数来自sos包裹 我怎样才能找到这样的间隔 我根据 Delta
  • 在 Linux 中使用 TCP 时,listen 的积压数量是否包括 SYN 接收的连接数?

    我读了一些帖子并检查了 Linux 内核代码 例如inet listen gt inet csk listen start https elixir bootlin com linux v4 3 6 source net ipv4 inet
  • 如果我更改扬声器配置,ffmpeg avcodec_open2 返回 -22

    我最近总是遇到一个奇怪的问题 根据我在 Windows stereo quad 5 1 中设置音频配置的方式 对 avcodec open2 的 ffmpeg 调用失败并出现错误 22 或正常工作 由于找不到太多有关该错误的信息 我想我应该
  • Ghostscript 顽固地拒绝嵌入字体

    我有一个从 pdflatex 创建的文档 嵌入 R pdf 图表 我现在正尝试将其发送到要求嵌入所有字体的打印机 lulu 我认为 没问题 gs dNOPAUSE dBATCH dNOPLATFONTS sDEVICE pdfwrite d
  • 如何:点击时将视图置于前面;设置最大/最小捏合手势比例;将屏幕限制设置为平移手势

    注意 我发现的所有东西都太旧了 或者与我实际需要的东西相差太大 而且我几乎尝试了我发现的所有东西 但没有一个能以正确的方式工作 我创建了 3 个 UIView 我可以拖动它们并缩放它们 现在 我需要 将其中一些放在前面 我想为每个添加一个
  • 使用owin中间件替换响应体

    有没有办法使用 OWIN 中间件覆盖响应内容 我的自定义错误类 public class Error public string error get set public string description get set public
  • RxJs - forkJoin 与空数组

    我目前正在使用forkJoin等待数组Observable s 之前完成pipe 英 和tap ping 我注意到如果数组为空 则不会发出任何信号 我什至不能tap 我该如何解决这种问题 我应该检查数组是否为空吗 myFirstFuncti
  • AspNetCore 2.0 声明始终为空

    我正在努力将 DotNet 4 5 MVC WebAPI 应用程序转换为 AspNetCore 2 0 但在让 Cookie 身份验证再次工作时遇到一些问题 当我设置 cookie 并尝试访问安全方法时 我无法到达那里 当我进入匿名方法并检
  • 空比较

    有一个查询 UPDATE MyTable SET nvarchar1 blahblah WHERE Id 096fe792 7313 416f b3c8 327f46be73b6 AND nvarchar1 lt gt blablah 当
  • 使用 Delphi 检测互联网连接激活

    我使用 3G 无线卡已经有一段时间了 每次连接时 我的防病毒软件都会启动更新 我想知道我可以使用哪些 Win32 API 函数集来获取通知或查询即将出现的 Internet 连接事件 Delphi 已经有一组移植的标头了吗 我参与了一个项目