Текущий архив: 2005.12.18;
Скачать: CL | DM;

Вниз

Сеть   Найти похожие ветки 

← →
тамара ©   (2005-11-29 12:19) [0]

Найти все компьютеры в сети

---

← →
Slider007 ©   (2005-11-29 12:24) [1]

к какому числу ?

---

← →
han_malign ©   (2005-11-29 12:40) [2]

unit uNetBrowse;

interface
uses Windows;

type PNetCompListItem = ^TNetCompListItem;
    TNetCompListItem = record
       sDomain,
       sHostName  : string;
       pNext: PNetCompListItem;
    end;
function EnumNetCompList: PNetCompListItem;
procedure FreeNetCompList(var aList: PNetCompListItem);
function WNetLastErrorMsg(var aErr: DWORD): string;
function AddrList(const aAddr: string): string;
function TrimUNC(aPC: PChar): PChar;
procedure OutLog(aText: string);
implementation
uses Utils, WINSOCK2;

procedure OutLog(aText: string);
begin
  flogln("Nets.log",aText);
  CharToOem(PChar(aText),PChar(aText));
  Writeln(aText);
end;

function TrimUNC(aPC: PChar): PChar;
begin
  Result:=aPC;
  while(Result^="\")do inc(Result);
end;

function AddrList(const aAddr: string): string;
type ppchar = ^PChar;
var phe : PHostEnt;
   pia : ppchar;
   i: integer;
begin
  phe:= GetHostByName(PChar(aAddr));
  if(phe=nil)then Result:=" Error - "+IntStr(WSAGetLastError)
  else with(phe^)do begin
     pia:=ppchar(h_addr_list); Result:="";
     while(pia^<>nil)do begin
        Result:=Result+" @"+intstr(ord(pia^[0]));
        for i:=1 to h_length-1 do Result:=Result+"."+IntStr(ord(pia^[i]));
        inc(pia);
     end;
  end;
end;

const cBufSize = $400;
function _EnumNetResources(var aItem: PNetCompListItem; const aDomain: string; lpNetResource: PNetResource): PNetCompListItem;
var hEnum: THandle;
   pBuf : array[0..cBufSize-1]of char;
   _p: PNetResource;
   res,cnt,sz: DWORD;
   _s: string;
   _root: PNetCompListItem;
begin
  Result:=aItem;
  res:=WNetOpenEnum(RESOURCE_GLOBALNET,RESOURCETYPE_ANY,0,lpNetResource,hEnum);
  if(res=NO_ERROR)then begin
     //GetMem(pBuf,cBufSize);
     while((res=NO_ERROR)or(res=ERROR_MORE_DATA))do begin
        cnt:=DWORD(-1); sz:=cBufSize;
        fillchar(pBuf,sz,0);
        res:=WNetEnumResource(hEnum,cnt,@pBuf,sz);
        if((res=NO_ERROR)or(res=ERROR_MORE_DATA))then begin
           _p:=@pBuf;
           while(Integer(cnt)>0)do begin
              _s:="";
              if(_p.dwDisplayType=RESOURCEDISPLAYTYPE_SERVER)then begin
                 if(aItem=nil)then begin
                    New(aItem); Result:=aItem;
                 end else begin
                    New(aItem.pNext);aItem:=aItem.pNext;
                 end;
                 aItem.sDomain  :=aDomain;
                 aItem.sHostName:=TrimUNC(_p.lpRemoteName);
                 aItem.pNext:=nil;
              end;
              if((_p.dwUsage and RESOURCEUSAGE_CONTAINER <> 0)and
                 (_p.dwDisplayType<>RESOURCEDISPLAYTYPE_SERVER)
                 )then begin
                 _s:="";
                 if(_p.dwDisplayType=RESOURCEDISPLAYTYPE_DOMAIN)then _s:=_p.lpRemoteName;
                 _root:=_EnumNetResources(aItem,_p.lpRemoteName,_p);
                 if(Result=nil)then Result:=_root;
              end;
              inc(_p);dec(cnt);
           end;
        end;
     end;
     if(res<>ERROR_NO_MORE_ITEMS)then Outlog("WNetEnumResource - "+ WNetLastErrorMsg(res));
     WNetCloseEnum(hEnum);
     //FreeMem(pBuf);
  end else Outlog("WNetOpenEnum - "+WNetLastErrorMsg(res));
end;

function WNetLastErrorMsg(var aErr: DWORD): string;
var szErr, szName: array[0..511]of char;
begin
  Result:="";
  if(aErr=ERROR_EXTENDED_ERROR)then begin
     if(NO_ERROR=WNetGetLastError(aErr,szErr,sizeof(szErr),szName,sizeof(szName)))
     then Result:=sprintf("%u - %s: %s",[aErr,@szName[0],@szErr[0]]);
  end else Result:=WinErrMsg(aErr);
end;

function  EnumNetCompList: PNetCompListItem;
var _item: PNetCompListItem;
begin
  _item:=nil;
  Result:=_EnumNetResources(_Item,"",nil);
end;

procedure FreeNetCompList(var aList: PNetCompListItem);
var _item: PNetCompListItem;
begin
  while(aList<>nil)do begin
     _item:=aList;
     aList:=aList.pNext;
     Dispose(_item);
  end;
end;

end.
..................................................................
program NetScan;

{$APPTYPE CONSOLE}

uses
 Windows, WINSOCK2,
 uNetBrowse in "uNetBrowse.pas";

var
  InitData : TWSADATA;
  pList, pItem: PNetCompListItem;
  _s: string;
begin
 if(WSAStartup($101, InitData) = 0)then begin
    pList:=EnumNetCompList;
    pItem:=pList;
    while(pItem<>nil)do begin
       _s:=pItem.sHostName+"."+pItem.sDomain;
       OutLog(_s+#9"("+AddrList(pItem.sHostName)+") ");
       pItem:=pItem.pNext;
    end;
    FreeNetCompList(pList);
    WSACleanup;
 end;
end.
- sprintf, flogln в utils  - выкладывать не буду, и к использованию SysUtils приводить - в лом...

---

← →
Ega23 ©   (2005-11-29 12:46) [3]

> Найти все компьютеры в сети


УРАААААААААААА!!!!!
:-(

---

← →
Anatoly Podgoretsky ©   (2005-11-29 12:56) [4]

Задача не решаемая, надо переформулировать вопрос. Но зачем этим программисту заниматься, есть же завхоз и файрвол.

---

← →
Dok_3D ©   (2005-11-29 13:55) [5]

и обезвредить!

---

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

Текущий архив: 2005.12.18;
Скачать: CL | DM;

Наверх

Память: 0.48 MB
Время: 0.071 c