was ist neu ¦  programmier tips ¦  indy artikel ¦  intraweb artikel ¦  informationen ¦  links ¦  interviews
 sonstiges ¦  tutorials ¦  Add&Win Gewinnspiel

Tips (1541)

Dateien (137)
Datenbanken (90)
Drucken (35)
Grafik (114)
IDE (21)
Indy (5)
Internet / LAN (130)
IntraWeb (0)
Mathematik (76)
Multimedia (45)
Oberfläche (107)
Objekte/
ActiveX (51)

OpenTools API (3)
Sonstiges (126)
Strings (83)
System (266)
VCL (242)

Tips sortiert nach
Komponente


Tip suchen

Tip hinzufügen

Add&Win Gewinnspiel

Werbung

46 Visitors Online


 
...Alle Computer im Netzwerk ermitteln?
Autor: Manfred Ruzicka
[ Tip ausdrucken ]  

Tip Bewertung (55):  
     


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;


 

Bewerten Sie diesen Tipp:

dürftig
ausgezeichnet


Copyright © by SwissDelphiCenter.ch
All trademarks are the sole property of their respective owners