Chat - Computer auflisten

[CReber]

Code:

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;

zum ausführen

Code:

procedure TForm1.BitBtn2Click(Sender: TObject); 
begin 
ScanNetworkResources(RESOURCETYPE_DISK, RESOURCEDISPLAYTYPE_SERVER, ListBox1.Items); 
end;