5 replies to this topic

[enecumene]

Aquí os dejo dos funciones basados en unas que encontré en la red que no recuerdo donde, adaptados para mejor funcionamiento, las funciones son ConfiguraIP() y AsignarDNS(), sirven para configurar/cambiar/limpiar el IP, Sub-Mascara, Puerta de enlace (gateway) y asignar los DNS primarios y secundarios (alterno), aquí el código:

delphi

uses ComObj, ActiveX, UrlMon;
 
...
 
// ======================================================================
// ConfiguraIP()
// Asigna IPAddress, Gateway y Subnetmask via WMI
// Argumentos …
// AIpAddress – si el valor es NULL o 'DHCP' entonces DHCP está HABILITADA
// de lo contrario será asignada una IP estática.
// AGateWay – [Opcional] Si no se escribe GATEWAY no se modifica.
// SubnetMask – [Opcional] si lo omitimos por defecto será '255.255.255.0'.
//
// AsignarDNS()
// Asignmos los servidores DNS via WMI
// Argumentos …
// APrimaryDNS – Si lo asignamos NULL entonces se limpiará la lista.
// AAlternateDNS – [Opcional]
//
// Valores de retornos …
// 0 Se completó con éxito, no requiere reinicio.
// 1 Se completón con éxito, requiere reinicio.
// -1 Error OLE desconocido.
// 64 Método no soportado en esta plataforma.
// 65 Fallo desconocido.
// 66 Sub-Mascara Inválido.
// 67 Se produjo un error al procesar una instancia que fue devuelto.
// 68 Parámetros de entrada inválido.
// 69 Se especificó más de 5 GATEWAY.
// 70 Dirección IP inválido.
// 71 Dirección GATEWAY inválido.
// 72 Se produjo un error al acceder al Registro de la información.
// 73 Nombre de Dominio inválido.
// 74 Nombre del HOST inválido.
// 75 No se definió un servidor WIN primario o secundario.
// 76 Archivo inválido.
// 77 Ruta del sistema inválido.
// 78 Falló copiado de archivo.
// 79 Parámetro de seguridad inválido.
// 80 Imposible configurar el servicio TCP/IP.
// 81 Imposible configurar el servicio DHCP.
// 82 No se puede renovar la concesión DHCP.
// 83 No se puede liberar DHCP.
// 84 IP no habilitado en el adaptador.
// 85 IPX no habilitado en el adaptador.
// 86 Error limitación de errores Frame/network.
// 87 Tipo frame inválido.
// 88 Número NETWORK inválido.
// 89 Número NETWORK duplicado.
// 90 Parámetros fuera del límite.
// 91 Acceso denegado.
// 92 Falta de memoria.
// 93 Ya existe.
// 94 Ruta, archivo, o objecto no encontrado.
// 95 Imposible notificar servicio.
// 96 Imposible notificar servicio DNS.
// 97 Interfaz no configurable.
// 98 No todos los servicios DHCP pueden ser liberados o renovar.
// 100 DHCP no habilitado en adaptador.
// ======================================================================
 
// ==================================================================
// IP Address,Gateway y Subnet Mask
// EnableStatic toma un array de cadenas como parámetro
// para las direcciones.
// ==================================================================
 
function ConfiguraIP(const AIpAddress : string;
const AGateWay : string = '';
const ASubnetMask : string = '') : integer;
var Retvar : integer;
    oBindObj : IDispatch;
    oNetAdapters,oNetAdapter,
    oIpAddress,oGateWay,
    oWMIService,oSubnetMask : OleVariant;
    i,iValue : longword;
    oEnum : IEnumvariant;
    oCtx : IBindCtx;
    oMk : IMoniker;
    sFileObj : widestring;
begin
  Retvar := 0;
  sFileObj := 'winmgmts:\\.\root\cimv2';
 
  // Creamos parámetro OLE [IN}
  oIpAddress := VarArrayCreate([1,1],varOleStr);
  oIpAddress[1] := AIpAddress;
  oGateWay := VarArrayCreate([1,1],varOleStr);
  oGateWay[1] := AGateWay;
  oSubnetMask := VarArrayCreate([1,1],varOleStr);
 
  if ASubnetMask = '' then
    oSubnetMask[1] := '255.255.255.0'
  else
    oSubnetMask[1] := ASubnetMask;
 
  // Conectando a WMI – Emulando la API GetObject()
  OleCheck(CreateBindCtx(0,oCtx));
  OleCheck(MkParseDisplayNameEx(oCtx,PWideChar(sFileObj),i,oMk));
  OleCheck(oMk.BindToObject(oCtx,nil,IUnknown,oBindObj));
  oWMIService := oBindObj;
 
  oNetAdapters := oWMIService.ExecQuery('Select * from ' +
  'Win32_NetworkAdapterConfiguration ' +
  'where IPEnabled=TRUE');
  oEnum := IUnknown(oNetAdapters._NewEnum) as IEnumVariant;
 
  while oEnum.Next(1,oNetAdapter,iValue) = 0 do begin
    try
    // asignar por DHCP ? (Gateway y Subnet ignorados)
      if (AIpAddress = '') or SameText(AIpAddress,'DHCP') then
      Retvar := oNetAdapter.EnableDHCP
    // asiganr via STATIC ?
      else begin
      Retvar := oNetAdapter.EnableStatic(oIpAddress,oSubnetMask);
    // cambiar Gateway ?
      if (Retvar = 0) and (AGateWay <> '') then
      Retvar := oNetAdapter.SetGateways(oGateway);
 
    // *** Aquí es donde tenemos que acualizar
    // *** algún tipo de red mapeadas de recursos ***
  end;
  except
    Retvar := -1;
  end;
 
  oNetAdapter := Unassigned;
