Главная страница
    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.015 c
4-1129281662
Vir
2005-10-14 13:21
2005.12.18
Nt Sevice + GUI


2-1132415297
Aleks
2005-11-19 18:48
2005.12.18
Какой компонент использовать


2-1133779561
KitsumVI
2005-12-05 13:46
2005.12.18
Какой программой можно просмотреть дерево классов


14-1132954799
dior
2005-11-26 00:39
2005.12.18
я не могу написать тест на делфи(((


14-1132730035
Пётр
2005-11-23 10:13
2005.12.18
помогите плиз





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
Английский Французский Немецкий Итальянский Португальский Русский Испанский