\r
function have_ipv6_connectivity:boolean;\r
\r
+function lcgethostname:ansistring;\r
+\r
{$ifdef mswindows}\r
-function gethostname:ansistring;\r
function getlocalipforip(const ip:tbinip):tbinip;\r
{$endif}\r
\r
{$ifdef unix}\r
\r
uses\r
- baseunix,sockets,sysutils;\r
+ baseunix,unix,sockets,sysutils;\r
\r
\r
function getlocalips_internal(wantfamily:integer):tbiniplist;\r
const\r
IF_NAMESIZE=16;\r
- \r
+\r
{$ifdef linux}SIOCGIFCONF=$8912;{$endif}\r
{$ifdef bsd}{$ifdef cpu386}SIOCGIFCONF=$C0086924;{$endif}{$endif}\r
- \r
+\r
{amd64: mac OS X: $C00C6924; freeBSD: $c0106924}\r
type\r
tifconf=packed record\r
end;\r
closefile(t);\r
end;\r
-{$endif}\r
+{$endif} //ipv6\r
\r
function getv4localips:tbiniplist;\r
begin\r
{$endif}\r
end;\r
\r
-{$else}\r
+{$else} //unix\r
\r
uses\r
- sysutils,windows,winsock,dnswin;\r
+ sysutils,windows,winsock,dnswin,registry;\r
\r
{the following code's purpose is to determine what IP windows would come from, to reach an IP\r
it can be abused to find if there's any global v6 IPs on a local interface}\r
const\r
SIO_ROUTING_INTERFACE_QUERY = $c8000014;\r
- function WSAIoctl(s: TSocket; code:integer; const Buf; len: Integer; var output; outlen:integer; var outreturned: Integer; overlapped:pointer; completion: pointer): Integer; stdcall; external 'ws2_32.dll' name 'WSAIoctl';\r
+ type tWSAIoctl=function(s: TSocket; code:integer; const Buf; len: Integer; var output; outlen:integer; var outreturned: Integer; overlapped:pointer; completion: pointer): Integer; stdcall;\r
\r
function getlocalipforip(const ip:tbinip):tbinip;\r
var\r
- handle:integer;\r
+ libraryhandle : hmodule;\r
+ WSAIoctl:tWSAIoctl;\r
+ handle:Tsocket;\r
a,b:integer;\r
inaddrv,inaddrv2:tinetsockaddrv;\r
srcx:winsock.tsockaddr absolute inaddrv2;\r
begin\r
+ libraryhandle := LoadLibraryA('Ws2_32.dll');\r
+ if (libraryhandle = 0) then raise exception.create('getlocalipforip: no winsock2');\r
+ WSAIoctl := getprocaddress(libraryhandle,'WSAIoctl');\r
+ handle := INVALID_SOCKET;\r
+ try\r
+ if not assigned(WSAIoctl) then raise exception.create('getlocalipforip: no winsock2 WSAIoctl');\r
+\r
makeinaddrv(ip,'0',inaddrv);\r
handle := Socket(inaddrv.inaddr.family,SOCK_DGRAM,IPPROTO_UDP);\r
- if (handle < 0) then begin\r
+ if (handle = INVALID_SOCKET) then begin\r
{this happens on XP without an IPv6 stack\r
i can either fail with an exception, or with a "null result". an exception is annoying in the IDE}\r
{fillchar(result,sizeof(result),0);\r
if WSAIoctl(handle, SIO_ROUTING_INTERFACE_QUERY, inaddrv, sizeof(inaddrv), inaddrv2, sizeof(inaddrv2), a, nil, nil) <> 0\r
then raise exception.create('getlocalipforip failed with error: '+inttostr(wsagetlasterror));\r
result := inaddrvtobinip(inaddrv2);\r
- closesocket(handle);\r
+ finally\r
+ if (handle <> INVALID_SOCKET) then closesocket(handle);\r
+ if (libraryhandle <> 0) then freelibrary(libraryhandle);\r
+ end;\r
end;\r
\r
\r
usewindnstemp:boolean;\r
error:integer;\r
begin\r
- result := winforwardlookuplist('',0,error);\r
+ result := winforwardlookuplist(lcgethostname,0,error);\r
\r
{$ifdef ipv6}\r
\r
begin\r
result := nil;\r
if iphlpapi=0 then iphlpapi := loadlibrary('iphlpapi.dll');\r
- if not assigned(getnetworkparams) then @getnetworkparams := getprocaddress(iphlpapi,'GetNetworkParams');\r
- if not assigned(getnetworkparams) then exit;\r
+\r
+ if not assigned(getnetworkparams) then getnetworkparams := getprocaddress(iphlpapi,'GetNetworkParams');\r
+ if not assigned(getnetworkparams) then exit;\r
fixed_info_len := 0;\r
if GetNetworkParams(nil,@fixed_info_len)<>ERROR_BUFFER_OVERFLOW then exit;\r
//fixed_info_len :=sizeof(tfixed_info);\r
{$ifdef mswindows}\r
fixed_info : pfixed_info;\r
currentdnsserver : pip_addr_string;\r
+ reg:Tregistry;\r
+ nameserver,s:ansistring;\r
+ a:integer;\r
{$else}\r
t:textfile;\r
s:ansistring;\r
\r
{$ifdef mswindows}\r
fixed_info := callgetnetworkparams;\r
- if fixed_info = nil then exit;\r
+ if fixed_info = nil then begin\r
+ //2000 and up method not supported. use the 9x or NT 4 method.\r
+ nameserver := '';\r
+ reg := TRegistry.Create();\r
+ reg.RootKey := HKEY_LOCAL_MACHINE;\r
+ //9x\r
+ if not reg.OpenKey('\System\CurrentControlSet\Services\VxD\MSTCP',false) then\r
+ //NT\r
+ if not reg.OpenKey('\System\CurrentControlSet\Services\Tcpip\Parameters',false) then begin\r
+ reg.destroy;\r
+ exit;\r
+ end;\r
+\r
+ nameserver := reg.ReadString('NameServer');\r
+ //DhcpNameServer is actually only set on NT\r
+ if (nameserver = '') then nameserver := reg.ReadString('DhcpNameServer');\r
+\r
+ reg.destroy;\r
+\r
+ //parse as comma separated list\r
+ repeat\r
+ if (nameserver = '') then exit; //done\r
+ a := pos(',',nameserver);\r
+ if (a > 1) then begin\r
+ s := copy(nameserver,1,a-1);\r
+ nameserver := copy(nameserver,a+1,9999);\r
+ end else begin\r
+ s := nameserver;\r
+ nameserver := '';\r
+ end;\r
+ s := trim(s);\r
+ ip := ipstrtobinf(s);\r
+ if (ip.family <> 0) then biniplist_add(result,ip);\r
+ until false;\r
+ end;\r
\r
currentdnsserver := @(fixed_info.dnsserverlist);\r
while assigned(currentdnsserver) do begin\r
end;\r
\r
\r
+function lcgethostname:ansistring;\r
{$ifdef mswindows}\r
-function gethostname:ansistring;\r
var\r
- fixed_info : pfixed_info;\r
+ buf:array[0..255] of ansichar;\r
+ i:integer;\r
begin\r
result := '';\r
- fixed_info := callgetnetworkparams;\r
- if fixed_info = nil then exit;\r
-\r
- result := fixed_info.hostname;\r
- if fixed_info.domainname <> '' then result := result + '.'+fixed_info.domainname;\r
-\r
- freemem(fixed_info);\r
+ fillchar(buf,sizeof(buf),0);\r
+ i := winsock.gethostname(@buf,sizeof(buf));\r
+ if (i = 0) then result := pansichar(@buf[0]);\r
+end;\r
+{$else}\r
+begin\r
+ result := unix.gethostname;\r
end;\r
{$endif}\r
\r
lcore.org gitweb / lcore.git / blobdiff