Go Premium for a chance to win a PS4. Enter to Win

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 245
  • Last Modified:

Access to Network Neighborhood

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
ewdrost
Asked:
ewdrost
  • 2
1 Solution
 
icampbe1Commented:
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
 
ewdrostAuthor Commented:
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
 
sperlingCommented:
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
 
ewdrostAuthor Commented:
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

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now