Delphi-Help

  • Increase font size
  • Default font size
  • Decrease font size
Главная Статьи Сеть Как узнать все доступные сетевые pесуpсы?

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

Оцените материал
(0 голосов)

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

uses
  ..., ComCtrls;
 
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, Cardinal( Count ), NetResources, Cardinal( 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
Прочитано 5487 раз

Авторизация



Счетчики