Browsing for a Network Machine (ala Network Neighborhood)

From: mloeffler@teletrade.com (Michael J. Loeffler)

{
  Network resource utility.  Similar in function to NetWork-
  Neighborhood.

  Michael J. Loeffler
  1997.01.31
}

unit netres_main_unit;

interface

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

type
  TfrmMain = class(TForm)
    tvResources: TTreeView;
    btnOK: TBitBtn;
    btnClose: TBitBtn;
    Label1: TLabel;
    barBottom: TStatusBar;
    popResources: TPopupMenu;
    mniExpandAll: TMenuItem;
    mniCollapseAll: TMenuItem;
    mniSaveToFile: TMenuItem;
    mniLoadFromFile: TMenuItem;
    grpListType: TRadioGroup;
    grpResourceType: TRadioGroup;
    dlgOpen: TOpenDialog;
    dlgSave: TSaveDialog;
    procedure FormCreate(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure mniExpandAllClick(Sender: TObject);
    procedure mniCollapseAllClick(Sender: TObject);
    procedure mniSaveToFileClick(Sender: TObject);
    procedure mniLoadFromFileClick(Sender: TObject);
    procedure btnOKClick(Sender: TObject);
  private
    ListType, ResourceType: DWORD;
    procedure ShowHint(Sender: TObject);
    procedure DoEnumeration;
    procedure DoEnumerationContainer(NetResContainer: TNetResource);
    procedure AddContainer(NetRes: TNetResource);
    procedure AddShare(TopContainerIndex: Integer; NetRes:
TNetResource);
    procedure AddShareString(TopContainerIndex: Integer; ItemName:
String);
    procedure AddConnection(NetRes: TNetResource);
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.DFM}

procedure TfrmMain.ShowHint(Sender: TObject);
begin
  barBottom.Panels.Items[0].Text:=Application.Hint;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  Application.OnHint:=ShowHint;
  barBottom.Panels.Items[0].Text:='';
end;

procedure TfrmMain.btnCloseClick(Sender: TObject);
begin
  Close;
end;

{
  Enumerate through all network resources:
}
procedure TfrmMain.DoEnumeration;
var
  NetRes: Array[0..2] of TNetResource;
  Loop: Integer;
  r, hEnum, EntryCount, NetResLen: DWORD;
