Mega Code Archive

 
Categories / Delphi / LAN Web TCP
 

Networkde açık olan bilgisayarların ip noları ile birlikte listesi

{Network'e bağlı ve açık olan bilgisayarların listesini IP numaraları ile birlikte gösterir. Kemal ÇEVİK, kcevik@hotmail.com, 10/10/2001} //aşağıdaki unit'i findcomp.pas olarak kaydedin. unit FindComp; interface uses Windows, Classes; function FindComputers: DWORD; function HostToIPAddr(Name: string; var Ip: string): Boolean; var Computers: TStringList; implementation uses SysUtils, winsock; const MaxEntries = 500; function HostToIPAddr(Name: string; var Ip: string): Boolean; var wsdata : TWSAData; hostName : array [0..255] of char; hostEnt : PHostEnt; addr : PChar; begin WSAStartup ($0101, wsdata); try gethostname (hostName, sizeof (hostName)); StrPCopy(hostName, Name); hostEnt := gethostbyname (hostName); if Assigned (hostEnt) then if Assigned (hostEnt^.h_addr_list) then begin addr := hostEnt^.h_addr_list^; if Assigned (addr) then begin IP := Format ('%d.%d.%d.%d', [byte (addr [0]), byte (addr [1]), byte (addr [2]), byte (addr [3])]); Result := True; end else Result := False; end else Result := False else begin Result := False; end; finally WSACleanup; end end; function FindComputers: DWORD; var EnumbilgHandle, EnumWorkGroupHandle, EnumComputerHandle: THandle; EnumError: DWORD; Network: TNetResource; bilgEntries, WorkGroupEntries, ComputerEntries: DWORD; EnumbilgBuffer, EnumWorkGroupBuffer, EnumComputerBuffer: array[1..MaxEntries] of TNetResource; bilgEnumbufferlength, workEnumbufferlength, compEnumBufferLength: DWORD; k,I, J: DWORD; st : string; begin Computers.Clear; FillChar(Network, SizeOf(Network), 0); with Network do begin dwScope := RESOURCE_GLOBALNET; dwType := RESOURCETYPE_ANY; dwUsage := RESOURCEUSAGE_CONTAINER; end; EnumError := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, 0, @Network, EnumWorkGroupHandle); if EnumError = NO_ERROR then begin WorkGroupEntries := MaxEntries; workEnumBufferLength := SizeOf(EnumWorkGroupBuffer); EnumError := WNetEnumResource(EnumWorkGroupHandle, WorkGroupEntries, @EnumWorkGroupBuffer, workEnumBufferLength); if EnumError = NO_ERROR then begin for I := 1 to WorkGroupEntries do begin EnumError := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, 0, @EnumWorkGroupBuffer[I], EnumComputerHandle); if EnumError = NO_ERROR then begin ComputerEntries := MaxEntries; compEnumBufferLength := SizeOf(EnumComputerBuffer); EnumError := WNetEnumResource(EnumComputerHandle, ComputerEntries, @EnumComputerBuffer, compEnumBufferLength); if EnumError = NO_ERROR then begin for j := 1 to computerEntries do begin Computers.Add(EnumcomputerBuffer[j].lpRemoteName); EnumError := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, 0, @EnumcomputerBuffer[J], EnumbilgHandle); if EnumError = NO_ERROR then begin bilgEntries := MaxEntries; bilgEnumBufferLength := SizeOf(EnumbilgBuffer); EnumError := WNetEnumResource(EnumbilgHandle, bilgEntries, @EnumbilgBuffer, bilgEnumBufferLength); if EnumError = NO_ERROR then for k := 1 to bilgEntries do begin st := EnumbilgBuffer[k].lpRemoteName; delete(st,1,2); Computers.Add(' '+st); end; WNetCloseEnum(EnumbilgHandle); end; end; end; WNetCloseEnum(EnumComputerHandle); end; end; end; WNetCloseEnum(EnumWorkGroupHandle); end; if EnumError = ERROR_NO_MORE_ITEMS then EnumError := NO_ERROR; Result := EnumError; end; initialization Computers := TStringList.Create; finalization Computers.Free; end. // findcomp unit'inin sonu //************kullanılması************** procedure TForm1.Button1Click(Sender: TObject); var k : integer; var IP: string; begin FindComputers; for k := 0 to findcomp.computers.count-1 do begin IP := ''; If trim(findcomp.computers[k]) <> '' then HostToIpAddr(trim(findcomp.computers[k]), IP); memo1.lines.add(findcomp.computers[k]+' '+IP); end; end;