Mega Code Archive

 
Categories / Delphi / LAN Web TCP
 

Get a list of computers in a network

Title: get a list of computers in a network? type PNetResourceArray = ^TNetResourceArray; TNetResourceArray = array[0..100] of TNetResource; function CreateNetResourceList(ResourceType: DWord; NetResource: PNetResource; out Entries: DWord; out List: PNetResourceArray): Boolean; var EnumHandle: THandle; BufSize: DWord; Res: DWord; begin Result := False; List := Nil; Entries := 0; if WNetOpenEnum(RESOURCE_GLOBALNET, ResourceType, 0, NetResource, EnumHandle) = NO_ERROR then begin try BufSize := $4000; // 16 kByte GetMem(List, BufSize); try repeat Entries := DWord(-1); FillChar(List^, BufSize, 0); Res := WNetEnumResource(EnumHandle, Entries, List, BufSize); if Res = ERROR_MORE_DATA then begin ReAllocMem(List, BufSize); end; until Res ERROR_MORE_DATA; Result := Res = NO_ERROR; if not Result then begin FreeMem(List); List := Nil; Entries := 0; end; except FreeMem(List); raise; end; finally WNetCloseEnum(EnumHandle); end; end; end; procedure ScanNetworkResources(ResourceType, DisplayType: DWord; List: TStrings); procedure ScanLevel(NetResource: PNetResource); var Entries: DWord; NetResourceList: PNetResourceArray; i: Integer; begin if CreateNetResourceList(ResourceType, NetResource, Entries, NetResourceList) then try for i := 0 to Integer(Entries) - 1 do begin if (DisplayType = RESOURCEDISPLAYTYPE_GENERIC) or (NetResourceList[i].dwDisplayType = DisplayType) then begin List.AddObject(NetResourceList[i].lpRemoteName, Pointer(NetResourceList[i].dwDisplayType)); end; if (NetResourceList[i].dwUsage and RESOURCEUSAGE_CONTAINER) 0 then ScanLevel(@NetResourceList[i]); end; finally FreeMem(NetResourceList); end; end; begin ScanLevel(Nil); end; procedure TForm1.Button1Click(Sender: TObject); begin ScanNetworkResources(RESOURCETYPE_DISK, RESOURCEDISPLAYTYPE_SERVER, ListBox1.Items); end;