From: beware Date: Wed, 17 Sep 2025 22:09:49 +0000 (+0000) Subject: lcorelocalips: fix multiple windows 9x and NT4 support issues. rename function gethos... X-Git-Url: http://www.lcore.org/git/lcore.git/commitdiff_plain/095083d60a366c89e8bf240e35bd8315c5772c41?ds=sidebyside lcorelocalips: fix multiple windows 9x and NT4 support issues. rename function gethostname to lcgethostname. --- diff --git a/lcorelocalips.pas b/lcorelocalips.pas index 710fbfa..453ce81 100644 --- a/lcorelocalips.pas +++ b/lcorelocalips.pas @@ -55,8 +55,9 @@ function getsystemdnsservers:tbiniplist; function have_ipv6_connectivity:boolean; +function lcgethostname:ansistring; + {$ifdef mswindows} -function gethostname:ansistring; function getlocalipforip(const ip:tbinip):tbinip; {$endif} @@ -68,16 +69,16 @@ implementation {$ifdef unix} uses - baseunix,sockets,sysutils; + baseunix,unix,sockets,sysutils; function getlocalips_internal(wantfamily:integer):tbiniplist; const IF_NAMESIZE=16; - + {$ifdef linux}SIOCGIFCONF=$8912;{$endif} {$ifdef bsd}{$ifdef cpu386}SIOCGIFCONF=$C0086924;{$endif}{$endif} - + {amd64: mac OS X: $C00C6924; freeBSD: $c0106924} type tifconf=packed record @@ -178,7 +179,7 @@ begin end; closefile(t); end; -{$endif} +{$endif} //ipv6 function getv4localips:tbiniplist; begin @@ -193,27 +194,36 @@ begin {$endif} end; -{$else} +{$else} //unix uses - sysutils,windows,winsock,dnswin; + sysutils,windows,winsock,dnswin,registry; {the following code's purpose is to determine what IP windows would come from, to reach an IP it can be abused to find if there's any global v6 IPs on a local interface} const SIO_ROUTING_INTERFACE_QUERY = $c8000014; - 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'; + type tWSAIoctl=function(s: TSocket; code:integer; const Buf; len: Integer; var output; outlen:integer; var outreturned: Integer; overlapped:pointer; completion: pointer): Integer; stdcall; function getlocalipforip(const ip:tbinip):tbinip; var - handle:integer; + libraryhandle : hmodule; + WSAIoctl:tWSAIoctl; + handle:Tsocket; a,b:integer; inaddrv,inaddrv2:tinetsockaddrv; srcx:winsock.tsockaddr absolute inaddrv2; begin + libraryhandle := LoadLibraryA('Ws2_32.dll'); + if (libraryhandle = 0) then raise exception.create('getlocalipforip: no winsock2'); + WSAIoctl := getprocaddress(libraryhandle,'WSAIoctl'); + handle := INVALID_SOCKET; + try + if not assigned(WSAIoctl) then raise exception.create('getlocalipforip: no winsock2 WSAIoctl'); + makeinaddrv(ip,'0',inaddrv); handle := Socket(inaddrv.inaddr.family,SOCK_DGRAM,IPPROTO_UDP); - if (handle < 0) then begin + if (handle = INVALID_SOCKET) then begin {this happens on XP without an IPv6 stack i can either fail with an exception, or with a "null result". an exception is annoying in the IDE} {fillchar(result,sizeof(result),0); @@ -223,7 +233,10 @@ begin if WSAIoctl(handle, SIO_ROUTING_INTERFACE_QUERY, inaddrv, sizeof(inaddrv), inaddrv2, sizeof(inaddrv2), a, nil, nil) <> 0 then raise exception.create('getlocalipforip failed with error: '+inttostr(wsagetlasterror)); result := inaddrvtobinip(inaddrv2); - closesocket(handle); + finally + if (handle <> INVALID_SOCKET) then closesocket(handle); + if (libraryhandle <> 0) then freelibrary(libraryhandle); + end; end; @@ -266,7 +279,7 @@ var usewindnstemp:boolean; error:integer; begin - result := winforwardlookuplist('',0,error); + result := winforwardlookuplist(lcgethostname,0,error); {$ifdef ipv6} @@ -341,8 +354,9 @@ var begin result := nil; if iphlpapi=0 then iphlpapi := loadlibrary('iphlpapi.dll'); - if not assigned(getnetworkparams) then @getnetworkparams := getprocaddress(iphlpapi,'GetNetworkParams'); - if not assigned(getnetworkparams) then exit; + + if not assigned(getnetworkparams) then getnetworkparams := getprocaddress(iphlpapi,'GetNetworkParams'); + if not assigned(getnetworkparams) then exit; fixed_info_len := 0; if GetNetworkParams(nil,@fixed_info_len)<>ERROR_BUFFER_OVERFLOW then exit; //fixed_info_len :=sizeof(tfixed_info); @@ -361,6 +375,9 @@ var {$ifdef mswindows} fixed_info : pfixed_info; currentdnsserver : pip_addr_string; + reg:Tregistry; + nameserver,s:ansistring; + a:integer; {$else} t:textfile; s:ansistring; @@ -374,7 +391,41 @@ begin {$ifdef mswindows} fixed_info := callgetnetworkparams; - if fixed_info = nil then exit; + if fixed_info = nil then begin + //2000 and up method not supported. use the 9x or NT 4 method. + nameserver := ''; + reg := TRegistry.Create(); + reg.RootKey := HKEY_LOCAL_MACHINE; + //9x + if not reg.OpenKey('\System\CurrentControlSet\Services\VxD\MSTCP',false) then + //NT + if not reg.OpenKey('\System\CurrentControlSet\Services\Tcpip\Parameters',false) then begin + reg.destroy; + exit; + end; + + nameserver := reg.ReadString('NameServer'); + //DhcpNameServer is actually only set on NT + if (nameserver = '') then nameserver := reg.ReadString('DhcpNameServer'); + + reg.destroy; + + //parse as comma separated list + repeat + if (nameserver = '') then exit; //done + a := pos(',',nameserver); + if (a > 1) then begin + s := copy(nameserver,1,a-1); + nameserver := copy(nameserver,a+1,9999); + end else begin + s := nameserver; + nameserver := ''; + end; + s := trim(s); + ip := ipstrtobinf(s); + if (ip.family <> 0) then biniplist_add(result,ip); + until false; + end; currentdnsserver := @(fixed_info.dnsserverlist); while assigned(currentdnsserver) do begin @@ -456,19 +507,20 @@ begin end; +function lcgethostname:ansistring; {$ifdef mswindows} -function gethostname:ansistring; var - fixed_info : pfixed_info; + buf:array[0..255] of ansichar; + i:integer; begin result := ''; - fixed_info := callgetnetworkparams; - if fixed_info = nil then exit; - - result := fixed_info.hostname; - if fixed_info.domainname <> '' then result := result + '.'+fixed_info.domainname; - - freemem(fixed_info); + fillchar(buf,sizeof(buf),0); + i := winsock.gethostname(@buf,sizeof(buf)); + if (i = 0) then result := pansichar(@buf[0]); +end; +{$else} +begin + result := unix.gethostname; end; {$endif}