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

Советы » Сеть » Как узнать доступные сетевые 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

.

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

Категории

Статьи

Советы

Copyright © 2023 - All Rights Reserved - www.delphirus.com