lcorelocalips: fix multiple windows 9x and NT4 support issues. rename function gethos...

diff --git a/lcorelocalips.pas b/lcorelocalips.pas
index 710fbfa4070d8d360da589557ad95c5932a8ce82..453ce81c4149986a6e3d111718dbce9a811e2968 100644 (file)
--- a/lcorelocalips.pas
+++ b/lcorelocalips.pas
@@ -55,8 +55,9 @@ function getsystemdnsservers:tbiniplist;
 \r
 function have_ipv6_connectivity:boolean;\r
 \r
 \r
 function have_ipv6_connectivity:boolean;\r
 \r

+function lcgethostname:ansistring;\r
+\r

 {$ifdef mswindows}\r
 {$ifdef mswindows}\r

-function gethostname:ansistring;\r

 function getlocalipforip(const ip:tbinip):tbinip;\r
 {$endif}\r
 \r
 function getlocalipforip(const ip:tbinip):tbinip;\r
 {$endif}\r
 \r


@@ -68,16 +69,16 @@ implementation
 {$ifdef unix}\r
 \r
 uses\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
 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
   {$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
   {amd64: mac OS X: $C00C6924; freeBSD: $c0106924}\r
 type\r
   tifconf=packed record\r


@@ -178,7 +179,7 @@ begin
   end;\r
   closefile(t);\r
 end;\r
   end;\r
   closefile(t);\r
 end;\r

-{$endif}\r
+{$endif}    //ipv6\r

 \r
 function getv4localips:tbiniplist;\r
 begin\r
 \r
 function getv4localips:tbiniplist;\r
 begin\r


@@ -193,27 +194,36 @@ begin
   {$endif}\r
 end;\r
 \r
   {$endif}\r
 end;\r
 \r

-{$else}\r
+{$else}   //unix\r

 \r
 uses\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
 \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
 \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
   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
   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
     {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


@@ -223,7 +233,10 @@ begin
   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
   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
 end;\r
 \r
 \r


@@ -266,7 +279,7 @@ var
   usewindnstemp:boolean;\r
   error:integer;\r
 begin\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
 \r
   {$ifdef ipv6}\r
 \r


@@ -341,8 +354,9 @@ var
 begin\r
   result := nil;\r
   if iphlpapi=0 then iphlpapi := loadlibrary('iphlpapi.dll');\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
     fixed_info_len := 0;\r
     if GetNetworkParams(nil,@fixed_info_len)<>ERROR_BUFFER_OVERFLOW then exit;\r
     //fixed_info_len :=sizeof(tfixed_info);\r


@@ -361,6 +375,9 @@ var
   {$ifdef mswindows}\r
     fixed_info : pfixed_info;\r
     currentdnsserver : pip_addr_string;\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
   {$else}\r
     t:textfile;\r
     s:ansistring;\r


@@ -374,7 +391,41 @@ begin
 \r
   {$ifdef mswindows}\r
     fixed_info := callgetnetworkparams;\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
 \r
     currentdnsserver := @(fixed_info.dnsserverlist);\r
     while assigned(currentdnsserver) do begin\r


@@ -456,19 +507,20 @@ begin
 end;\r
 \r
 \r
 end;\r
 \r
 \r

+function lcgethostname:ansistring;\r

 {$ifdef mswindows}\r
 {$ifdef mswindows}\r

-function gethostname:ansistring;\r

 var\r
 var\r

-    fixed_info : pfixed_info;\r
+  buf:array[0..255] of ansichar;\r
+  i:integer;\r

 begin\r
   result := '';\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
 end;\r
 {$endif}\r
 \r