Class to Enumerate Resources on WNet (Views: 29)
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. |