Mega Code Archive
Network Resource Tree (Network Browser)
<![CDATA[
Title: Network Resource Tree (Network Browser)
Question: Component that inherits from TCustomTreeView. Allows "Network Neighbourhood" style browsing. On double click event is passed the resource name and a TNetResource structure
typedef struct _NETRESOURCE { // nr
DWORD dwScope;
DWORD dwType;
DWORD dwDisplayType;
DWORD dwUsage;
LPTSTR lpLocalName;
LPTSTR lpRemoteName;
LPTSTR lpComment;
LPTSTR lpProvider;
} NETRESOURCE;
Mods and improvements are welcome as this is a brand new component of mine and as yet is not fully stress tested.
Answer:
unit NetTree;
interface
uses
Windows,Messages,SysUtils,Classes,Graphics,Controls,Forms,ComCtrls;
type
TNetTreeDblClick = procedure(Sender : TObject;
Name : string;
NetResource : TNetResource) of object;
TNetTree = class(TCustomTreeView)
private
{ Private declarations }
FOnDblClick : TNetTreeDblClick;
protected
{ Protected declarations }
procedure Loaded; override;
procedure Click; override;
procedure DblClick; override;
procedure NetResourceNode(TreeNode : TTreeNode;NetResource : TNetResource);
public
{ Public declarations }
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
published
{ Published declarations }
property OnDblClick : TNetTreeDblClick read FOnDblClick write FOnDblClick;
{ Expose proteced properties from Base class }
property OnEnter;
property OnExit;
property OnClick;
property Font;
property Align;
property Anchors;
property BorderStyle;
property BorderWidth;
property Color;
property Constraints;
property Cursor;
property Enabled;
property PopupMenu;
property Visible;
end;
procedure Register;
// -----------------------------------------------------------------------------
implementation
const MAXENTRIES = 200;
type TBuffer = array [1..MAXENTRIES] of TNetResource;
PTBuffer = ^TBuffer;
// Additional info to store at node
TNetNodeExtra = class(TObject)
private
FNetResource : TNetResource;
FChildsRun : boolean;
PlpLocalName,
PlpComment,
PlpProvider,
PlpRemoteName : PChar;
public
destructor Destroy; override;
procedure Assign(NR : TNetResource);
end;
procedure Register;
begin
RegisterComponents('Win95', [TNetTree]);
end;
// ===========================================
// TNetNodeExtra methods
// Pointer to lpRemoteName etc. get destroyed
// when Buffer is released - make a local
// copy in class and free in destructor
// ===========================================
destructor TNetNodeExtra.Destroy;
begin
if PlpRemoteName nil then FreeMem(PlpRemoteName);
if PlpLocalName nil then FreeMem(PlpLocalName);
if PlpComment nil then FreeMem(PlpComment);
if PlpProvider nil then FreeMem(PlpProvider);
inherited Destroy;
end;
procedure TNetNodeExtra.Assign(NR : TNetResource);
begin
FChildsRun := false;
FNetResource := NR;
if length(NR.lpRemoteName) = 0 then
PlpRemoteName := nil
else begin
GetMem(PlpRemoteName,length(NR.lpRemoteName) + 1);
StrCopy(PlpRemoteName,NR.lpRemoteName);
end;
if length(NR.lpLocalName) = 0 then
PlpLocalName := nil
else begin
GetMem(PlpLocalName,length(NR.lpLocalName) + 1);
StrCopy(PlpLocalName,NR.lpLocalName);
end;
if length(NR.lpComment) = 0 then
PlpComment := nil
else begin
GetMem(PlpComment,length(NR.lpComment) + 1);
StrCopy(PlpComment,NR.lpComment);
end;
if length(NR.lpProvider) = 0 then
PlpProvider := nil
else begin
GetMem(PlpProvider,length(NR.lpProvider) + 1);
StrCopy(PlpProvider,NR.lpProvider);
end;
FNetResource.lpRemoteName := PlpRemoteName;
FNetResource.lpLocalName := PlpLocalName;
FNetResource.lpComment := PlpComment;
FNetResource.lpProvider := PlpProvider;
end;
// ========================
// TNetTree methods
// ========================
constructor TNetTree.Create(AOwner : TComponent);
begin
inherited Create(AOwner);
HideSelection := false;
ReadOnly := true;
end;
destructor TNetTree.Destroy;
var i : integer;
NN : TNetNodeExtra;
begin
for i := 0 to Items.Count - 1 do begin
NN := Items[i].Data;
NN.Free;
end;
inherited Destroy;
end;
procedure TNetTree.Loaded;
var Dummy : TNetResource;
i,c : integer;
begin
// Create tree root if not design mode
// and add next level down
if not (csDesigning in ComponentState) then begin
Items.Clear;
NetResourceNode(nil,Dummy);
c := Items.Count - 1;
for i := 0 to c do
NetResourceNode(Items[i],TNetNodeExtra(Items[i].Data).FNetResource);
end;
end;
// ========================================
// Expand Net Resource and add to tree
// ========================================
procedure TNetTree.NetResourceNode(TreeNode : TTreeNode;
NetResource : TNetResource);
var EHandle : THandle;
MaxItems,BufLen,Loop,i,Err : longword;
Buffer : PTBuffer;
NetNodeExtra : TNetNodeExtra;
Network : TNetResource;
begin
GetMem(Buffer,SizeOf(TBuffer));
if TreeNode = nil then
Err := WNetOpenEnum(RESOURCE_GLOBALNET,
RESOURCETYPE_ANY,0,nil,EHandle)
else begin
Network := NetResource;
Err := WNetOpenEnum(RESOURCE_GLOBALNET,
RESOURCETYPE_ANY,0,@Network,EHandle);
end;
if Err = NO_ERROR then begin
repeat
MaxItems := MAXENTRIES;
BufLen := SizeOf(TBuffer);
Loop := WNetEnumResource(EHandle,MaxItems,Buffer,BufLen);
if Loop = NO_ERROR then
for i := 1 to MaxItems do begin
NetNodeExtra := TNetNodeExtra.Create;
NetNodeExtra.Assign(Buffer^[i]);
if Buffer^[i].lpRemoteName '' then
Items.AddChildObject(TreeNode,Buffer^[i].lpRemoteName,
NetNodeExtra)
else
Items.AddChildObject(TreeNode,Buffer^[i].lpProvider,
NetNodeExtra);
end;
until Loop = ERROR_NO_MORE_ITEMS;
FreeMem(Buffer);
WNetCloseEnum(EHandle);
end;
end;
// ===========================================================
// Add any children when item clicked - Logic flags built
// in to prevent unneeded repeats of expansions
// ===========================================================
procedure TNetTree.Click;
var NetNodeExtra : TNetNodeExtra;
begin
inherited Click;
Screen.Cursor := crHourGlass;
Application.Processmessages;
NetNodeExtra := TNetNodeExtra(Selected.Data);
if (Selected nil) and
(not NetNodeExtra.FChildsRun) and
(length(NetNodeExtra.FNetResource.lpRemoteName) 0) and
(not Selected.HasChildren) then begin
NetResourceNode(Selected,NetNodeExtra.FNetResource);
NetNodeExtra.FChildsRun := true;
end;
Screen.Cursor := crDefault;
end;
procedure TNetTree.DblClick;
begin
inherited DblClick;
if Assigned(FOnDblClick) then
FOnDblClick(Self,Selected.Text,
TNetNodeExtra(Selected.Data).FNetResource);
end;
end.
]]>