end;
 
  oGateWay := Unassigned;
  oSubnetMask := Unassigned;
  oIpAddress := Unassigned;
  oNetAdapters := Unassigned;
  oWMIService := Unassigned;
  Result := Retvar;
end;
 
// ====================================================
// asignar servidores DNS
// aquí es donde asignamos los DNS primarios y alternos
// se puede colocar una lista de todas las DNS posibles
// pero es recomendable usar 1 dirección tanto para el
// primario como alterno.
// ====================================================
 
function AsignarDNS(const APrimaryDNS : string;
const AAlternateDNS : string = '') : integer;
var Retvar : integer;
  oBindObj : IDispatch;
  oNetAdapters,oNetAdapter,
  oDnsAddr,oWMIService : OleVariant;
  i,iValue,iSize : longword;
  oEnum : IEnumvariant;
  oCtx : IBindCtx;
  oMk : IMoniker;
  sFileObj : widestring;
begin
  Retvar := 0;
  sFileObj := 'winmgmts:\\.\root\cimv2';
  iSize := 0;
 
  if APrimaryDNS <> '' then inc(iSize);
  if AAlternateDNS <> '' then inc(iSize);
 
// creando parámetros OLE [IN}
  if iSize > 0 then begin
    oDnsAddr := VarArrayCreate([1,iSize],varOleStr);
    oDnsAddr[1] := APrimaryDNS;
  if iSize > 1 then oDnsAddr[2] := AAlternateDNS;
end;
 
// Conectar a WMI – Emulando la API GetObject()
  OleCheck(CreateBindCtx(0,oCtx));
  OleCheck(MkParseDisplayNameEx(oCtx,PWideChar(sFileObj),i,oMk));
  OleCheck(oMk.BindToObject(oCtx,nil,IUnknown,oBindObj));
  oWMIService := oBindObj;
 
  oNetAdapters := oWMIService.ExecQuery('Select * from ' +
  'Win32_NetworkAdapterConfiguration ' +
  'where IPEnabled=TRUE');
  oEnum := IUnknown(oNetAdapters._NewEnum) as IEnumVariant;
 
  while oEnum.Next(1,oNetAdapter,iValue) = 0 do begin
    try
      if iSize > 0 then
        Retvar := oNetAdapter.SetDNSServerSearchOrder(oDnsAddr)
      else
        Retvar := oNetAdapter.SetDNSServerSearchOrder();
    except
        Retvar := -1;
  end;
 
  oNetAdapter := Unassigned;
end;
 
  oDnsAddr := Unassigned;
  oNetAdapters := Unassigned;
  oWMIService := Unassigned;
  Result := Retvar;
end;

Su forma de uso sería:

Asignando IP y DNSs

delphi

ConfiguraIP({asignamos el IP}, {Asignamos el Gateway}, {asignamos la sub-mascar}):
 
//Ejemplo
ConfiguraIP('143.1.21.100', '143.1.21.101', ''); //dejando la Sub-Mascara como nulo por defecto coloca 255.255.255.0
 
AsignarDNS({DNS primario}, {DNS Alterno})
 
//Ejemplo
AsignarDNS('200.1.100.22', '196.110.8.13'); //Si sólo queremos el DNS primario dejamos el alterno Nulo.

Limpiando IP y DNS

delphi

//Para deshabilitar o limpiar todos los IP y DNS
 
ConfiguraIP('','',''); //dejando nulo todos se deshabilita
AsignarDNS('',''); //dejando nulo todos se deshabilita

Eso esto es todo, sólo resta que algún compañero lo pruebe tanto en 2000/XP/Vista y nos comente los resultados . Qué lo disfruten.

Saludos.

[Wilson]

Muy interesante amigo, gracias por el aporte.

Saludos

[seoane]

Por aquí ya hablamos sobre esto mismo:
http://www.delphiacc...pic=381.msg5735

[enecumene]

Por aquí ya hablamos sobre esto mismo:
http://www.delphiacc...pic=381.msg5735

Ah mierda, cómo me falla la memoria :$ :$

[Wilson]

Por aquí ya hablamos sobre esto mismo:
http://www.delphiacc...pic=381.msg5735

Ah mierda, cómo me falla la memoria :$ :$

Es mejor pecar  por exceso y no por defecto.

[seoane]

Ah mierda, cómo me falla la memoria :$ :$

No era un reproche solo una observación