Foros Club Delphi - Localizar computadoras en la red y conectarse a ellas

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)

- Internet (https://www.clubdelphi.com/foros/forumdisplay.php?f=3)

- - Localizar computadoras en la red y conectarse a ellas (https://www.clubdelphi.com/foros/showthread.php?t=1603)

Localizar computadoras en la red y conectarse a ellas

Hola!

Tenía ya rato sin colocar un hilo.

Ya termine unas aplicaciones Cliente/Servidor funcionales, aunque carece por el momento de varias herramientas.
Los programas cliente los controlo por medio del servidor, usando componentes Indy.

Entre las cosas que contenia los programas anteriores eran el envio de mensajes a traves de la red, captura de pantalla y bloqueo. Solo que tenían que conectarse al servidor primero.

Ahora lo que quiero hacer es un programa que solo se encargue del envio de mensajes solo que sin el uso de servidor. Lo que pretendo pues es que mi aplicacion encuentre todas las computadoras de la red, y conectarse a las que tienen el mismo programa. Así el programa sería cliente y servidor a la vez.

Lo primero es obtener el nombre de todas las computadoras existentes en la red junto con su IP, he checado en Trucomania y viene uno similar pero no funciona correctamente, sólo me muestra la computadora en la que estoy ejecutando el código y en las demás me muestra cadenas con basura.

Agradezco cualquier ayuda...

Salu2!

Lamento no poder ser de mucha ayuda... pero te daré una idea.

Si no mal recuerdo hay una función llamada EnumNetResources (o algo similar)....

Como supongo que trabajas con tcp/ip, pues tendrás que tener muy bien configurada la red para que todo funcione. El explorador de windows normalmente se basa en NetBEUI y abusa de los broadcasts para conseguir mostrar toda la red (y muchas veces falla en el intento)...

por ahora solo eso puedo decirte... espero haber sido de ayuda.

Hasta luego.

;)

Hola jachguate!

La función que comentas no la encuentro en la ayuda de Delphi. La he buscado de varias maneras pero sin exito.

¿Se puede obtener los nombres mediante un ShellTreeView? Porke he hecho un trukillo y funciona a medias, porke es todo un show para poder obtener el nombre de las PC en red, confiablemente.

Gracias de todos modos.

Bueno, para el rollo que te pongo a continuacion necesitas el componente TIdIcmpClient de las Indy

Creo que he logrado sacar todo lo que no te interesa (no se si sacando me abre pasado o no abre llegado :p).

Esta unit lo que hace es recuperar el nombre y la IP de los equipos de una red. Lo de conectarse si tienen el mismo programa ya te lo dejo a ti ;)

Espero te sirva

P.D. : empieza a mirarlo por el ultimo procedimiento que es donde esta la llamada a ObtenerIPs y, desde alli, ves mirando lo que hace cada uno de los procedures y functions

Código:

unit UCTerminales;



interface



uses

.......



type

  TCTerminales = class(TForm)

.....

    ICMP: TIdIcmpClient;

  private

    { Private declarations }

    ID2             : array of PItemiDList;

    Dir_ip          : String;

    procedure ICMPReply(ASender: TComponent; const ReplyStatus: TReplyStatus);

    procedure Ping(var vHost : String);

    function GetComputerName: String;

    function OriginFolderNT: IShellFolder;

    function WinNT : Boolean;

    function Win2K : Boolean;



    procedure DisposePIDL(ID: PItemIDList);

    function  OriginFolder: IShellFolder;

    function  GetDisplayName(ShellFolder: IShellFolder; PIDL: PItemIDList): String;

    function  parser(Folder: IShellFolder; vPing: Boolean; Lista : TStringlist): Integer;

    function  EnumObjects( ShellFolder: IShellFolder): IEnumIDList;

    function ObtenerIPs(var Ips : TStringList) : boolean;



    procedure StripLastID(IDList: PItemIDList);

    function  CreatePIDL(Size: Integer): PItemIDList;

    function  GetPrevPIDL(PIDL: PItemIDList): PItemIDList;

    function  GetPIDLSize(IDList: PItemIDList): Integer;

    function  NextPIDL(IDList: PItemIDList): PItemIDList;

    function  CopyPIDL(IDList: PItemIDList): PItemIDList;

  public

    { Public declarations }

  end;



var

  CTerminales: TCTerminales;



