1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80
| unit Unit2;
interface
uses Windows;
type
TEnumNetworkProc = procedure(const aNetResource :TNetResource; const aLevel :word; var aContinue :boolean) of object;
procedure EnumNetwork(const aEnumNetworkProc :TEnumNetworkProc; const aScope :dword = RESOURCE_GLOBALNET; const aType :dword = RESOURCETYPE_ANY);
implementation
//Procédure récursive
procedure DoEnumNetwork(const aContainer :Pointer;
const aEnumNetworkProc :TEnumNetworkProc;
const aScope :dword;
const aType :dword;
const aLevel :byte);
type
PNetResourceArray = ^TNetResourceArray;
TNetResourceArray = array [0..0] of TNetResource;
var
NetHandle :THandle;
NetResources :PNetResourceArray;
NetResult :dword;
Size, Count, i :Cardinal;
Continue :boolean;
begin
Continue := TRUE;
NetResult := WNetOpenEnum(aScope, aType, 0, aContainer, NetHandle);
if NetResult = NO_ERROR then
try
//Taille de base
Size := 50 *SizeOf(TNetResource);
GetMem(NetResources, Size);
try
while Continue do
begin
Count := $FFFFFFFF;
NetResult := WNetEnumResource(NetHandle, Count, NetResources, Size);
//Taille insuffisante ?
if NetResult = ERROR_MORE_DATA
then ReallocMem(NetResources, Size)
else Break;
end;
//Enumère
if NetResult = NO_ERROR then
for i := 0 to Count - 1 do
begin
//Callback
if Assigned(aEnumNetworkProc) then
begin
aEnumNetworkProc(NetResources^[i], aLevel, Continue);
if not Continue then Break;
end;
//Appel récursif
if (NetResources^[i].dwUsage and RESOURCEUSAGE_CONTAINER) > 0 then
DoEnumNetwork(@NetResources^[i], aEnumNetworkProc, aScope, aType, aLevel +1);
end;
finally
FreeMem(NetResources, Size);
end;
finally
WNetCloseEnum(NetHandle);
end;
end;
procedure EnumNetwork(const aEnumNetworkProc: TEnumNetworkProc; const aScope, aType: dword);
begin
DoEnumNetwork(nil, aEnumNetworkProc, aScope, aType, 0);
end;
end. |
Partager