delphi 网络邻居的列表|笨鱼技术网

如果你问如何能得到网络邻居的列表，那是一个非常复杂的任务

您将不得不和非常不友好的OLE对象打交道

下面两个过程可能会对你有用

procedure GetDomainList(TV:TTreeView);
var
a : Integer;
ErrCode : Integer;
NetRes : Array[0..1023] of TNetResource;
EnumHandle : THandle;
EnumEntries : DWord;

BufferSize : DWord;
s           : string;
itm         : TTreeNode;
begin
{ Start here }
try
    With NetRes[0] do begin
      dwScope       :=RESOURCE_GLOBALNET;
      dwType        :=RESOURCETYPE_ANY;
      dwDisplayType :=RESOURCEDISPLAYTYPE_DOMAIN;
      dwUsage       :=RESOURCEUSAGE_CONTAINER;
      lpLocalName   :=NIL;
      lpRemoteName :=NIL;
      lpComment     :=NIL;
      lpProvider    :=NIL;
    end;
    { get net root }
    ErrCode:=WNetOpenEnum(
      RESOURCE_GLOBALNET,
      RESOURCETYPE_ANY,
      RESOURCEUSAGE_CONTAINER,
      @NetRes[0],

      EnumHandle
    );
    If ErrCode=NO_ERROR then begin
      EnumEntries:=1;
      BufferSize:=SizeOf(NetRes);
      ErrCode:=WNetEnumResource(
        EnumHandle,
        EnumEntries,
        @NetRes[0],
        BufferSize
      );
      WNetCloseEnum(EnumHandle);
      ErrCode:=WNetOpenEnum(
        RESOURCE_GLOBALNET,
        RESOURCETYPE_ANY,
        RESOURCEUSAGE_CONTAINER,
        @NetRes[0],
        EnumHandle
      );
      EnumEntries:=1024;
      BufferSize:=SizeOf(NetRes);
      ErrCode:=WNetEnumResource(
        EnumHandle,
        EnumEntries,
        @NetRes[0],
        BufferSize
      );
      IF ErrCode=No_Error then with TV do try
        a:=0;
        Items.BeginUpDate;
        Items.Clear;

        Itm:=Items.Add(TV.Selected,string(NetRes[0].lpProvider));
        Itm.ImageIndex:=0;
        Itm.SelectedIndex:=0;

{ get domains }
While a How can I get the contents of the Neighborhood?

The following unit defines a component, TNetworkBrowser, which can be used
to enumerate all resources on the network in a hierarchical tree. The
actual browsing takes a long time (try opening "Entire Network" in Windows
Explorer). If you set the Scope property to nsContext, you'll see the list

of machines from the "Network Neighborhood" window.
下面的一个单元定义了一个组件. TNetworkBrowser, 可以枚举hierachical树上所有
的网络资源. 实际上浏览是要花费很长时间的,这您可以通过在WINDOWS资源管理器
中打开"整个网络" 来比较一下. 如果你设置SCOPE属性为nsContext , 你就可以看到
和网络邻居中一样的机器列表

Yorai Aminov
El-On Software Systems

unit NetBrwsr;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
TNetScope = (nsConnected, nsGlobal, nsRemembered, nsContext);

TNetResourceType = (nrAny, nrDisk, nrPrint);
TNetDisplay = (ndDomain, ndGeneric, ndServer, ndShare, ndFile, ndGroup,
ndNetwork, ndRoot, ndShareAdmin, ndDirectory, ndTree, ndNDSContainer);
TNetUsage = set of (nuConnectable, nuContainer);

TNetworkItems = class;

TNetworkItem = class
private
    FScope: TNetScope;
    FResourceType: TNetResourceType;
    FDisplay: TNetDisplay;
    FUsage: TNetUsage;
    FLocalName: string;
    FRemoteName: string;
    FComment: string;
    FProvider: string;
    FSubItems: TNetworkItems;
