functionPacketGetAdaptersNPF(): Byte;
var
LinkageKey, AdapKey, OneAdapKey: HKEY;
RegKeySize: DWORD;
Status: Longint;
i: Integer;
dim: DWORD;
RegType: DWORD;
TName: array[0..255] of AnsiChar;
TAName: array[0..255] of AnsiChar;
AdapName: array[0..255] of AnsiChar;
TcpBindingsMultiString: PAnsiChar;
FireWireFlag: UINT;
//// Old registry based WinPcap names//// CHAR npfCompleteDriverPrefix[MAX_WINPCAP_KEY_CHARS];// UINT RegQueryLen;
npfCompleteDriverPrefix: array[0..MAX_WINPCAP_KEY_CHARS - 1] of AnsiChar; // = NPF_DRIVER_COMPLETE_DEVICE_PREFIX;
DeviceGuidName: array[0..255] of AnsiChar;
label tcpip_linkage;
begin
RegKeySize := 0;
FillChar(npfCompleteDriverPrefix, sizeof(npfCompleteDriverPrefix), #0);
StrCopy(npfCompleteDriverPrefix, NPF_DRIVER_COMPLETE_DEVICE_PREFIX);
//TRACE_ENTER("PacketGetAdaptersNPF");//// Old registry based WinPcap names//// Get device prefixes from the registry
Status := RegOpenKeyEx(HKEY_LOCAL_MACHINE,
'SYSTEMCurrentControlSetControlClass{4D36E972-E325-11CE-BFC1-08002BE10318}',
0,
KEY_READ,
AdapKey);
if (Status <> ERROR_SUCCESS) thenbegin//TRACE_PRINT("PacketGetAdaptersNPF: RegOpenKeyEx ( Class\{networkclassguid} ) Failed");
goto tcpip_linkage;
end;
i := 0;
//TRACE_PRINT("PacketGetAdaptersNPF: RegOpenKeyEx ( Class\{networkclassguid} ) was successful");//TRACE_PRINT("PacketGetAdaptersNPF: Cycling through the adapters in the registry:");//// Cycle through the entries inside the {4D36E972-E325-11CE-BFC1-08002BE10318} key// To get the names of the adapters////while((Result = RegEnumKey(AdapKey, i, AdapName, sizeof(AdapName)/2)) == ERROR_SUCCESS)while ((RegEnumKey(AdapKey, i, AdapName, sizeof(AdapName) div2)) = ERROR_SUCCESS) dobegin
Inc(i);
FireWireFlag := 0;
//// Get the adapter name from the registry key//
Status := RegOpenKeyEx(AdapKey, AdapName, 0, KEY_READ, OneAdapKey);
if (Status <> ERROR_SUCCESS) thenbegin//TRACE_PRINT1("%d) RegOpenKey( OneAdapKey ) Failed, skipping the adapter.",i);continue;
end;
////// Check if this is a FireWire adapter, looking for "1394" in its ComponentId string.// We prevent listing FireWire adapters because winpcap can open them, but their interface// with the OS is broken and they can cause blue screens.//
dim := sizeof(TName);
Status := RegQueryValueEx(OneAdapKey,
'ComponentId',
nil,
nil,
PBYTE(@TName[0]),
@dim);
if (Status = ERROR_SUCCESS) thenbeginif (IsFireWire(TName) <> 0) thenbegin
FireWireFlag := INFO_FLAG_DONT_EXPORT;
end;
end;
Status := RegOpenKeyEx(OneAdapKey, 'Linkage', 0, KEY_READ, LinkageKey);
if (Status <> ERROR_SUCCESS) thenbegin
RegCloseKey(OneAdapKey);
//TRACE_PRINT1("%d) RegOpenKeyEx ( LinkageKey ) Failed, skipping the adapter",i);continue;
end;
dim := sizeof(DeviceGuidName);
Status := RegQueryValueExA(LinkageKey,
'Export',
nil,
nil,
PBYTE(@DeviceGuidName[0]),
@dim);
if (Status <> ERROR_SUCCESS) thenbegin
RegCloseKey(OneAdapKey);
RegCloseKey(LinkageKey);
//TRACE_PRINT1("%d) Name = SKIPPED (error reading the key)", i);continue;
end;
if (strlen(DeviceGuidName) >= strlen('Device')) thenbegin// Put the DeviceNPF_ string at the beginning of the name
StrPCopy(TAName, Format('%s%s', [npfCompleteDriverPrefix,
DeviceGuidName + strlen('Device')]));
endelsecontinue;
//terminate the string, just in case
TAName[sizeof(TAName) - 1] := #0;
//TRACE_PRINT2("%d) Successfully retrieved info for adapter %s, trying to add it to the global list...", i, TAName);// If the adapter is valid, add it to the list.
PacketAddAdapterNPF(TAName, FireWireFlag);
RegCloseKey(OneAdapKey);
RegCloseKey(LinkageKey);
end; // while enum reg keys
RegCloseKey(AdapKey);
tcpip_linkage:
//// no adapters were found under {4D36E972-E325-11CE-BFC1-08002BE10318}. This means with great probability// that we are under Windows NT 4, so we try to look under the tcpip bindings.////TRACE_PRINT("Adapters not found under SYSTEM\CurrentControlSet\Control\Class. Using the TCP/IP bindings.");
Status := RegOpenKeyEx(HKEY_LOCAL_MACHINE,
'SYSTEMCurrentControlSetServicesTcpipLinkage',
0,
KEY_READ,
LinkageKey);
if (Status = ERROR_SUCCESS) thenbegin// Retrieve the length of th binde key// This key contains the name of the devices as devicefoo//in ASCII, separated by a single '\0'. The list is terminated//by another '\0'
Status := RegQueryValueExA(LinkageKey,
'bind',
nil,
@RegType,
nil,
@RegKeySize);
// Allocate the buffer
TcpBindingsMultiString := GlobalAllocPtr(GMEM_MOVEABLE or GMEM_ZEROINIT, RegKeySize + 2);
if (TcpBindingsMultiString = nil) thenbegin//TRACE_PRINT("GlobalAlloc failed allocating memory for the registry key, returning.");//TRACE_EXIT("PacketGetAdaptersNPF");Result := 0;
Exit;
end;
// Query the key again to get its content
Status := RegQueryValueExA(LinkageKey,
'bind',
nil,
@RegType,
PBYTE(@TcpBindingsMultiString[0]),
@RegKeySize);
RegCloseKey(LinkageKey);
// Scan the buffer with the device names
i := 0;
whileTruedobeginif (TcpBindingsMultiString[i] = #0) thenbreak;
StrPCopy(TAName, Format('%s%s', [npfCompleteDriverPrefix, TcpBindingsMultiString + i + strlen('Device')]));
//// TODO GV: this cast to avoid a compilation warning is// actually stupid. We shouls check not to go over the buffer boundary!//
Inc(i, strlen(PAnsiChar(TcpBindingsMultiString + i)) + 1);
// If the adapter is valid, add it to the list.
PacketAddAdapterNPF(TAName, 0);
end;
GlobalFreePtr(TcpBindingsMultiString);
endelsebeginend;
Result := 1;
end;