Localizar computadoras en la red y conectarse a ellas

[madman]

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]

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]

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]

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


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]

Gracias Cadetill!

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

Saludos!

[madman]

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


Posteado originalmente por cadetill, con algunas observaciones por madman


//---------------------------------------------------------------------------------
***** 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:

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:

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]

Ups, creo que me pase borrando cosas, jejeje

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

[__cadetill]

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

[madman]

Gracias de nuevo cadetill!

:D

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

[jachguate]

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]

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]

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

Hasta luego.
;)

[acertij022]

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

Salud2;)

[madman]

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]

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]

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!