Einzelnen Beitrag anzeigen

Whookie

Registriert seit: 3. Mai 2006
Ort: Graz
445 Beiträge
 
Delphi 10.3 Rio
 
#14

Re: Mehrere IP-Adressen auf einem Rechner -für Simulationszw

  Alt 17. Jul 2007, 00:31
Für alle die es interessiert (und weil ich eine Eeewigkeit gebraucht habe um das rauszukriegen) gibts hier eine Funktion, die herausfindet, ob der Loopback Adapter bereits installiert ist. Getestet habe ich das ganze allerdings nur auf Windows XP (+SP2), wenn also jemand Lust hat und das auch auf was anderem zum Laufen kriegt, kann er ja hier seine Erfahrungen posten!
Um den Code kompilieren zu können, ist die Unit "SetupApi" aus den Jedis nötig und da musste ich {.DEFINE SETUPAPI_LINKONREQUEST} einstellen um keinen Crash zu verursachen...


Delphi-Quellcode:
Function LoopBackInstalled: Boolean;
Var
  pDevInfo: HDEVINFO;
  DevInfoData: SP_DEVINFO_DATA;
  RegDataType: Cardinal;
  PropSize: Cardinal;
  pPropBuffer: PByte;
  i: Integer;
  p: PChar;
begin
  Result := FALSE; // Annahme: Nix installiert
  pDevInfo := SetupDiGetClassDevs(NIL, NIL, 0, DIGCF_ALLCLASSES Or DIGCF_PRESENT);
  if DWord(pDevInfo) <> INVALID_HANDLE_VALUE then
  begin
    // suche nach dem loopback adapter
    DevInfoData.cbSize := SizeOf(DevInfoData);
    i := 0;
    while SetupDiEnumDeviceInfo(pDevInfo, i, DevInfoData) And Not Result Do // schlägt fehl wenn was nicht passt oder i>Devices ist
    Begin
      pPropBuffer := NIL;
      PropSize := 0;
      // 1. Aufruf um die Buffergröße herauszufinden
      SetupDiGetDeviceRegistryProperty(pDevInfo, DevInfoData, SPDRP_HARDWAREID, RegDataType, pPropBuffer, PropSize, PropSize);
      If GetLastError = ERROR_INSUFFICIENT_BUFFER Then
      Begin
        GetMem(pPropBuffer, PropSize);
        // 2. Aufruf um die Daten zu holen
        If SetupDiGetDeviceRegistryProperty(pDevInfo, DevInfoData, SPDRP_HARDWAREID, RegDataType, pPropBuffer, PropSize, PropSize) Then
        Begin
          // ok pPropBuffer durchsuchen ...
          p := PChar(pPropBuffer);
          while p^ <> #0 do
          begin
            if CompareText(p, '*msloop')=0 then
            begin
              Result := TRUE;
              Break;
            end;
            p := p + Length(p)+1;
          end;
        End; // Eventuell keine Daten vorhanden ...?
        FreeMem(pPropBuffer);
      end;
      Inc(i);
    End;


    SetupDiDestroyDeviceInfoList(pDevInfo);
  end;
end;
  Mit Zitat antworten Zitat