implementation



{$R *.dfm}



function TCTerminales.WinNT : Boolean;

begin

     Result := Win32Platform = VER_PLATFORM_WIN32_NT;

end;



function TCTerminales.Win2K : Boolean;

begin

     Result := (Win32MajorVersion > 4) and (Win32Platform = VER_PLATFORM_WIN32_NT);

end;



function TCTerminales.OriginFolderNT: IShellFolder;

var Desktop   : IShellFolder;

    S         : String;

    W         : WideString;

    P         : PWideChar;

    Len, Flags: LongWord;

    Machine, Workgroup, Network : PItemIDList;

    NetShell  : IShellFolder;

    Enum      : IEnumIDList;

    ID        : PItemIDList;

begin

     S := '\\'+GetComputerName;

     Len := Length(S);

     W := S;

     P := PWideChar(W);

     SHGetDesktopFolder(Desktop);

     Desktop.ParseDisplayName(0, nil, P, Len, Machine, Flags);

     Workgroup:=GetPrevPIDL(Machine);

     Network:=GetPrevPIDL(Workgroup);

     Desktop.BindToObject(Network, nil, IShellFolder, NetShell);

     Enum := EnumObjects(NetShell);

     Enum.Next(1, ID, Flags);

     NetShell.BindToObject(ID, nil, IShellFolder, Pointer(Result));

     DisposePIDL(Network);

     DisposePIDL(Workgroup);

end;



function TCTerminales.Parser(Folder: IShellFolder; vPing: Boolean; Lista : TStringlist): Integer;

var ID       : PItemiDList;

    EnumList : IEnumIDList;

    NumIDs   : LongWord;

    S        : String;

    Index    : Integer;

begin

     EnumList := EnumObjects(Folder);

     Index := 0;

     if Assigned(EnumList) then

        while EnumList.Next(1, ID, NumIDs) = S_OK do

        begin

              S := GetDisplayName(Folder, ID);

              if vping then

              begin

                   Ping(S);

                   Lista.add(S);

              end

              else

              begin

                   SetLength(ID2, index + 1);

                   ID2[index] := ID;

              end;

              inc(Index);

        end;

     Result := Index;

end;



function TCTerminales.EnumObjects(ShellFolder: IShellFolder): IEnumIDList;

const Flags = SHCONTF_FOLDERS or SHCONTF_NONFOLDERS or SHCONTF_INCLUDEHIDDEN;

begin

     ShellFolder.EnumObjects(0, Flags, Result);

end;



procedure TCTerminales.Ping(var vHost : String);

begin

     ICMP.OnReply := ICMPReply;

     ICMP.ReceiveTimeout := 1000;

     try

        ICMP.Host := vHost;

        ICMP.Ping;

        Application.ProcessMessages;

        vhost := vhost + '|' + Dir_ip;

     finally

     end;

end;



procedure TCTerminales.ICMPReply(ASender: TComponent; const ReplyStatus: TReplyStatus);

begin

     if ReplyStatus.BytesReceived > 0 then // respuesta de la otra máquina.

        Dir_ip := ReplyStatus.FromIpAddress; // -> direccion del Servidor

end;



function TCTerminales.GetComputerName: String;

var N   : Cardinal;

    Buf : array [0..MAX_COMPUTERNAME_LENGTH + 1] of AnsiChar;

begin

     N := SizeOf(Buf) - 1;

     Windows.GetComputerName(Buf, N);

     Result := PChar(@Buf[0]);

end;



function TCTerminales.CreatePIDL(Size: Integer): PItemIDList;

var Malloc : IMalloc;

    HR     : HResult;

begin

     Result := nil;

     HR := SHGetMalloc(Malloc);

     if Failed(HR) then Exit;

     try

        Result := Malloc.Alloc(Size);

        if Assigned(Result) then FillChar(Result^, Size, 0);

     finally

     end;

end;



procedure TCTerminales.DisposePIDL(ID: PItemIDList);

var Malloc : IMalloc;

begin

     if ID = nil then Exit;

     OLECheck(SHGetMalloc(Malloc));

     Malloc.Free(ID);

end;



function TCTerminales.GetPrevPIDL(PIDL: PItemIDList): PItemIDList;

var Temp : PItemIDList;

