Solved

Access to Network Neighborhood

Posted on 1997-06-16
4
236 Views
Last Modified: 2010-04-04
I want to access Network Neighborhood (Microsoft Networking) and register (in a file) all available servers together with the folder/ files they are sharing. I DON'T want to use TOpenDialog.

Can you help me?  

     ;-) Edwin
0
Comment
Question by:ewdrost
  • 2
4 Comments
 
LVL 2

Expert Comment

by:icampbe1
ID: 1337059
If the shell (explorer) can do it then so must I.. Right?  I believe that the net neighborhood is COM Object (Like a lot of other objects use by the shell).  What you need to do, is find out what methods are surfaced through the Object's interface and made available to you.  It's a lot like OLE Automation.  I'm not sure where to get the interface definition for the object though, maybe on the Microsoft SDK, its a good place to start.  (Funny isn't it... Microsoft develop the whole COM technology to accomplish exactly what you want to do, and then make it hard for you to do it.!!)

Ian C.
0
 

Author Comment

by:ewdrost
ID: 1337060
Ian,

sorry I had to give you a bad grade, but this was the part I figured out myself.

I thought of 2 options:
1. Create a shell link (that's what you suggested)
2. Use Microsoft DLL's (look in SDK)

Unfortunately I don't have the SDK (I'm a student)so that won't help me either.

   Thanx anyway....Edwin
0
 
LVL 3

Accepted Solution

by:
sperling earned 200 total points
ID: 1337061
Try this one. The TNetworkResource class should be rather selfexplanatory, but if you get problems, leave me a comment.

Should run on NT/95 under D2 and D3. Havent tested with D2 though.

Regards,

Erik.

---------starting unit1.dfm
object Form1: TForm1
  Left = 200
  Top = 102
  Width = 321
  Height = 357
  Caption = 'Form1'
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OnShow = FormShow
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 4
    Top = 220
    Width = 32
    Height = 13
    Caption = 'Label1'
  end
  object Label2: TLabel
    Left = 4
    Top = 238
    Width = 32
    Height = 13
    Caption = 'Label2'
  end
  object Label3: TLabel
    Left = 4
    Top = 257
    Width = 32
    Height = 13
    Caption = 'Label3'
  end
  object Label4: TLabel
    Left = 4
    Top = 275
    Width = 32
    Height = 13
    Caption = 'Label1'
  end
  object Label5: TLabel
    Left = 4
    Top = 294
    Width = 32
    Height = 13
    Caption = 'Label2'
  end
  object Label6: TLabel
    Left = 4
    Top = 312
    Width = 32
    Height = 13
    Caption = 'Label3'
  end
  object LB: TListBox
    Left = 0
    Top = 0
    Width = 310
    Height = 213
    ItemHeight = 13
    TabOrder = 0
    OnClick = LBClick
  end
  object Button1: TButton
    Left = 236
    Top = 300
    Width = 75
    Height = 25
    Caption = '&Refresh'
    TabOrder = 1
    OnClick = Button1Click
  end
end
---------ending unit1.dfm
---------starting unit1.pas
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    LB: TListBox;
    Button1: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure LBClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

type
  TNetResourceType = (rtUnknown, rtDisk, rtPrint);
  TNetDisplayType = (dtUnknown, dtDomain, dtGeneric, dtServer, dtShare);
  TNetUsageType = (utConnectable, utContainer);

  TNetworkResource = class
  private
  protected
    FParent        : TNetworkResource;
    FChildren      : TList;
    FResourceType  : TNetResourceType;
    FDisplayType   : TNetDisplayType;
    FUsageType     : TNetUsageType;
    FName,
    FComment,
    FProvider      : STRING;
    FNetRes        : PNetResource;
    function GetChildCount : INTEGER;
    function GetChild (index : INTEGER) : TNetworkResource;
    procedure FreeChildren;
    constructor Create (AParent : TNetworkResource; pNetRes : PNetResource);
    destructor Destroy; override;
  public
    procedure Refresh;
    property  Parent : TNetworkResource read FParent;
    property  ChildCount : INTEGER read GetChildCount;
    property  Child [index : INTEGER] : TNetworkResource read GetChild;
    property  ResourceType : TNetResourceType read FResourceType;
    property  DisplayType : TNetDisplayType read FDisplayType;
    property  UsageType : TNetUsageType read FUsageType;
    property  Name : STRING read FName;
    property  Comment : STRING read FComment;
    property  Provider : STRING read FProvider;
  end;

