Class to Enumerate Resources on WNet

Problem/Question/Abstract:

Other solutions presented here for enumerating computers, drives, etc. were incomplete. I needed a more fully developed solution, and wanted one that would be easy to use, and implemented in a class.

Note that there is room for improvement in the handling of "remembered" connections. The test for ERROR_INVALID_HANDLE at the bottom of the repeat loop currently handles that.

Note, too, that for Delphi 8, this will need some further work, as the pointers render it unsafe code.

Answer:

unit WNetEnum_Class;

{
WNetEnumClass. This class implements the discovery of connected computers,
drives, and printers, using the WNet functions.

Copyright (C) 2004 by William H. Meyer

History:
2004.05.28 -- file created

2004.06.03 -- successful completion

TODO:  Add an array of all TNetResources, and functions to allow their
access from the calling app. Or more properly, functions that will
return useful info from the TNetResources, simplifying the
determination of device type, and so on.
}

interface

uses
Classes, Sysutils, Windows;

type
TWNetEnumClass = class(TObject)
private
FnErrorNum: Integer;
FslAllNames: TStringList; // list for all resource names
FslCompNames: TStringList; // list for all computer names
FslDiskNames: TStringList; // list for all disk names
FslDomainNames: TStringList; // list for all domain names
FslErrors: TStringList; // list of errors
FslPrintNames: TStringList; // list of all printer names

procedure ErrorHandler(errorNum: Cardinal; s: string);

// EnumerateResources is the heart of the class
function EnumerateResources(startingPoint: TNetResource): Boolean;
protected
// EnumResources is used internally; Refresh calls it
procedure EnumResources;
public
constructor Create(Owner: TComponent); virtual;
destructor Destroys; virtual;

// getters for the stringlists
function GetAllNames: TStringList;
function GetCompNames: TStringList;
function GetDiskNames: TStringList;
function GetDomainNames: TStringList;
function GetErrors: TStringList;
function GetPrintNames: TStringList;

procedure Refresh; // used by calling apps to populate the lists
end;

implementation

{ WNetEnum }

const
BASE_RES = 128;
MAX_RES = 8192;

var
// establish a buffer to use to prime the drill-down process
base_buffer: array of TNetResource;

constructor TWNetEnumClass.Create(Owner: TComponent);
begin
inherited Create;

SetLength(base_buffer, BASE_RES); // initialize the base buffer

// now create the stringlists we will use
FslAllNames := TStringList.Create;
FslCompNames := TStringList.Create;
FslDiskNames := TStringList.Create;
FslDomainNames := TStringList.Create;
FslErrors := TStringList.Create;
FslPrintNames := TStringList.Create;
end;

destructor TWNetEnumClass.Destroys;
begin
// free the stringlists
FslPrintNames.Free;
FslErrors.Free;
FslDomainNames.Free;
FslDiskNames.Free;
FslCompNames.Free;
FslAllNames.Free;

base_buffer := nil; // free the base buffer

inherited Destroy;
end;

//

function TWNetEnumClass.EnumerateResources(startingPoint: TNetResource): Boolean;
var
res: Cardinal;
resEnum: Cardinal;
enumHandle: THandle;
buffer: array of TNetResource;
bufferSize: Cardinal;
numEntries: Cardinal;
i: Cardinal;
begin // EnumerateResources
// Open a container
res := WNetOpenEnum(
RESOURCE_GLOBALNET, RESOURCETYPE_ANY, 0, @startingPoint, enumHandle);
if (res <> NO_ERROR) then
ErrorHandler(res, 'WNetOpenEnum');

// loop through all the elements in the container
repeat
numEntries := Cardinal(-1);
SetLength(buffer, MAX_RES);
bufferSize := SizeOf(TNetResource) * MAX_RES;

// get resources
resEnum := WNetEnumResource(enumHandle, numEntries, buffer, bufferSize);
if (resEnum = NO_ERROR) then
begin
// loop through all entries
for i := 0 to numEntries - 1 do
begin
if (buffer[i].dwDisplayType = RESOURCEDISPLAYTYPE_SERVER) then
FslCompNames.Add(buffer[i].lpRemoteName)
else if (buffer[i].dwType = RESOURCETYPE_PRINT) then
FslPrintNames.Add(buffer[i].lpRemoteName)
else if (buffer[i].dwType = RESOURCETYPE_DISK) then
FslDiskNames.Add(buffer[i].lpRemoteName)
else if (buffer[i].dwDisplayType = RESOURCEDISPLAYTYPE_DOMAIN) then
FslDomainNames.Add(buffer[i].lpRemoteName);
// if the entry is a container, recursively open it
if (buffer[i].dwUsage and RESOURCEUSAGE_CONTAINER > 0) then
if (not EnumerateResources(buffer[i])) then
FslErrors.Add('Enumeration failed');
end;
end
else if (resEnum <> ERROR_NO_MORE_ITEMS) then
ErrorHandler(resEnum, 'WNetEnumResource');
// added the test for ERROR_INVALID_HANDLE to deal with the case where a
// "remembered" connection is no longer in existence. I need to look for a
// cleaner fix.
until (resEnum = ERROR_NO_MORE_ITEMS) or (resEnum = ERROR_INVALID_HANDLE);

// clean up
buffer := nil;
res := WNetCloseEnum(enumHandle);
if (res <> NO_ERROR) then
begin
ErrorHandler(res, 'WNetCloseEnum');
result := False;
end
else
result := True;
end;

procedure TWNetEnumClass.EnumResources;
begin
EnumerateResources(base_buffer[0]);
end;

procedure TWNetEnumClass.ErrorHandler(errorNum: Cardinal; s: string);
var
res: Cardinal;
error: Cardinal;
errorStr: string;
nameStr: string;
begin
if (errorNum <> ERROR_EXTENDED_ERROR) then
begin
FslErrors.Add('Error number ' + IntToStr(errorNum) +
' returned by ' + s);
end
else
begin
res := WNetGetLastError(
error, PChar(errorStr), 1000, PChar(nameStr), 1000);
if (res <> NO_ERROR) then
FslErrors.Add('Failure in WNetGetLastError: ' + IntToStr(error))
else
begin
FslErrors.Add('Extended Error: ' + errorStr + '. Provider: ' + nameStr);
end;
end;
end;

function TWNetEnumClass.GetAllNames: TStringList;
begin
FslAllNames.Sort;
Result := FslAllNames;
end;

function TWNetEnumClass.GetCompNames: TStringList;
begin
FslCompNames.Sort;
Result := FslCompNames;
end;

function TWNetEnumClass.GetDiskNames: TStringList;
begin
FslDiskNames.Sort;
Result := FslDiskNames;
end;

function TWNetEnumClass.GetDomainNames: TStringList;
begin
FslDomainNames.Sort;
Result := FslDomainNames;
end;

function TWNetEnumClass.GetErrors: TStringList;
begin
Result := FslErrors;
end;

function TWNetEnumClass.GetPrintNames: TStringList;
begin
FslPrintNames.Sort;
Result := FslPrintNames;
end;

procedure TWNetEnumClass.Refresh;
begin
FslAllNames.Clear;
FslCompNames.Clear;
FslDiskNames.Clear;
FslDomainNames.Clear;
FslErrors.Clear;
FslPrintNames.Clear;
EnumResources;
end;

end.