public
    constructor Create;
    destructor Destroy; override;
    property Scope: TNetScope read FScope;

    property ResourceType: TNetResourceType read FResourceType;
    property Display: TNetDisplay read FDisplay;
    property Usage: TNetUsage read FUsage;
    property LocalName: string read FLocalName;
    property RemoteName: string read FRemoteName;
    property Comment: string read FComment;
    property Provider: string read FProvider;
    property SubItems: TNetworkItems read FSubItems;
end;

TNetworkItems = class
private
    FList: TList;
    procedure SetItem(Index: Integer; Value: TNetworkItem);
    function GetItem(Index: Integer): TNetworkItem;

    function GetCount: Integer;
public
    constructor Create;
    destructor Destroy; override;
    procedure Clear;
    procedure Add(Item: TNetworkItem);
    procedure Delete(Index: Integer);
    property Items[Index: Integer]: TNetworkItem read GetItem write
SetItem; default;
    property Count: Integer read GetCount;
end;

TNetworkBrowser = class(TComponent)
private
    FItems: TNetworkItems;
    FScope: TNetScope;
    FResourceType: TNetResourceType;
    FUsage: TNetUsage;
    FActive: Boolean;
    procedure Refresh;
    procedure SetActive(Value: Boolean);
    procedure SetScope(Value: TNetScope);

    procedure SetResourceType(Value: TNetResourceType);
    procedure SetUsage(Value: TNetUsage);
    procedure EnumerateNet(NetItems: TNetworkItems; lpnr: PNetResource);
protected
public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Open;
    procedure Close;
    property Items: TNetworkItems read FItems;
published
    property Scope: TNetScope read FScope write SetScope default nsGlobal;
    property ResourceType: TNetResourceType read FResourceType
      write SetResourceType default nrAny;
    property Usage: TNetUsage read FUsage write SetUsage default [];

property Active: Boolean read FActive write SetActive default False;
end;

implementation

type
PNetResourceArray = ^TNetResourceArray;
TNetResourceArray = array[0..0] of TNetResource;

{ TNetworkItem }

constructor TNetworkItem.Create;
begin
inherited;
FSubItems := TNetworkItems.Create;
end;

destructor TNetworkItem.Destroy;
begin
if FSubItems <> nil then
FSubItems.Free;
inherited;
end;

{ TNetworkItems }

constructor TNetworkItems.Create;
begin
inherited;
FList := TList.Create;
end;

destructor TNetworkItems.Destroy;

begin
Clear;
if FList <> nil then
FList.Free;
inherited;
end;

procedure TNetworkItems.SetItem(Index: Integer; Value: TNetworkItem);
begin
if (FList.Items[Index] <> nil) and (FList.Items[Index] <> Value) then
TNetworkItem(FList.Items[Index]).Free;
FList.Items[Index] := Value;
end;

function TNetworkItems.GetItem(Index: Integer): TNetworkItem;
begin
Result := TNetworkItem(FList.Items[Index]);
end;

procedure TNetworkItems.Clear;
begin
while Count > 0 do
Delete(0);
end;

procedure TNetworkItems.Add(Item: TNetworkItem);
begin

FList.Add(Item);
end;

procedure TNetworkItems.Delete(Index: Integer);
begin
if FList.Items[Index] <> nil then
TNetworkItem(FList.Items[Index]).Free;
FList.Delete(Index);
end;

function TNetworkItems.GetCount: Integer;
begin
if FList <> nil then
Result := FList.Count
else
Result := 0;
end;

{ TNetworkBrowser }

constructor TNetworkBrowser.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FItems := TNetworkItems.Create;
FScope := nsGlobal;
FResourceType := nrAny;
FUsage := [];
end;

destructor TNetworkBrowser.Destroy;
begin
if FItems <> nil then
FItems.Free;

inherited;
end;

procedure TNetworkBrowser.EnumerateNet(NetItems: TNetworkItems; lpnr:
PNetResource);
var
dwResult, dwResultEnum: Integer;
hEnum: THandle;
cbBuffer, cEntries, i: Integer;
nrArray: PNetResourceArray;
NewItem: TNetworkItem;
dwScope, dwType, dwUsage: Integer;
begin
cbBuffer := 16384;
cEntries := $FFFFFFFF;