var
  Net : TNetworkResource;

function GetLastErrorText : STRING;
begin
  Result := IntToStr(GetLastError);
end;


function TNetworkResource.GetChildCount : INTEGER;
begin
  Result := 0;
  if (UsageType <> utContainer) then exit;
  if FChildren = nil then Refresh;
  Result := FChildren.Count;
end;

function TNetworkResource.GetChild (index : INTEGER) : TNetworkResource;
begin
  Result := nil;
  if (UsageType <> utContainer) or (index<0) or (index>=ChildCount) then exit;
  Result := TNetworkResource(FChildren[index]);
end;

constructor TNetworkResource.Create (AParent : TNetworkResource; pNetRes : PNetResource);
begin
  FParent := AParent;
  if FParent<>nil then
    FParent.FChildren.Add(Self);
  if pNetRes <> nil then begin
    if (pNetRes.dwUsage and $7FFFFFFF) = RESOURCEUSAGE_CONTAINER then begin
      new(FNetRes);
      FillChar(FNetRes^, SizeOf(TNetResource), 0);
      FNetRes.dwScope := pNetRes.dwScope;
      FNetRes.dwType := pNetRes.dwType;
      FNetRes.dwDisplayType := pNetRes.dwDisplayType;
      FNetRes.dwUsage := pNetRes.dwUsage;
      if pNetRes.lpLocalName <> nil then
        FNetRes.lpLocalName := StrNew(pNetRes.lpLocalName);
      if pNetRes.lpRemoteName <> nil then
        FNetRes.lpRemoteName := StrNew(pNetRes.lpRemoteName);
      if pNetRes.lpComment <> nil then
        FNetRes.lpComment := StrNew(pNetRes.lpComment);
      if pNetRes.lpProvider <> nil then
        FNetRes.lpProvider := StrNew(pNetRes.lpProvider);
    end;
    case pNetRes.dwType of
      RESOURCETYPE_DISK  : FResourceType := rtDisk;
      RESOURCETYPE_PRINT : FResourceType := rtPrint;
    end;
    case pNetRes.dwDisplayType of
      RESOURCEDISPLAYTYPE_DOMAIN  : FDisplayType := dtDomain;
      RESOURCEDISPLAYTYPE_GENERIC : FDisplayType := dtGeneric;
      RESOURCEDISPLAYTYPE_SERVER  : FDisplayType := dtServer;
      RESOURCEDISPLAYTYPE_SHARE   : FDIsplayType := dtShare;
    end;
    case (pNetRes.dwUsage and $7FFFFFFF) of
      RESOURCEUSAGE_CONNECTABLE   : FUsageType := utConnectable;
      RESOURCEUSAGE_CONTAINER     : FUsageType := utContainer;
    end;
    FName := StrPas(pNetRes.lpRemoteName);
    FComment := StrPas(pNetRes.lpComment);
    FProvider := StrPas(pNetRes.lpProvider);    
  end else begin
    FUsageType := utContainer;
    FName := 'Network root';
  end;
end;

destructor TNetworkResource.Destroy;
begin
  FreeChildren;
  if (FParent<>nil) and (FParent.FChildren.IndexOf(Self)>=0) then
    FParent.FChildren.Delete(FParent.FChildren.IndexOf(Self));
  FParent := nil;
  inherited;
