Форум: "Начинающим";
Текущий архив: 2008.05.25;
Скачать: [xml.tar.bz2];

Вниз

Имя компьютера   Найти похожие ветки 

← →
Vasja   (2008-04-26 13:11) [0]

можно ли в Delphi сформироыать список имен компьютеров, подключенных к локальной сети?

---

← →
ZENsan ©   (2008-04-26 13:14) [1]


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;


---

← →
IOrist   (2008-04-26 13:23) [2]

спс

---

Страницы: 1 вся ветка

Форум: "Начинающим";
Текущий архив: 2008.05.25;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.45 MB
Время: 0.007 c