case FScope of
    nsConnected: dwScope := RESOURCE_CONNECTED;
    nsGlobal: dwScope := RESOURCE_GLOBALNET;
    nsRemembered: dwScope := RESOURCE_REMEMBERED;

    nsContext: dwScope := RESOURCE_CONTEXT;
else
    dwScope := RESOURCE_GLOBALNET;
end;
case FResourceType of
    nrAny: dwType := RESOURCETYPE_ANY;
    nrDisk: dwType := RESOURCETYPE_DISK;
    nrPrint: dwType := RESOURCETYPE_PRINT;
else
    dwType := RESOURCETYPE_ANY;
end;
dwUsage := 0;
if nuConnectable in FUsage then
    dwUsage := dwUsage or RESOURCEUSAGE_CONNECTABLE;
if nuContainer in FUsage then
    dwUsage := dwUsage or RESOURCEUSAGE_CONTAINER;

dwResult := WNetOpenEnum(dwScope, dwType, dwUsage, lpnr, hEnum);

if dwResult <> NO_ERROR then Exit;

GetMem(nrArray, cbBuffer);
repeat
    dwResultEnum := WNetEnumResource(hEnum, cEntries, nrArray, cbBuffer);
    if dwResultEnum = NO_ERROR then
      for i := 0 to cEntries-1 do
      begin
        NewItem := TNetworkItem.Create;
        case nrArray[i].dwScope of
          RESOURCE_CONNECTED: NewItem.FScope := nsConnected;
          RESOURCE_GLOBALNET: NewItem.FScope := nsGlobal;
          RESOURCE_REMEMBERED: NewItem.FScope := nsRemembered;
          RESOURCE_CONTEXT:    NewItem.FScope := nsContext;

        else
          NewItem.FScope := nsGlobal;
        end;
        case nrArray[i].dwType of
          RESOURCETYPE_ANY:   NewItem.FResourceType := nrAny;
          RESOURCETYPE_DISK: NewItem.FResourceType := nrDisk;
          RESOURCETYPE_PRINT: NewItem.FResourceType := nrPrint;
        else
          NewItem.FResourceType := nrAny;
        end;
        case nrArray[i].dwDisplayType of
          RESOURCEDISPLAYTYPE_GENERIC:      NewItem.FDisplay := ndGeneric;
          RESOURCEDISPLAYTYPE_DOMAIN:       NewItem.FDisplay := ndDomain;

          RESOURCEDISPLAYTYPE_SERVER:       NewItem.FDisplay := ndServer;
          RESOURCEDISPLAYTYPE_SHARE:        NewItem.FDisplay := ndShare;
          RESOURCEDISPLAYTYPE_FILE:         NewItem.FDisplay := ndFile;
          RESOURCEDISPLAYTYPE_GROUP:        NewItem.FDisplay := ndGroup;
          RESOURCEDISPLAYTYPE_NETWORK:      NewItem.FDisplay := ndNetwork;
          RESOURCEDISPLAYTYPE_ROOT:         NewItem.FDisplay := ndRoot;
          RESOURCEDISPLAYTYPE_SHAREADMIN:   NewItem.FDisplay :=

ndShareAdmin;
          RESOURCEDISPLAYTYPE_DIRECTORY:    NewItem.FDisplay :=
ndDirectory;
          RESOURCEDISPLAYTYPE_TREE:         NewItem.FDisplay := ndTree;
          RESOURCEDISPLAYTYPE_NDSCONTAINER: NewItem.FDisplay :=