begin

     Temp := CopyPIDL(PIDL);

     if Assigned(Temp) then StripLastID(Temp);

     if Temp.mkid.cb <> 0 then Result := Temp

     else Result := nil;

end;



function TCTerminales.GetPIDLSize(IDList: PItemIDList): Integer;

begin

     Result := 0;

     if Assigned(IDList) then

      begin

           Result := SizeOf(IDList^.mkid.cb);

           while IDList^.mkid.cb <> 0 do

            begin

                 Result := Result + IDList^.mkid.cb;

                 IDList := NextPIDL(IDList);

            end;

      end;

end;



procedure TCTerminales.StripLastID(IDList: PItemIDList);

var MarkerID: PItemIDList;

begin

     MarkerID := IDList;

     if Assigned(IDList) then

      begin

           while IDList.mkid.cb <> 0 do

            begin

                 MarkerID := IDList;

                 IDList := NextPIDL(IDList);

            end;

           MarkerID.mkid.cb := 0;

      end;

end;



function TCTerminales.NextPIDL(IDList: PItemIDList): PItemIDList;

begin

     Result := IDList;

     Inc(PChar(Result), IDList^.mkid.cb);

end;



function TCTerminales.CopyPIDL(IDList: PItemIDList): PItemIDList;

var Size : Integer;

begin

     Size := GetPIDLSize(IDList);

     Result := CreatePIDL(Size);

     if Assigned(Result) then CopyMemory(Result, IDList, Size);

end;



function TCTerminales.OriginFolder: IShellFolder;

var Desktop : IShellFolder;

    S       : String;

    P       : PWideChar;

    Len, Flags: LongWord;

    Machine, Workgroup, Network: PItemIDList;

begin

     S := '\\'+GetComputerName;

     Len := Length(S);

     P := StringToOleStr(S);

     Flags := 0;

     SHGetDesktopFolder(Desktop);

     Desktop.ParseDisplayName(0, nil, P, Len, Machine, Flags);

     Workgroup := GetPrevPIDL(Machine);

     try

        Network := GetPrevPIDL(Workgroup);

        try

           Desktop.BindToObject(Network, nil, IShellFolder, Pointer(Result));

        finally

               DisposePIDL(Network);

        end;

     finally

            DisposePIDL(Workgroup);

     end;

end;



function TCTerminales.GetDisplayName(ShellFolder: IShellFolder;

  PIDL: PItemIDList): String;

var StrRet : TStrRet;

    P      : PChar;

begin

     Result := '';

     ShellFolder.GetDisplayNameOf(PIDL, SHGDN_NORMAL, StrRet);

     case StrRet.uType of

          STRRET_CSTR   : SetString(Result, StrRet.cStr, lStrLen(StrRet.cStr));

          STRRET_OFFSET : begin

                               P := @PIDL.mkid.abID[StrRet.uOffset - SizeOf(PIDL.mkid.cb)];

                               SetString(Result, P, PIDL.mkid.cb - StrRet.uOffset);

                          end;

          STRRET_WSTR: Result := StrRet.pOleStr;

     end;

end;



function TCTerminales.ObtenerIPs(var Ips : TStringList) : boolean;

var Network   : IShellFolder;

    Workgroup : IShellFolder;

    i, Redes  : Integer;

begin

     Result := true;



     if WinNT and (not Win2K) then Network := OriginFolderNT

     else Network := OriginFolder;

     redes := Parser(Network, false, Ips);

     try

         for i := 0 to Redes - 1 do

         begin

              Network.BindToObject(ID2[i], nil, IShellFolder, Workgroup);

              Parser(Workgroup, TRUE, Ips);

              Workgroup := nil;

         end;

     except

           Result := false;

     end;

end;



procedure TCTerminales.A_BuscaIPsExecute(Sender: TObject);

var Ips : TStringList;

begin

     Ips := TStringList.Create;

     try

        Screen.Cursor := crHourglass;

        ObtenerIPs(Ips);

        Screen.Cursor := crDefault;

     finally

            Ips.Free;

            Screen.Cursor := crDefault;

     end;

end;



end.

Gracias Cadetill!

Ahora mismo lo estoy checando, y le comento a todos los del Club como me va. :)

Saludos!

Por el momento estoy trabajando con la unit que proporcionaste, para asegurarme de que primero pueda ubicar las computadoras y mostrarlas. La conexión entre ellas la hare despues, de que logre que esto funcione :P

