function GetIPFromHost(var HostName, IPaddr, WSAErr: string): Boolean;
type
Name = array [0 .. 100] of AnsiChar;
PName = ^Name;
var
HEnt: pHostEnt;
HName: PName;
WSAData: TWSAData;
i: Integer;
begin
Result := False;
if WSAStartup($0101, WSAData) <> 0 then
begin
WSAErr := 'در اتصال به شبکه مشکل به وجود آماده است"';
Exit;
end;
IPaddr := '';
New(HName);
if GetHostName(HName^, SizeOf(Name)) = 0 then
begin
HostName := StrPas(HName^);
HEnt := GetHostByName(HName^);
for i := 0 to HEnt^.h_length - 1 do
IPaddr := Concat(IPaddr, IntToStr(Ord(HEnt^.h_addr_list^[i])) + '.');
SetLength(IPaddr, Length(IPaddr) - 1);
Result := True;
end
else
begin
case WSAGetLastError of
WSANOTINITIALISED:
WSAErr := 'WSANotInitialised';
WSAENETDOWN:
WSAErr := 'WSAENetDown';
WSAEINPROGRESS:
WSAErr := 'WSAEInProgress';
end;
end;
Dispose(HName);
WSACleanup;
end;
{$R *.dfm}
function CreateNetResourceList(ResourceType: DWord; NetResource: PNetResource;
out Entries: DWord; out List: PNetResourceArray): Boolean;
var
EnumHandle: THandle;
BufSize: DWord;
Res: DWord;
begin
Result := False;
List := Nil;
Entries := 0;
if WNetOpenEnum(RESOURCE_GLOBALNET, ResourceType, 0, NetResource, EnumHandle)
= NO_ERROR then
begin
try
BufSize := $4000; // 16 kByte
GetMem(List, BufSize);
try
repeat
Entries := DWord(-1);
FillChar(List^, BufSize, 0);
Res := WNetEnumResource(EnumHandle, Entries, List, BufSize);
if Res = ERROR_MORE_DATA then
begin
ReAllocMem(List, BufSize);
end;
until Res <> ERROR_MORE_DATA;
Result := Res = NO_ERROR;
if not Result then
begin
FreeMem(List);
List := Nil;
Entries := 0;
end;
except
FreeMem(List);
raise;
end;
finally
WNetCloseEnum(EnumHandle);
end;
end;
end;
procedure ScanNetworkResources(ResourceType, DisplayType: DWord;
List: TStrings);
procedure ScanLevel(NetResource: PNetResource);
var
Entries: DWord;
NetResourceList: PNetResourceArray;
i: Integer;
Host: string;
begin
if CreateNetResourceList(ResourceType, NetResource, Entries, NetResourceList)
then
try
Application.ProcessMessages;
for i := 0 to Integer(Entries) - 1 do
begin
if (DisplayType = RESOURCEDISPLAYTYPE_GENERIC) or
(NetResourceList[i].dwDisplayType = DisplayType) then
begin
List.AddObject(NetResourceList[i].lpRemoteName,
Pointer(NetResourceList[i].dwDisplayType));
end;
if (NetResourceList[i].dwUsage and RESOURCEUSAGE_CONTAINER) <> 0 then
ScanLevel(@NetResourceList[i]);
Application.ProcessMessages;
end;
finally
FreeMem(NetResourceList);
end;
end;
begin
ScanLevel(Nil);
end;
function GetIPAddress(NetworkName: String): String;
var
Error: DWord;
HostEntry: pHostEnt;
Data: WSAData;
Address: In_Addr;
begin
Error := WSAStartup(MakeWord(1, 1), Data);
if Error = 0 then
begin
HostEntry := GetHostByName(PansiChar(AnsiString(NetworkName)));
Error := GetLastError();
if Error = 0 then
begin
Address := PInAddr(HostEntry^.h_addr_list^)^;
Result := inet_ntoa(Address);
end
else
begin
Result := 'Unknown';
end;
end
else
begin
Result := 'Error';
end;
WSACleanup();
end;
اینم نحوه فراخوانی :
ScanNetworkResources(RESOURCETYPE_DISK, RESOURCEDISPLAYTYPE_SERVER,
EdtServerName.Items);
به جای این EdtServerName.Items آبجکت مورد نظرت رو بزار
آیا راهی برای یافتن نام کامپیوتری که به سرور ریموت شده است وجود دارد؟
پاسخ با نقل قول
نوشته شده توسط Mask
