Localizar computadoras en la red y conectarse a ellas

madman · #1 20-06-2003

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!

jachguate · #2 24-06-2003

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.

madman · #3 24-06-2003

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.

__cadetill · #4 24-06-2003

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

).

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.

madman · #5 25-06-2003

Gracias Cadetill!

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

Saludos!

madman · #6 25-06-2003

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.

__cadetill · #7 25-06-2003

Ups, creo que me pase borrando cosas, jejeje

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

__cadetill · #8 25-06-2003

Bueno, pues ya lo tengo

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

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

madman · #9 25-06-2003

Gracias de nuevo cadetill!

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

jachguate · #10 26-06-2003

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.

__cadetill · #11 26-06-2003

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

jachguate · #12 26-06-2003

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

Hasta luego.

acertij022 · #13 26-06-2003

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

Salud2

madman · #14 28-06-2003

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.

mauro · #15 30-06-2003

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.

madman · #16 30-06-2003

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!