Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Потрепаться";
Текущий архив: 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
6-1126192068
integery
2005-09-08 19:07
2005.12.18
помогите разобратса из TcpServer TcpClient


2-1133600599
coral
2005-12-03 12:03
2005.12.18
Помогите плиз срочно!


9-1122150518
Иггорь
2005-07-24 00:28
2005.12.18
Как сделать точный таймер?


14-1132920637
Patient
2005-11-25 15:10
2005.12.18
Насморк - это хорошо или плохо?


2-1133627721
Cerberus
2005-12-03 19:35
2005.12.18
Помогите с ListBox





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский