LAN Web TCP Delphi

{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;