Получение дерева сети

unit Unit1;

interface

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

type

 TNetRes=class(TObject)
  dwScope: DWORD;
  dwType: DWORD;
  dwDisplayType: DWORD;
  dwUsage: DWORD;
  LocalName: string;
  RemoteName: string;
  Comment: string;
  Provider: string;
  PassWord:string;
  lastI,lastInterval:integer;
  function GetNetResource:TNetResource;
 end;

  TfmMain = class(TForm)
    btUpdate: TButton;
    tv: TTreeView;
    edMaxCount: TEdit;
    Label1: TLabel;
    procedure btUpdateClick(Sender: TObject);
  private
   MaxCount:integer;
  public
   procedure ClearListNet;
   procedure NumerateNet(Node:TTreeNode;PNetNode:PNetResource);
  end;

var
  fmMain: TfmMain;

implementation

{$R *.DFM}

function TNetRes.GetNetResource:TNetResource;
begin
 Result.dwScope:=dwScope;
 Result.dwType:=dwType;
 Result.dwDisplayType:=dwDisplayType;
 Result.dwUsage:=dwUsage;
 Result.lpLocalName:=pchar(LocalName);
 Result.lpRemoteName:=pchar(RemoteName);
 Result.lpComment:=pchar(Comment);
 Result.lpProvider:=pchar(Provider);
end;

procedure TfmMain.ClearListNet;
var
 i:integer;
 NR:TNetRes;
 Nodes:TTreeNodes;
 Node:TTreeNode;
begin
 Nodes:=tv.Items;
 for i:=Nodes.Count-1 downto 0 do begin
  Node:=Nodes[i];
  if (TObject(Node.Data) is TNetRes) then begin
   NR:=TNetRes(Node.Data);
   WNetCancelConnection2(pchar(NR.RemoteName),0,true);
   NR.Free;
  end;
 end;
 tv.Items.Clear;
end;

procedure TfmMain.NumerateNet(Node:TTreeNode;PNetNode:PNetResource);
type
  PNetResourceArray = ^TNetResourceArray;
  TNetResourceArray = array[0..MaxInt div SizeOf(TNetResource) - 1] of TNetResource;
var
  I, Count, BufSize, Size, NetResult: Integer;
  NetHandle: THandle;
  NetResources: PNetResourceArray;
  NR:TNetRes;
  subNode:TTreeNode;
begin
 if (tv.Items.Count>MaxCount) and(MaxCount<>0) then exit;
 if WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY,
 0, PNetNode,NetHandle) <> NO_ERROR then Exit;
// RESOURCE_GLOBALNET
// RESOURCE_CONNECTED
// RESOURCE_REMEMBERED
 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
      NR:=TNetRes.Create;
      NR.dwScope:=dwScope;
      NR.dwType:=dwType;
      NR.dwDisplayType:=dwDisplayType;
      NR.dwUsage:=dwUsage;
      NR.LocalName:=lpLocalName;
      NR.RemoteName:=lpRemoteName;
      NR.Comment:=lpComment;
      NR.Provider:=lpProvider;
      if lpRemoteName<>nil
      then subNode:=tv.Items.AddChildObject(Node,lpRemoteName,NR)
      else subNode:=tv.Items.AddChildObject(Node,'Provider: '+lpProvider,NR);
      if NR.dwUsage=RESOURCEUSAGE_CONTAINER then begin
       NumerateNet(subNode,@(NetResources^[I]));
      end;
      Application.ProcessMessages;
     end;
    end;
   end;
  finally
   FreeMem(NetResources, BufSize);
  end;
 finally
  WNetCloseEnum(NetHandle);
 end;
end;

procedure TfmMain.btUpdateClick(Sender: TObject);
begin
 tv.Items.Clear;
 ClearListNet;
 MaxCount:=strtoint(edMaxCount.Text);
 NumerateNet(nil,nil);
end;

end.