begin
  case grpListType.ItemIndex of
    { Connected resources: }
    1: ListType:=RESOURCE_CONNECTED;
    { Persistent resources: }
    2: ListType:=RESOURCE_REMEMBERED;
    { Global: }
    else ListType:=RESOURCE_GLOBALNET;
  end;

  case grpResourceType.ItemIndex of
    { Disk resources: }
    1: ResourceType:=RESOURCETYPE_DISK;
    { Print resources: }
    2: ResourceType:=RESOURCETYPE_PRINT;
    { All: }
    else ResourceType:=RESOURCETYPE_ANY;
  end;

  Screen.Cursor:=crHourGlass;

  try
    { Delete any old items in the tree view: }
    for Loop:=tvResources.Items.Count-1 downto 0 do
      tvResources.Items[Loop].Delete;
  except
  end;

  { Start enumeration: }
  r:=WNetOpenEnum(ListType,ResourceType,0,nil,hEnum);
  if r<>NO_ERROR then
  begin
    if r=ERROR_EXTENDED_ERROR then
      MessageDlg('Unable to Enumerate the Network.'+#13+
        'A network-specific error occurred.',mtError,[mbOK],0)
    else
      MessageDlg('Unable to Enumerate the Network.',
        mtError,[mbOK],0);
    Exit;
  end;

  try
    { We got a valid enumeration handle; walk the resources: }
    while (1=1) do
    begin
      EntryCount:=1;
      NetResLen:=SizeOf(NetRes);
      r:=WNetEnumResource(hEnum,EntryCount,@NetRes,NetResLen);
      case r of
        0: begin
          { It's a container, iterate it: }
          if NetRes[0].dwUsage=RESOURCEUSAGE_CONTAINER then
            DoEnumerationContainer(NetRes[0])
          else
            { Persistent and connected resources show up here: }
            if ListType in [RESOURCE_REMEMBERED,RESOURCE_CONNECTED]
then
              AddConnection(NetRes[0]);
        end;

        { Done: }
        ERROR_NO_MORE_ITEMS: Break;
        { Other error: }
        else begin
          MessageDlg('Error Walking Resources.',mtError,[mbOK],0);
          Break;
        end;
      end;
    end;

  finally
    Screen.Cursor:=crDefault;
    { Close enumeration handle: }
    WNetCloseEnum(hEnum);
  end;
end;

{
  Enumerate through the specified container:
  This function is usually recursively called.
}
procedure TfrmMain.DoEnumerationContainer(NetResContainer:
TNetResource);
var
  NetRes: Array[0..10] of TNetResource;
  TopContainerIndex: Integer;
  r, hEnum, EntryCount, NetResLen: DWORD;
begin
  { Add container name to tree view: }
  AddContainer(NetResContainer);
  { Keep track of this item as current root: }
  TopContainerIndex:=tvResources.Items.Count-1;
  { Start enumeration: }
  if ListType=RESOURCE_GLOBALNET then
    { Enumerating global net: }
    r:=WNetOpenEnum(ListType,ResourceType,RESOURCEUSAGE_CONTAINER,
      @NetResContainer,hEnum)
  else
    { Enumerating connections or persistent (won't normally get here):
}
    r:=WNetOpenEnum(ListType,ResourceType,RESOURCEUSAGE_CONTAINER,
      nil,hEnum);
  { Couldn't enumerate through this container; just make a note
    of it and continue on: }
  if r<>NO_ERROR then
  begin
    AddShareString(TopContainerIndex,'<Couldn''t Enumerate Resources
(Error #'+
      IntToStr(r)+'>');
    WNetCloseEnum(hEnum);
    Exit;
  end;

  { We got a valid enumeration handle; walk the resources: }
  while (1=1) do
  begin
    EntryCount:=1;
    NetResLen:=SizeOf(NetRes);
    r:=WNetEnumResource(hEnum,EntryCount,@NetRes,NetResLen);
    case r of
      0: begin
        { Yet another container to enumerate; call this function
          recursively to handle it: }
        if (NetRes[0].dwUsage=RESOURCEUSAGE_CONTAINER) or
          (NetRes[0].dwUsage=10) then
          DoEnumerationContainer(NetRes[0])
        else
          case NetRes[0].dwDisplayType of
            { Top level type: }
            RESOURCEDISPLAYTYPE_GENERIC,
            RESOURCEDISPLAYTYPE_DOMAIN,
            RESOURCEDISPLAYTYPE_SERVER: AddContainer(NetRes[0]);
            { Share: }
            RESOURCEDISPLAYTYPE_SHARE:
AddShare(TopContainerIndex,NetRes[0]);
          end;
        end;
      ERROR_NO_MORE_ITEMS: Break;
      else begin
        MessageDlg('Error #'+IntToStr(r)+' Walking
Resources.',mtError,[mbOK],0);
        Break;
      end;
    end;
  end;

  { Close enumeration handle: }
  WNetCloseEnum(hEnum);
end;

procedure TfrmMain.FormShow(Sender: TObject);
begin
  DoEnumeration;
end;

{
  Add item to tree view; indicate that it is a container:
}
procedure TfrmMain.AddContainer(NetRes: TNetResource);
var
  ItemName: String;
begin
  ItemName:=Trim(String(NetRes.lpRemoteName));
  if Trim(String(NetRes.lpComment))<>'' then
  begin
    if ItemName<>'' then ItemName:=ItemName+'  ';
    ItemName:=ItemName+'('+String(NetRes.lpComment)+')';
  end;
  tvResources.Items.Add(tvResources.Selected,ItemName);
end;

{
  Add child item to container denoted as current top:
}
procedure TfrmMain.AddShare(TopContainerIndex: Integer; NetRes:
TNetResource);
var
  ItemName: String;
begin
  ItemName:=Trim(String(NetRes.lpRemoteName));
  if Trim(String(NetRes.lpComment))<>'' then
  begin
    if ItemName<>'' then ItemName:=ItemName+'  ';
    ItemName:=ItemName+'('+String(NetRes.lpComment)+')';
  end;

tvResources.Items.AddChild(tvResources.Items[TopContainerIndex],ItemName);
end;

{
  Add child item to container denoted as current top;
  this just adds a string for purposes such as being unable
  to enumerate a container.  That is, the container's shares
  are not accessible to us.
}
procedure TfrmMain.AddShareString(TopContainerIndex: Integer;
ItemName: String);
begin

tvResources.Items.AddChild(tvResources.Items[TopContainerIndex],ItemName);
end;

{
  Add a connection to the tree view.
  Mostly used for persistent and currently connected
  resources to be displayed.
}
procedure TfrmMain.AddConnection(NetRes: TNetResource);
var
  ItemName: String;
begin
  ItemName:=Trim(String(NetRes.lpLocalName));
  if Trim(String(NetRes.lpRemoteName))<>'' then
  begin
    if ItemName<>'' then ItemName:=ItemName+'  ';
    ItemName:=ItemName+'-> '+Trim(String(NetRes.lpRemoteName));
  end;
  tvResources.Items.Add(tvResources.Selected,ItemName);
end;

{
  Expand all containers in the tree view:
}
procedure TfrmMain.mniExpandAllClick(Sender: TObject);
begin
  tvResources.FullExpand;
end;

{
  Collapse all containers in the tree view:
}
procedure TfrmMain.mniCollapseAllClick(Sender: TObject);
begin
  tvResources.FullCollapse;
end;

{
  Allow saving of tree view to a file:
}
procedure TfrmMain.mniSaveToFileClick(Sender: TObject);
begin
  if dlgSave.Execute then
    tvResources.SaveToFile(dlgSave.FileName);
end;

{
  Allow loading of tree view from a file:
}
procedure TfrmMain.mniLoadFromFileClick(Sender: TObject);
begin
  if dlgOpen.Execute then
    tvResources.LoadFromFile(dlgOpen.FileName);
end;

{
  Rebrowse:
}
procedure TfrmMain.btnOKClick(Sender: TObject);
begin
  DoEnumeration;
end;

end.

Accessing Netware Usernames

You can try this code. I've been using it on a Netware LAN for some time now with no problems. It depends on having the NWCALLS.DLL library already on the users machine; if users have a Netware connection, then they should already have that DLL.

unit GetLogin;

{This unit is a wrapper for several external functions in the NWCALLS.DLL}
{Adapted by Ray Buck from code written by Gregory Trubetskoy}
{The unit contains a function that returns the Netware User ID}
{and one that returns the user's full name.}

interface
 uses
  SysUtils, Messages, Dialogs;
function GetUserLogin: string;
function GetUserFullName( SomeUser: string): string;

implementation
  type
    NWTimeStamp = record
      Year:      byte;
      Month:     byte;
      Day:       byte;
      Hour:      byte;
      Minute:    byte;
      Second:    byte;
      DayOfWeek: byte;
    end;

  {Netware API's - require NWCALLS.DLL}
  function NWGetDefaultConnectionID(var Connection: word): word;
           far; external 'NWCALLS';

  function NWGetConnectionNumber(Connection: word; var ConnectionNumber:
word): word;
           far; external 'NWCALLS';

  function NWGetConnectionInformation(Connection: word;
                                      ConnectionNumber: word;
                                      ObjectName: pchar;
                                      var ObjectType: word;
                                      var ObjectID: word;
                                      var LoginTime: NWTimeStamp):word;
           far; external 'NWCALLS';

  function NWReadPropertyValue(Connection:       word;
                               ObjectName:       pChar;
                               ObjectType:       word;
                               PropertyName:     pChar;
                               DataSetIndex:     byte;
                               DataBuffer:       pChar;
                               var More:             byte;
                               var Flags:            byte): word;
           far; external 'NWCALLS';
  { end of Netware API stuff }

function GetUserLogin: string;
var
  ConnectionID: word;
  ConnectionNumber: word;
  RC: word;
  Name: array[0..50] of Char;
  ObjectType: word;
  ObjectID: word;
  LoginTime: NWTimeStamp;
begin
  RC := NWGetDefaultConnectionID(ConnectionID);
  RC := NWGetConnectionNumber(ConnectionID, ConnectionNumber);
  RC := NWGetConnectionInformation( ConnectionID,
                                    ConnectionNumber,
                                    Name,
                                    ObjectType,
                                    ObjectID,
                                    LoginTime);

  Result := StrPas(Name);
end;

function GetUserFullName( SomeUser: string): string;
{The real user name is a 'property' called 'IDENTIFICATON'.
You have to call NWReadPropertyValue passing it (among other things) your ConnectionID, 
the name of the object (same as the login of the user who's full name you need) 
and the name property you want to retrieve, in this case 'IDENTIFICATION' 
(which translated from Novellish to English means 'Full Name').}

var
  ConnectionID: word;
  RC: word;
  Name: array[0..50] of Char;
  ObjectType: word;
  PropName: array[0..14] of Char;
  DataSetIndex: byte;
  FullName: array[0..127] of Char;
  More: byte;
  Flags: byte;
begin
  RC := NWGetDefaultConnectionID(ConnectionID);
  ObjectType := 256; {user}
  StrPCopy(PropName, 'IDENTIFICATION');
  DataSetIndex := 1;
  StrPCopy(Name, SomeUser);
  RC := NWReadPropertyValue( ConnectionID,
                               Name,
                               ObjectType,
                               PropName,
                               DataSetIndex,
                               FullName,
                               More,
                               Flags);
  if RC = 35324 then
    MessageDlg('No user ' + SomeUser + ' exists on this server!',
                mtError, [mbOK], 0);
  Result := StrPas(FullName);
end;

end.

How to Connect to a Network Drive in Delphi

This document explains how to create a 'Network' button that brings up a connection dialog and then sets a drive box to point to the new drive in Delphi. The code was created in Delphi 2, but doing it in Delphi 1 should be about the same procedure.

Create a command button named NetBtn, and a drive combo box named DriveBox. Then type this code in the OnClick event for the button:

procedure TStartForm.NetBtnClick(Sender: TObject); 
var
  OldDrives: TStringList;
  i: Integer;
begin
  OldDrives := TStringList.Create;
  OldDrives.Assign(Drivebox.Items);                            // Remember old drive list
  // Show the connection dialog
  if WNetConnectionDialog(Handle, RESOURCETYPE_DISK) = NO_ERROR then begin
    DriveBox.TextCase := tcLowerCase;                          // Refresh the drive list box
    for i := 0 to DriveBox.Items.Count - 1 do begin
      if Olddrives.IndexOf(Drivebox.Items[i]) = -1 then begin  // Find new Drive letter
        DriveBox.ItemIndex := i;              // Updates the drive list box to new drive letter
        DriveBox.Drive := DriveBox.Text[1];   // Cascades the update to connected directory lists, etc
      end;
    end;
    DriveBox.SetFocus;
  end;
  OldDrives.Free;
end;

You must also add the WinProcs and WinTypes units to the uses clause of your unit.

The difficult part here is that the DriveComboBox lacks a refresh function. By setting the TextCase property, we force an update of the box.

Copyright © 1997 by Josef Garvi

accessing network drive mapping dialog

Try WNetConnectionDialog. This function is already pre-wrapped in Windows.pas and is specifically designed to do exactly what you want it to do.

This page has been created with