ndNDSContainer;
        else
          NewItem.FDisplay := ndGeneric;
        end;
        NewItem.FUsage := [];
        if nrArray[i].dwUsage and RESOURCEUSAGE_CONNECTABLE <> 0 then
          Include(NewItem.FUsage, nuConnectable);
        if nrArray[i].dwUsage and RESOURCEUSAGE_CONTAINER <> 0 then

          Include(NewItem.FUsage, nuContainer);
        NewItem.FLocalName := StrPas(nrArray[i].lpLocalName);
        NewItem.FRemoteName := StrPas(nrArray[i].lpRemoteName);
        NewItem.FComment := StrPas(nrArray[i].lpComment);
        NewItem.FProvider := StrPas(nrArray[i].lpProvider);
        NetItems.Add(NewItem);
        // if container, call recursively
        if (nuContainer in NewItem.FUsage) and (FScope <> nsContext) then
          EnumerateNet(NewItem.FSubItems, @nrArray[i])

end;
until dwResultEnum = ERROR_NO_MORE_ITEMS;

FreeMem(nrArray);
WNetCloseEnum(hEnum);
end;

procedure TNetworkBrowser.Refresh;
begin
FItems.Clear;
if FActive then
EnumerateNet(FItems, nil);
end;

procedure TNetworkBrowser.SetActive(Value: Boolean);
begin
if Value <> FActive then
begin
FActive := Value;
Refresh;
end;
end;

procedure TNetworkBrowser.SetScope(Value: TNetScope);
begin
if Value <> FScope then
begin
FScope := Value;
Refresh;
end;
end;

procedure TNetworkBrowser.SetResourceType(Value: TNetResourceType);
begin
if Value <> FResourceType then
begin
FResourceType := Value;
Refresh;
end;
end;

procedure TNetworkBrowser.SetUsage(Value: TNetUsage);
begin
if Value <> FUsage then
begin
FUsage := Value;
Refresh;
end;
end;

procedure TNetworkBrowser.Open;
begin
Active := True;
end;

procedure TNetworkBrowser.Close;
begin
Active := False;
end;

end.

unit FindComp;

interface

uses

Windows, Classes;

function FindComputers: DWORD;

var

Computers: TStringList;

implementation

uses

SysUtils;

const

MaxEntries = 250;

function FindComputers: DWORD;

var

EnumWorkGroupHandle, EnumComputerHandle: THandle;

EnumError: DWORD;

Network: TNetResource;

WorkGroupEntries, ComputerEntries: DWORD;

EnumWorkGroupBuffer, EnumComputerBuffer: array[1..MaxEntries] of TNetResource;

EnumBufferLength: DWORD;

I, J: DWORD;

begin

Computers.Clear;

FillChar(Network, SizeOf(Network), 0);

with Network do

begin

dwScope := RESOURCE_GLOBALNET;

dwType := RESOURCETYPE_ANY;

dwUsage := RESOURCEUSAGE_CONTAINER;

end;

EnumError := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, 0, @Network, EnumWorkGroupHandle);

if EnumError = NO_ERROR then

begin

WorkGroupEntries := MaxEntries;

EnumBufferLength := SizeOf(EnumWorkGroupBuffer);

EnumError := WNetEnumResource(EnumWorkGroupHandle, WorkGroupEntries, @EnumWorkGroupBuffer, EnumBufferLength);

if EnumError = NO_ERROR then

begin

for I := 1 to WorkGroupEntries do

begin

EnumError := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, 0, @EnumWorkGroupBuffer[I], EnumComputerHandle);

if EnumError = NO_ERROR then

begin

ComputerEntries := MaxEntries;

EnumBufferLength := SizeOf(EnumComputerBuffer);

EnumError := WNetEnumResource(EnumComputerHandle, ComputerEntries, @EnumComputerBuffer, EnumBufferLength);

if EnumError = NO_ERROR then

for J := 1 to ComputerEntries do

Computers.Add(Copy(EnumComputerBuffer[J].lpRemoteName, 3, Length(EnumComputerBuffer[J].lpRemoteName) - 2));

WNetCloseEnum(EnumComputerHandle);

end;

WNetCloseEnum(EnumWorkGroupHandle);

end;

if EnumError = ERROR_NO_MORE_ITEMS then

EnumError := NO_ERROR;

Result := EnumError;

end;

initialization

Computers := TStringList.Create;

finalization

Computers.Free;

end.