Discovery of connected computers, drives, and printers, using the WNet functions
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 |
unit WNetEnum_Class; 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. |