end;

procedure TNetworkResource.FreeChildren;
begin
  if FChildren <> nil then begin
    while ChildCount > 0 do Child[ChildCount-1].Free;
    FChildren.Free;
    FChildren := nil;
  end;
end;

procedure TNetworkResource.Refresh;
var
  pNetRes   : PNetResource;
  BufSize,
  Entries,
  hEnum,
  Res       : INTEGER;
begin
  FreeChildren;
  if UsageType <> utContainer then exit;
  FChildren := TList.Create;
  GetMem (pNetRes, 4000);
  try
    if WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, 0, FNetRes, hEnum) <> 0 then
      raise Exception.CreateFmt('Error while opening network enumeration. (%s)', [GetLastErrorText]);
    Entries := 1;
    repeat
      BufSize := 4000;
      res := WNetEnumResource(hEnum, Entries, pNetRes, BufSize);
      if (res=0) then
        TNetworkResource.Create(Self, pNetRes);
    until res<>0;
    if res <> ERROR_NO_MORE_ITEMS then
      raise Exception.CreateFmt('Error while enumerating network. (%s)', [GetLastErrorText]);
  finally
    FreeMem(pNetRes);
  end;
end;


procedure TForm1.Button1Click(Sender: TObject);

  procedure AddToList (Nr : TNetworkResource; Indent : INTEGER);
  var
    s       : STRING;
    ndx     : INTEGER;
  begin
    s := '';
    for ndx := 1 to Indent do s := s + ' ';
    LB.Items.AddObject(s + NR.Name, NR);
    for ndx := 0 to NR.ChildCount-1 do
      AddToList(NR.Child[ndx], Indent+2);      
  end;

begin
  LB.Items.Clear;
  Net.Refresh;
  AddToList(Net, 0);
end;

procedure TForm1.LBClick(Sender: TObject);
var
  NR      : TNetworkResource;
  s       : STRING;
begin
  if LB.ItemIndex >= 0 then begin
    NR := TNetworkResource(LB.Items.Objects[LB.ItemIndex]);
    Label1.Caption := 'Name :' + NR.Name;
    Label2.Caption := 'Comment : '+NR.Comment;
    Label3.Caption := 'Provider : '+NR.Provider;

    case NR.ResourceType of
      rtUnknown : s := 'Unknown';
      rtDisk    : s := 'Disk';
      rtPrint   : s := 'Printer';
    end;
    Label4.Caption := 'Resource type : '+s;

    case NR.DisplayType of
      dtUnknown   : s := 'Unknown';
      dtDomain    : s := 'Domain';
      dtGeneric   : s := 'Generic';
      dtServer    : s := 'Server';
      dtShare     : s := 'Share';
    end;
    Label5.Caption := 'Display type : '+s;

    case NR.UsageType of
      utConnectable : Label6.Caption := 'Resource is connectable';
      utContainer : Label6.Caption := 'Resource is a container';
    end;
  end;
end;


procedure TForm1.FormShow(Sender: TObject);
begin
  Button1.Click;
  LB.ItemIndex := 0;
  LBClick(LB);
end;

initialization
  Net := TNetworkResource.Create(nil, nil);
end.
---------ending unit1.pas

0
 

Author Comment

by:ewdrost
ID: 1337062
This was just what I've been looking for, unfortunately I'm a little busy right now because I have to study.

But I will use this routines in the project I have in mind.

Thanks (1000 times), Edwin
(E.W.Drost@Student.UTwente.Nl)

0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
Get a first impression of how PRTG looks and learn how it works.   This video is a short introduction to PRTG, as an initial overview or as a quick start for new PRTG users.
This demo shows you how to set up the containerized NetScaler CPX with NetScaler Management and Analytics System in a non-routable Mesos/Marathon environment for use with Micro-Services applications.

746 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

17 Experts available now in Live!

Get 1:1 Help Now