Cita:

Posteado originalmente por cadetill, con algunas observaciones por madman

Código:



//---------------------------------------------------------------------------------

***** Este es tu Procedimiento ***** 

procedure TCTerminales.ICMPReply(ASender: TComponent; const  ReplyStatus: TReplyStatus);

begin

.....

end;



***** Este es el Procedimiento  con los parametros que te da al crearlo con OnReply de los Eventos del ICMPClient***** 

procedure TCTerminales.ICMPReply(ASender: TComponent; const AReplyStatus: TReplyStatus);

begin

.....

end;

Nada mas difieren en que el tuyo no tiene la 'A' al principio.
No se porque asignas esto, para mi es solo una línea de más:

Código:

procedure TCTerminales.Ping(var vHost : String);

begin

     ICMP.OnReply := ICMPReply; 

     ICMP.ReceiveTimeout := 1000;

     try

             ...

     end;

end;

Me ocurre un error al llamar, el procedimiento A_BuscaIPsExecute(), lo mando llamar desde un Boton ya sea por su nombre o teniendo en el BotonClick el mismo codigo que este.
:( Cuando lo hago siempre se sale del programa y me manda a esta linea:

Código:

function TCTerminales.GetPIDLSize(IDList: PItemIDList): Integer;

begin

     Result := 0;

     if Assigned(IDList) then

      begin

           Result := SizeOf(IDList^.mkid.cb);

           while IDList^.mkid.cb <> 0 do 

            begin

                 Result := Result + IDList^.mkid.cb;

                 IDList := NextPIDL(IDList);

            end;

      end;

end;



end.

Ups, creo que me pase borrando cosas, jejeje

Dejame que le de un vistazo y te comento a ver donde esta el fallo ;)

Bueno, pues ya lo tengo ;)

Te lo he subido a mi web en el apartado de App/Utils. El programa es el Localizador :p

Lo he probado y funciona bien, a ver si te vale ahora :)

P.D. Solo agradecer a todos aquellos que habeis visitado mi web. Ya habeis pasado de las 1000 visitas!!!! GRACIAS de nuevo

Gracias de nuevo cadetill!

:D

Tu programa corre muy bien, ahora continuare con lo mío. Colocare agradecimientos para ti en mi aplicación.

Hola.

He descargado el programa y los fuentes (aunque ni los he visto por falta de tiempo.... ) y lo he probado en una red con dominios de Windows NT y unas 40 terminales con win95, 98, 2000 y XP.

La terminal donde lo probe tiene Win XP Pro, y no detectó ninguna máquina, ni del grupo al que pertenece la red, ni del dominio completo.

Lo digo como un comentario constructivo. Como te digo, no he tenido tiempo de revisar los fuentes y no tengo la menor idea de porque falle... pero no funciona.

Hasta luego.

;)

Pues la verdad es que no te sabria decir, no tengo ninguna maquina con XP para probarlo :(

Si encuentras el fallo y lo puedes corregir te estaria agradecido de que lo comentaras

Lo intentaré cuando tenga tiempo... quizas la otra semana.

Hasta luego.
;)

hola foro estuve probando el programita y tampoco logro ver las maquinas en una red Novell si encuentro la causa lo publicare.

Salud2;)

Hola...!

Quiero decirles que a mí el programa si me ha funcionado.

Lo instale en una computadora con Windows XP Professional, en la red ademas de esta PC se encuentran algunas con Windows ME & Windows 98 SE y si las puedo ver.

No sé cuál sea el motivo de su fallo con ustedes.

Hola, que tal?

Se me ocurrió una forma totalmente diferente,
por ejemplo si el servidor tiene la siguiente ip:
169.254.0.1 y los clientes van desde el .2 hasta el .50,
lo que podes hacer es un ciclo for pingeando cada
una de las pcs.

De esta forma si te responden podes tirar una conexion
y realizar todo lo que necesites.

Mauro

Espero que te sirva la idea, el código no te lo paso xq
soy bastante nuevo en delphi y no sabria por donde empezar,
aunque lo hecho en visual y funciona bien.

Hola!

mauro al respecto de tu idea ya lo habia pensado, solo que las ip's de la red estan dadas dinamicamente. Así que resultaría algo lioso en hacer un ciclo para obtener una conexion.

Pero como comento el programa de cadetill me ha estado funcionando.

Salu2!