Как узнать доступные сетевые pесуpсы

type
  PNetResourceArray = ^TNetResourceArray;
  TNetResourceArray =
  array [0..MaxInt div SizeOf(TNetResource) - 1] of TNetResource;

procedure EnumResources(LpNR:PNetResource);
var
  NetHandle: THandle;
  BufSize: Integer;
  Size: Integer;
  NetResources: PNetResourceArray;
  Count: Integer;
  NetResult: Integer;
  I: Integer;
  NewItem: TListItem;
begin
  if WNetOpenEnum(
  RESOURCE_GLOBALNET,
  RESOURCETYPE_ANY,
  // RESOURCETYPE_ANY - все ресурсы
  // RESOURCETYPE_DISK - диски
  // RESOURCETYPE_PRINT - принтеры
  0, LpNR, NetHandle) <> NO_ERROR then
    Exit;
  try
    BufSize := 50 * SizeOf(TNetResource);
    GetMem(NetResources, BufSize);
    try
      while True do
      begin
        Count := -1;
        Size := BufSize;
        NetResult := WNetEnumResource(NetHandle, Count, NetResources, Size);
        if NetResult = ERROR_MORE_DATA then
        begin
          BufSize := Size;
          ReallocMem(NetResources, BufSize);
          Continue;
        end;
        if NetResult <> NO_ERROR then
          Exit;
        for I := 0 to Count-1 do
        begin
          with NetResources^[I] do
          begin
            if RESOURCEUSAGE_CONTAINER = (DwUsage and RESOURCEUSAGE_CONTAINER) then
              EnumResources(@NetResources^[I]);

            if dwDisplayType = RESOURCEDISPLAYTYPE_SHARE then
            // ^^^^^^^^^^^^^^^^^^^^^^^^^ - ресурс
            // RESOURCEDISPLAYTYPE_SERVER - компьютер
            // RESOURCEDISPLAYTYPE_DOMAIN - рабочая группа
            // RESOURCEDISPLAYTYPE_GENERIC - сеть
            begin
              NewItem:= Form1.ListView1.Items.Add;
              NewItem.Caption:=LpRemoteName;
            end;
          end;
        end
      end;
    finally
      FreeMem(NetResources, BufSize);
    end;
  finally
    WNetCloseEnum(NetHandle);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  OldCursor: TCursor;
begin
  OldCursor:= Screen.Cursor;
  Screen.Cursor:= crHourGlass;
  with ListView1.Items do
  begin
    BeginUpdate;
    Clear;
    EnumResource(nil);
    EndUpdate;
  end;
  Screen.Cursor:= OldCursor;
end;

Автор: Михаил Немцов

обнаружил и исправил некоторые ошибки. Его код публикуется ниже:

type

PNetResourceArray = ^TNetResourceArray;
TNetResourceArray = array
[0..MaxInt div
 SizeOf(TNetResource) - 1] of
 TNetResource;


Procedure
 EnumResources(LpNR:PNetResource);
Var

NetHandle: DWORD;
BufSize: DWORD;
Size:DWORD;
NetResources: PNetResourceArray;
Count: DWORD;
NetResult:Integer;
I: Integer;
NewItem:TListItem;
Begin


If
 WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY,0,LpNR,NetHandle) <> NO_ERROR
then
 Exit;
Try

BufSize := 50 * SizeOf(TNetResource);
GetMem(NetResources, BufSize);
Try

while
 True
 do

begin

Count := 1;
Size := BufSize;
NetResult := WNetEnumResource(NetHandle, Count, NetResources, Size);
If
 NetResult = ERROR_MORE_DATA then

begin

BufSize := Size;
ReallocMem(NetResources, BufSize);
Continue;
end
;
if
 NetResult <> NO_ERROR then
 Exit;
For
 I := 0 to
 Count-1 do

Begin

With
 NetResources^[I] do

Begin

If
 RESOURCEUSAGE_CONTAINER =(DwUsage and
 RESOURCEUSAGE_CONTAINER) then

EnumResources(@NetResources^[I]);
If
 dwDisplayType = RESOURCEDISPLAYTYPE_SHARE Then

// ^^^^^^^^^^^^^^^^^^^^^^^^^ - ресурс
// RESOURCEDISPLAYTYPE_SERVER - компьютер
// RESOURCEDISPLAYTYPE_DOMAIN - рабочая группа
// RESOURCEDISPLAYTYPE_GENERIC - сеть
Begin

NewItem:= Form1.ListView1.Items.Add;
NewItem.Caption:=LpRemoteName;
End
;
End
;
End
;
End
;
finally

FreeMem(NetResources, BufSize);
end
;
finally

WNetCloseEnum(NetHandle);
end
;
End
;

procedure
 TForm1.Button1Click(Sender: TObject);
Var


OldCursor: TCursor;
begin


OldCursor:= Screen.Cursor;
Screen.Cursor:= crHourGlass;
With
 ListView1.Items do

Begin

BeginUpdate;
Clear;
EnumResources(nil
);
EndUpdate;
End
;
Screen.Cursor:= OldCursor;
end
;

end
.

Другое по теме:

• Состояние подключения к сети
• Как подключать сетевые диски
• Как подключить и отключить сетевые диски