gilsonnrodrigues
Moderador
Registrado: Quinta-Feira, 14 de Abril de 2005
Mensagens: 9009
Localização: Governador Valadares-MG
|
 Enviada: Sex Ago 10, 2007 1:07 pm Assunto: |
 |
|
| Código: | type
PNetResourceArray = ^TNetResourceArray;
TNetResourceArray = array[0..100] of TNetResource;
function CreateNetResourceList(ResourceType : DWord;
NetResource : PNetResource;
out Entries : DWord;
out List : PNetResourceArray) : Boolean;
var
EnumHandle : THandle;
BufSize : DWord;
Res : DWord;
begin
Result := False;
List := nil;
Entries := 0;
if WNetOpenEnum(RESOURCE_GLOBALNET, ResourceType, 0, NetResource, EnumHandle) = NO_ERROR then
begin
try
BufSize := $4000; // 16 kByte
GetMem(List, BufSize);
try
repeat
Entries := DWord(-1);
FillChar(List^, BufSize, 0);
Res := WNetEnumResource(EnumHandle, Entries, List, BufSize);
if Res = ERROR_MORE_DATA then
begin
ReAllocMem(List, BufSize);
end;
until not (Res = ERROR_MORE_DATA);
Result := Res = NO_ERROR;
if not Result then
begin
FreeMem(List);
List := nil;
Entries := 0;
end;
except
FreeMem(List);
raise;
end;
finally
WNetCloseEnum(EnumHandle);
end;
end;
end;
procedure ScanNetworkResources(ResourceType, DisplayType : DWord; List : TStrings);
procedure ScanLevel(NetResource : PNetResource);
var
Entries : DWord;
NetResourceList : PNetResourceArray;
i : Integer;
begin
if CreateNetResourceList(ResourceType, NetResource, Entries, NetResourceList) then
try
for i := 0 to Integer(Entries) - 1 do
begin
if (DisplayType = RESOURCEDISPLAYTYPE_GENERIC) or
(NetResourceList[i].dwDisplayType = DisplayType) then
begin
List.AddObject(NetResourceList[i].lpRemoteName, Pointer(NetResourceList[i].dwDisplayType));
end;
if not ((NetResourceList[i].dwUsage and RESOURCEUSAGE_CONTAINER) = 0) then
ScanLevel(@NetResourceList[i]);
end;
finally
FreeMem(NetResourceList);
end;
end;
begin
ScanLevel(nil);
end; |
exemplos de uso:
Lista os Pcs em rede
| Código: | procedure TForm1.Button1Click(Sender : TObject);
begin
ScanNetworkResources(RESOURCETYPE_DISK, RESOURCEDISPLAYTYPE_SERVER, ListBox1.Items);
end; |
lista os compartilhamentos
| Código: | procedure TForm1.Button1Click(Sender : TObject);
begin
ScanNetworkResources(RESOURCETYPE_DISK, RESOURCEDISPLAYTYPE_SHARE, ListBox1.Items);
end; |
Lista tudo:
| Código: | procedure TForm1.Button1Click(Sender : TObject);
begin
ScanNetworkResources(RESOURCETYPE_DISK, RESOURCEDISPLAYTYPE_GENERIC, ListBox1.Items);
end; |
espero ter ajudado!!! |
|
FAQ
Pesquisar
Membros
Grupos
Registrar
Perfil
Entrar e ver Mensagens Particulares
Entrar
