Главная страница
    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.014 c
1-1132758392
Igor_thief
2005-11-23 18:06
2005.12.18
Эмуляция нажатия кнопок на клавиатуре


2-1133172693
Dilman
2005-11-28 13:11
2005.12.18
Пример работы с DLL


1-1132773228
pound
2005-11-23 22:13
2005.12.18
Как нормально прекратить работу потока


2-1133375394
Сергей А.
2005-11-30 21:29
2005.12.18
3 вопроса по взаимодействию с DBGrid


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