[Code Collection] 枚举LAN中的资源

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, ImgList;

type
  TForm1 = class(TForm)
    TreeView1: TTreeView;
    Button1: TButton;
    ImageList1: TImageList;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TEnumThread = class(TThread)
    FTV: TTreeView;
    FCurrentNode: TTreeNode; // working node
    FChildNodeStr: string; // working text

    procedure UpdateTree;
    procedure AddChildNode(ALanNode: PNetResource);
    procedure Execute; override;
    procedure EnumLan(ALanNode: PNetResource);
    constructor Create(ATreeView: TTreeView; CreateSuspended: boolean);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function GetNetRsrcScope(ANode: PNetResource): string;
begin
  case ANode.dwScope of
    RESOURCE_CONNECTED: Result :='Connected';
    RESOURCE_GLOBALNET: Result :='GlobalNet';
    RESOURCE_REMEMBERED: Result :='Remembered';
  else
    Result := 'Unknown Scope: ' + IntToStr(ANode.dwScope);
  end;
end;

function GetNetRsrcType(ANode: PNetResource): string;
begin
  case ANode.dwType of
    RESOURCETYPE_ANY: Result :='Any';
    RESOURCETYPE_DISK: Result :='Disk';
    RESOURCETYPE_PRINT: Result :='Print';
  else
    Result := 'Unknown Type: ' + IntToStr(ANode.dwType);
  end;
end;

function GetNetRsrcDispType(ANode: PNetResource): string;
begin
  case ANode.dwType of
    RESOURCEDISPLAYTYPE_DOMAIN: Result :='Domain';
    RESOURCEDISPLAYTYPE_GENERIC: Result :='Generic';
    RESOURCEDISPLAYTYPE_SERVER: Result :='Server';
    RESOURCEDISPLAYTYPE_SHARE: Result :='Share';
    RESOURCEDISPLAYTYPE_GROUP: Result :='Group';
    RESOURCEDISPLAYTYPE_NETWORK: Result :='Network';
    RESOURCEDISPLAYTYPE_ROOT: Result :='Root';
    RESOURCEDISPLAYTYPE_SHAREADMIN: Result :='ShareAdmin';
    RESOURCEDISPLAYTYPE_DIRECTORY: Result :='Directory';
    RESOURCEDISPLAYTYPE_TREE: Result :='Tree';
    RESOURCEDISPLAYTYPE_NDSCONTAINER: Result :='NDS Container';
  else
    Result :='Unknown Disp Type: ' + IntToStr(ANode.dwType);
  end;
end;

function GetNetRsrcUsage(ANode: PNetResource): string;
begin
  Result := '';
  if ANode.dwScope = RESOURCE_GLOBALNET then
  begin
    if (ANode.dwUsage and RESOURCEUSAGE_CONNECTABLE) <> 0 then Result := Result + 'Connectable';
    if (ANode.dwUsage and RESOURCEUSAGE_CONTAINER) <> 0 then Result := Result + 'Container';
    if (ANode.dwUsage and RESOURCEUSAGE_NOLOCALDEVICE) <> 0 then Result := Result + 'Connectable';
    if (ANode.dwUsage and RESOURCEUSAGE_SIBLING) <> 0 then Result := Result + 'Sibling';
    if (ANode.dwUsage and RESOURCEUSAGE_ATTACHED) <> 0 then Result := Result + 'Attached';
    if (ANode.dwUsage and RESOURCEUSAGE_RESERVED) <> 0 then Result := Result + 'Reserved';
  end;
end;

{ TEnumThread }

procedure TEnumThread.AddChildNode(ALanNode: PNetResource);
begin
  FChildNodeStr := StrPas(ALanNode.lpRemoteName);
    { + GetNetRsrcScope(ALanNode) + GetNetRsrcDispType(ALanNode) +
      GetNetRsrcUsage(ALanNode)}

  // show the node
  Synchronize(UpdateTree);

  // recursive call to build the network tree
  EnumLan(ALanNode);
end;

constructor TEnumThread.Create(ATreeView: TTreeView;
  CreateSuspended: boolean);
begin
  FTV := ATreeView;
  FCurrentNode := nil;
  FChildNodeStr := '';
  inherited Create(CreateSuspended);
end;

procedure TEnumThread.EnumLan(ALanNode: PNetResource);
var
  hEnum: THandle;
  Count, BufSize, Usage: DWORD;
  Buf, NetRsrc: PNetResource;
  ANode: TTreeNode;
  Ret: Integer;
begin
  if WNetOpenEnum(RESOURCE_GLOBALNET,RESOURCETYPE_ANY,0, ALanNode, hEnum) <> NO_ERROR
    then Exit;

  BufSize := $1;
  GetMem(Buf, BufSize);
  try
    while true do
    begin
      Count := $FFFFFFFF; // should be set before call WNetEnumResource
      Ret := WNetEnumResource(hEnum, Count, Buf, BufSize);
      if Ret = ERROR_MORE_DATA then
      begin
        // here the BufSize was set to Require Size by last WNetEnumResource Call
        FreeMem(Buf);
        GetMem(Buf, BufSize);
        Count := $FFFFFFFF; // should be set before call WNetEnumResource
        Ret := WNetEnumResource(hEnum, Count, Buf, BufSize);
      end;
      if (Ret = ERROR_NO_MORE_ITEMS) or (Count = 0) then break; // stop looping
      if Ret <> NO_ERROR then Abort; // error occurs

      NetRsrc := Buf;
      while Count > 0 do
      begin
        ANode := FCurrentNode;
        AddChildNode(NetRsrc);
        FCurrentNode := ANode;
        Inc(NetRsrc);
        Dec(Count);
      end; // end of count
    end; // end of while true
  finally
    WNetCloseEnum(hEnum);
    FreeMem(Buf);
  end;
end;

procedure TEnumThread.Execute;
begin
  EnumLan(nil);
end;

procedure TEnumThread.UpdateTree;
begin
  FCurrentNode := FTV.Items.AddChild(FCurrentNode, FChildNodeStr);
  FCurrentNode.ImageIndex := 2;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  AThread: TEnumThread;
begin
  AThread := TEnumThread.Create(TreeView1, false);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  TreeView1.Images := ImageList1;
end;

end.