Форум: "Потрепаться";
Текущий архив: 2005.12.18;
Скачать: [xml.tar.bz2];
ВнизСеть Найти похожие ветки
← →
тамара © (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;
Скачать: [xml.tar.bz2];
Память: 0.47 MB
Время: 0.012 c