binipstuff.pas

   1 { Copyright (C) 2005 Bas Steendijk and Peter Green\r
   2   For conditions of distribution and use, see copyright notice in zlib_license.txt\r
   3   which is included in the package\r
   4   ----------------------------------------------------------------------------- }\r
   5 unit binipstuff;\r
   6 \r
   7 interface\r
   8 \r
   9 {$include lcoreconfig.inc}\r
  10 \r
  11 uses\r
  12   {$ifndef win32}{$ifdef ipv6}sockets,{$endif}{$endif}\r
  13   pgtypes;\r
  14 \r
  15 {$ifdef fpc}\r
  16   {$mode delphi}\r
  17 {$endif}\r
  18 {$ifdef cpu386}{$define i386}{$endif}\r
  19 {$ifdef i386}{$define ENDIAN_LITTLE}{$endif}\r
  20 \r
  21 {$include uint32.inc}\r
  22 \r
  23 const\r
  24   hexchars:array[0..15] of ansichar='0123456789abcdef';\r
  25   AF_INET=2;\r
  26   {$ifdef win32}\r
  27     AF_INET6=23;\r
  28   {$else}\r
  29     AF_INET6=10;\r
  30   {$endif}\r
  31 \r
  32 type\r
  33   {$ifdef ipv6}\r
  34     \r
  35     {$ifdef win32}\r
  36       {$define want_Tin6_addr}\r
  37     {$endif}\r
  38     {$ifdef ver1_0}\r
  39       {$define want_Tin6_addr}\r
  40     {$endif}\r
  41     {$ifdef want_Tin6_addr}\r
  42       Tin6_addr = packed record\r
  43         case byte of\r
  44           0: (u6_addr8  : array[0..15] of byte);\r
  45           1: (u6_addr16 : array[0..7] of Word);\r
  46           2: (u6_addr32 : array[0..3] of uint32);\r
  47           3: (s6_addr8  : array[0..15] of shortint);\r
  48           4: (s6_addr   : array[0..15] of shortint);\r
  49           5: (s6_addr16 : array[0..7] of smallint);\r
  50           6: (s6_addr32 : array[0..3] of LongInt);\r
  51       end;\r
  52     {$endif}\r
  53   {$endif}\r
  54 \r
  55   tbinip=record\r
  56     family:integer;\r
  57     {$ifdef ipv6}\r
  58       case integer of\r
  59         0: (ip:longint);\r
  60         1: (ip6:tin6_addr);\r
  61     {$else}\r
  62       ip:longint;\r
  63     {$endif}\r
  64   end;\r
  65 \r
  66   {$ifdef win32}\r
  67     TInetSockAddr = packed Record\r
  68       family:Word;\r
  69       port  :Word;\r
  70       addr  :uint32;\r
  71       pad   :array [1..8] of byte;\r
  72     end;\r
  73     {$ifdef ipv6}\r
  74 \r
  75       TInetSockAddr6 = packed record\r
  76         sin6_family: word;\r
  77         sin6_port: word;\r
  78         sin6_flowinfo: uint32;\r
  79         sin6_addr: tin6_addr;\r
  80         sin6_scope_id: uint32;\r
  81       end;\r
  82     {$endif}\r
  83   {$endif}\r
  84 \r
  85 \r
  86 \r
  87   {$ifdef ipv6}\r
  88     {$ifdef ver1_0}\r
  89       cuint16=word;\r
  90       cuint32=dword;\r
  91       sa_family_t=word;\r
  92 \r
  93       TInetSockAddr6 = packed record\r
  94         sin6_family: word;\r
  95         sin6_port: word;\r
  96         sin6_flowinfo: uint32;\r
  97         sin6_addr: tin6_addr;\r
  98         sin6_scope_id: uint32;\r
  99       end;\r
 100     {$endif}\r
 101   {$endif}\r
 102   TinetSockAddrv = packed record\r
 103     case integer of\r
 104       0: (InAddr:TInetSockAddr);\r
 105       {$ifdef ipv6}\r
 106       1: (InAddr6:TInetSockAddr6);\r
 107       {$endif}\r
 108   end;\r
 109   Pinetsockaddrv = ^Tinetsockaddrv;\r
 110 \r
 111   type\r
 112     tsockaddrin=TInetSockAddr;\r
 113 \r
 114 \r
 115 \r
 116 {\r
 117 bin IP list code, by beware\r
 118 while this is really just a string, on the interface side it must be treated\r
 119 as an opaque var which is passed as "var" when it needs to be modified}\r
 120 \r
 121   tbiniplist=tbufferstring;\r
 122 \r
 123 function biniplist_new:tbiniplist;\r
 124 procedure biniplist_add(var l:tbiniplist;ip:tbinip);\r
 125 function biniplist_getcount(const l:tbiniplist):integer;\r
 126 function biniplist_get(const l:tbiniplist;index:integer):tbinip;\r
 127 procedure biniplist_set(var l:tbiniplist;index:integer;ip:tbinip);\r
 128 procedure biniplist_setcount(var l:tbiniplist;newlen:integer);\r
 129 procedure biniplist_free(var l:tbiniplist);\r
 130 procedure biniplist_addlist(var l:tbiniplist;const l2:tbiniplist);\r
 131 function biniplist_tostr(const l:tbiniplist):thostname;\r
 132 function isbiniplist(const l:tbiniplist):boolean;\r
 133 \r
 134 function htons(w:word):word;\r
 135 function htonl(i:uint32):uint32;\r
 136 \r
 137 function ipstrtobin(const s:thostname;var binip:tbinip):boolean;\r
 138 function ipstrtobinf(const s:thostname):tbinip;\r
 139 function ipbintostr(const binip:tbinip):thostname;\r
 140 {$ifdef ipv6}\r
 141 function ip6bintostr(const bin:tin6_addr):thostname;\r
 142 function ip6strtobin(const s:thostname;var bin:tin6_addr):boolean;\r
 143 {$endif}\r
 144 \r
 145 function comparebinip(const ip1,ip2:tbinip):boolean;\r
 146 procedure maskbits(var binip:tbinip;bits:integer);\r
 147 function comparebinipmask(ip1,ip2:tbinip;bits:integer):boolean;\r
 148 \r
 149 procedure addipsoffamily(var l:tbiniplist;const l2:tbiniplist;family:integer);\r
 150 \r
 151 {deprecated}\r
 152 function longip(s:thostname):longint;\r
 153 \r
 154 function needconverttov4(const ip:tbinip):boolean;\r
 155 procedure converttov4(var ip:tbinip);\r
 156 \r
 157 function inaddrvtobinip(inaddrv:tinetsockaddrv):tbinip;\r
 158 function makeinaddrv(addr:tbinip;port:ansistring;var inaddr:tinetsockaddrv):integer;\r
 159 function inaddrsize(inaddr:tinetsockaddrv):integer;\r
 160 \r
 161 implementation\r
 162 \r
 163 uses sysutils;\r
 164 \r
 165 function htons(w:word):word;\r
 166 begin\r
 167   {$ifdef ENDIAN_LITTLE}\r
 168   result := ((w and $ff00) shr 8) or ((w and $ff) shl 8);\r
 169   {$else}\r
 170   result := w;\r
 171   {$endif}\r
 172 end;\r
 173 \r
 174 function htonl(i:uint32):uint32;\r
 175 begin\r
 176   {$ifdef ENDIAN_LITTLE}\r
 177   result := (i shr 24) or (i shr 8 and $ff00) or (i shl 8 and $ff0000) or (i shl 24 and $ff000000);\r
 178   {$else}\r
 179   result := i;\r
 180   {$endif}\r
 181 end;\r
 182 \r
 183 \r
 184 function inaddrvtobinip(inaddrv:tinetsockaddrv):tbinip;\r
 185 begin\r
 186   result.family := inaddrv.inaddr.family;\r
 187   if result.family = AF_INET then result.ip := inaddrv.inaddr.addr;\r
 188   {$ifdef ipv6}\r
 189   if result.family = AF_INET6 then result.ip6 := inaddrv.inaddr6.sin6_addr;\r
 190   {$endif}\r
 191 end;\r
 192 \r
 193 function makeinaddrv(addr:tbinip;port:ansistring;var inaddr:tinetsockaddrv):integer;\r
 194 begin\r
 195   result := 0;\r
 196 {  biniptemp := forwardlookup(addr,10);}\r
 197   fillchar(inaddr,sizeof(inaddr),0);\r
 198   //writeln('converted address '+addr+' to binip '+ipbintostr(biniptemp));\r
 199   if addr.family = AF_INET then begin\r
 200     inAddr.InAddr.family:=AF_INET;\r
 201     inAddr.InAddr.port:=htons(strtointdef(port,0));\r
 202     inAddr.InAddr.addr:=addr.ip;\r
 203     result := sizeof(tinetsockaddr);\r
 204   end else\r
 205   {$ifdef ipv6}\r
 206   if addr.family = AF_INET6 then begin\r
 207     inAddr.InAddr6.sin6_family:=AF_INET6;\r
 208     inAddr.InAddr6.sin6_port:=htons(strtointdef(port,0));\r
 209     inAddr.InAddr6.sin6_addr:=addr.ip6;\r
 210     result := sizeof(tinetsockaddr6);\r
 211   end;\r
 212   {$endif}\r
 213 end;\r
 214 \r
 215 function inaddrsize(inaddr:tinetsockaddrv):integer;\r
 216 begin\r
 217   {$ifdef ipv6}\r
 218   if inaddr.inaddr.family = AF_INET6 then result := sizeof(tinetsockaddr6) else\r
 219   {$endif}\r
 220   result := sizeof(tinetsockaddr);\r
 221 end;\r
 222 \r
 223 {internal}\r
 224 {converts dotted v4 IP to longint. returns host endian order}\r
 225 function longip(s:thostname):longint;\r
 226 var\r
 227   l:longint;\r
 228   a,b:integer;\r
 229 function convertbyte(const s:ansistring):integer;\r
 230 begin\r
 231   result := strtointdef(s,-1);\r
 232   if result < 0 then begin\r
 233     result := -1;\r
 234     exit;\r
 235   end;\r
 236   if result > 255 then begin\r
 237     result := -1;\r
 238     exit;\r
 239   end;\r
 240   {01 exception}\r
 241   if (result <> 0) and (s[1] = '0') then begin\r
 242     result := -1;\r
 243     exit;\r
 244   end;\r
 245   {+1 exception}\r
 246   if not (s[1] in ['0'..'9']) then begin\r
 247     result := -1;\r
 248     exit\r
 249   end;\r
 250 end;\r
 251 \r
 252 begin\r
 253   result := 0;\r
 254   a := pos('.',s);\r
 255   if a = 0 then exit;\r
 256   b := convertbyte(copy(s,1,a-1));if (b < 0) then exit;\r
 257   l := b shl 24;\r
 258   s := copy(s,a+1,256);\r
 259   a := pos('.',s);\r
 260   if a = 0 then exit;\r
 261   b := convertbyte(copy(s,1,a-1));if (b < 0) then exit;\r
 262   l := l or b shl 16;\r
 263   s := copy(s,a+1,256);\r
 264   a := pos('.',s);\r
 265   if a = 0 then exit;\r
 266   b := convertbyte(copy(s,1,a-1));if (b < 0) then exit;\r
 267   l := l or b shl 8;\r
 268   s := copy(s,a+1,256);\r
 269   b := convertbyte(copy(s,1,256));if (b < 0) then exit;\r
 270   l := l or b;\r
 271   result := l;\r
 272 end;\r
 273 \r
 274 \r
 275 function ipstrtobinf;\r
 276 begin\r
 277   ipstrtobin(s,result);\r
 278 end;\r
 279 \r
 280 function ipstrtobin(const s:thostname;var binip:tbinip):boolean;\r
 281 begin\r
 282   binip.family := 0;\r
 283   result := false;\r
 284   {$ifdef ipv6}\r
 285   if pos(':',s) <> 0 then begin\r
 286     {try ipv6. use builtin routine}\r
 287     result := ip6strtobin(s,binip.ip6);\r
 288     if result then binip.family := AF_INET6;\r
 289     exit;\r
 290   end;\r
 291   {$endif}\r
 292 \r
 293   {try v4}\r
 294   binip.ip := htonl(longip(s));\r
 295   if (binip.ip <> 0) or (s = '0.0.0.0') then begin\r
 296     result := true;\r
 297     binip.family := AF_INET;\r
 298     exit;\r
 299   end;\r
 300 end;\r
 301 \r
 302 function ipbintostr(const binip:tbinip):thostname;\r
 303 var\r
 304   a:integer;\r
 305 begin\r
 306   result := '';\r
 307   {$ifdef ipv6}\r
 308   if binip.family = AF_INET6 then begin\r
 309     result := ip6bintostr(binip.ip6);\r
 310   end else\r
 311   {$endif}\r
 312   if binip.family = AF_INET then begin\r
 313     a := htonl(binip.ip);\r
 314     result := inttostr(a shr 24)+'.'+inttostr((a shr 16) and $ff)+'.'+inttostr((a shr 8) and $ff)+'.'+inttostr(a and $ff);\r
 315   end;\r
 316 end;\r
 317 \r
 318 \r
 319 {------------------------------------------------------------------------------}\r
 320 \r
 321 {$ifdef ipv6}\r
 322 \r
 323 {\r
 324 IPv6 address binary to/from string conversion routines\r
 325 written by beware\r
 326 \r
 327 - implementation does not depend on other ipv6 code such as the tin6_addr type,\r
 328   the parameter can also be untyped.\r
 329 - it is host endian neutral - binary format is aways network order\r
 330 - it supports compression of zeroes\r
 331 - it supports ::ffff:192.168.12.34 style addresses\r
 332 - they are made to do the Right Thing, more efficient implementations are possible\r
 333 }\r
 334 \r
 335 {fpc has hostaddrtostr6 and strtohostaddr6 but the later isnt implemented yet}\r
 336 \r
 337 \r
 338 function ip6bintostr(const bin:tin6_addr):thostname;\r
 339 {base16 with lowercase output}\r
 340 function makehex(w:word):ansistring;\r
 341 begin\r
 342   result := '';\r
 343   if w >= 4096 then result := result + hexchars[w shr 12];\r
 344   if w >= 256 then result := result + hexchars[w shr 8 and $f];\r
 345   if w >= 16 then result := result + hexchars[w shr 4 and $f];\r
 346   result := result + hexchars[w and $f];\r
 347 end;\r
 348 \r
 349 var\r
 350   a,b,c,addrlen:integer;\r
 351   runbegin,runlength:integer;\r
 352   bytes:array[0..15] of byte absolute bin;\r
 353   words:array[0..7] of word;\r
 354   dwords:array[0..3] of integer absolute words;\r
 355 begin\r
 356   for a := 0 to 7 do begin\r
 357     words[a] := bytes[a shl 1] shl 8 or bytes[a shl 1 or 1];\r
 358   end;\r
 359   if (dwords[0] = 0) and (dwords[1] = 0) and (words[4] = 0) and (words[5] = $ffff) then begin\r
 360     {::ffff:/96 exception: v4 IP}\r
 361     addrlen := 6;\r
 362   end else begin\r
 363     addrlen := 8;\r
 364   end;\r
 365   {find longest run of zeroes}\r
 366   runbegin := 0;\r
 367   runlength := 0;\r
 368   for a := 0 to addrlen-1 do begin\r
 369     if words[a] = 0 then begin\r
 370       c := 0;\r
 371       for b := a to addrlen-1 do if words[b] = 0 then begin\r
 372         inc(c);\r
 373       end else break;\r
 374       if (c > runlength) then begin\r
 375         runlength := c;\r
 376         runbegin := a;\r
 377       end;\r
 378     end;\r
 379   end;\r
 380   result := '';\r
 381   for a := 0 to runbegin-1 do begin\r
 382     if (a <> 0) then result := result + ':';\r
 383     result := result + makehex(words[a]);\r
 384   end;\r
 385   if runlength > 0 then result := result + '::';\r
 386   c := runbegin+runlength;\r
 387   for a := c to addrlen-1 do begin\r
 388     if (a > c) then result := result + ':';\r
 389     result := result + makehex(words[a]);\r
 390   end;\r
 391   if addrlen = 6 then begin\r
 392     result := result + ':'+inttostr(bytes[12])+'.'+inttostr(bytes[13])+'.'+inttostr(bytes[14])+'.'+inttostr(bytes[15]);\r
 393   end;\r
 394 end;\r
 395 \r
 396 function ip6strtobin(const s:thostname;var bin:tin6_addr):boolean;\r
 397 var\r
 398   a,b:integer;\r
 399   fields:array[0..7] of ansistring;\r
 400   fieldcount:integer;\r
 401   emptyfield:integer;\r
 402   wordcount:integer;\r
 403   words:array[0..7] of word;\r
 404   bytes:array[0..15] of byte absolute bin;\r
 405 begin\r
 406   result := false;\r
 407   for a := 0 to 7 do fields[a] := '';\r
 408   fieldcount := 0;\r
 409   for a := 1 to length(s) do begin\r
 410     if s[a] = ':' then inc(fieldcount) else fields[fieldcount] := fields[fieldcount] + s[a];\r
 411     if fieldcount > 7 then exit;\r
 412   end;\r
 413   if fieldcount < 2 then exit;\r
 414 \r
 415   {find the empty field (compressed zeroes), not counting the first and last there may be at most 1}\r
 416   emptyfield := -1;\r
 417   for a := 1 to fieldcount-1 do begin\r
 418     if fields[a] = '' then begin\r
 419       if emptyfield = -1 then emptyfield := a else exit;\r
 420     end;\r
 421   end;\r
 422 \r
 423   {check if last field is a valid v4 IP}\r
 424   a := longip(fields[fieldcount]);\r
 425   if (a <> 0) or (fields[fieldcount] = '0.0.0.0') then wordcount := 6 else wordcount := 8;\r
 426   {0:1:2:3:4:5:6.6.6.6\r
 427    0:1:2:3:4:5:6:7}\r
 428   fillchar(words,sizeof(words),0);\r
 429   if wordcount = 6 then begin\r
 430     if fieldcount > 6 then exit;\r
 431     words[6] := a shr 16;\r
 432     words[7] := a and $ffff;\r
 433   end;\r
 434   if emptyfield = -1 then begin\r
 435     {no run length: must be an exact number of fields}\r
 436     if wordcount = 6 then begin\r
 437       if fieldcount <> 6 then exit;\r
 438       emptyfield := 5;\r
 439     end else if wordcount = 8 then begin\r
 440       if fieldcount <> 7 then exit;\r
 441       emptyfield := 7;\r
 442     end else exit;\r
 443   end;\r
 444   for a := 0 to emptyfield do begin\r
 445     if fields[a] = '' then b := 0 else b := strtointdef('$'+fields[a],-1);\r
 446     if (b < 0) or (b > $ffff) then exit;\r
 447     words[a] := b;\r
 448   end;\r
 449   if wordcount = 6 then dec(fieldcount);\r
 450   for a := wordcount-1 downto wordcount-(fieldcount-emptyfield) do begin\r
 451     b := a+fieldcount-wordcount+1;\r
 452     if fields[b] = '' then b := 0 else b := strtointdef('$'+fields[b],-1);\r
 453     if (b < 0) or (b > $ffff) then exit;\r
 454     words[a] := b;\r
 455   end;\r
 456   for a := 0 to 7 do begin\r
 457     bytes[a shl 1] := words[a] shr 8;\r
 458     bytes[a shl 1 or 1] := words[a] and $ff;\r
 459   end;\r
 460   result := true;\r
 461 end;\r
 462 {$endif}\r
 463 \r
 464 function comparebinip(const ip1,ip2:tbinip):boolean;\r
 465 begin\r
 466   if (ip1.ip <> ip2.ip) then begin\r
 467     result := false;\r
 468     exit;\r
 469   end;\r
 470 \r
 471   {$ifdef ipv6}\r
 472   if ip1.family = AF_INET6 then begin\r
 473     if (ip1.ip6.s6_addr32[1] <> ip2.ip6.s6_addr32[1])\r
 474     or (ip1.ip6.s6_addr32[2] <> ip2.ip6.s6_addr32[2])\r
 475     or (ip1.ip6.s6_addr32[3] <> ip2.ip6.s6_addr32[3]) then begin\r
 476       result := false;\r
 477       exit;\r
 478     end;\r
 479   end;\r
 480   {$endif}\r
 481 \r
 482   result := (ip1.family = ip2.family);\r
 483 end;\r
 484 \r
 485 procedure maskbits(var binip:tbinip;bits:integer);\r
 486 const\r
 487   ipmax={$ifdef ipv6}15{$else}3{$endif};\r
 488 type tarr=array[0..ipmax] of byte;\r
 489 var\r
 490   arr:^tarr;\r
 491   a,b:integer;\r
 492 begin\r
 493   arr := @binip.ip;\r
 494   if bits = 0 then b := 0 else b := ((bits-1) div 8)+1;\r
 495   for a := b to ipmax do begin\r
 496     arr[a] := 0;\r
 497   end;\r
 498   if (bits and 7 <> 0) then begin\r
 499     arr[bits shr 3] := arr[bits div 8] and not ($ff shr (bits and 7))\r
 500   end;\r
 501 end;\r
 502 \r
 503 function comparebinipmask;\r
 504 begin\r
 505   maskbits(ip1,bits);\r
 506   maskbits(ip2,bits);\r
 507   result := comparebinip(ip1,ip2);\r
 508 end;\r
 509 \r
 510 function needconverttov4(const ip:tbinip):boolean;\r
 511 begin\r
 512   {$ifdef ipv6}\r
 513   if ip.family = AF_INET6 then begin\r
 514     if (ip.ip6.u6_addr32[0] = 0) and (ip.ip6.u6_addr32[1] = 0) and\r
 515     (ip.ip6.u6_addr16[4] = 0) and (ip.ip6.u6_addr16[5] = $ffff) then begin\r
 516       result := true;\r
 517       exit;\r
 518     end;\r
 519   end;\r
 520   {$endif}\r
 521 \r
 522   result := false;\r
 523 end;\r
 524 \r
 525 {converts a binary IP to v4 if it is a v6 IP in the v4 range}\r
 526 procedure converttov4(var ip:tbinip);\r
 527 begin\r
 528   {$ifdef ipv6}\r
 529   if needconverttov4(ip) then begin\r
 530     ip.family := AF_INET;\r
 531     ip.ip := ip.ip6.s6_addr32[3];\r
 532   end;\r
 533   {$endif}\r
 534 end;\r
 535 \r
 536 {-----------biniplist stuff--------------------------------------------------}\r
 537 \r
 538 const\r
 539   biniplist_prefix: ansistring = 'bipl'#0;\r
 540   //fpc 1.0.x doesn't seem to like use of length function in a constant \r
 541   //definition\r
 542   //biniplist_prefixlen=length(biniplist_prefix);\r
 543 \r
 544   biniplist_prefixlen=5;\r
 545   \r
 546 function biniplist_new:tbiniplist;\r
 547 begin\r
 548   result := biniplist_prefix;\r
 549 end;\r
 550 \r
 551 procedure biniplist_add(var l:tbiniplist;ip:tbinip);\r
 552 var\r
 553   a:integer;\r
 554 begin\r
 555   a := biniplist_getcount(l);\r
 556   biniplist_setcount(l,a+1);\r
 557   biniplist_set(l,a,ip);\r
 558 end;\r
 559 \r
 560 function biniplist_getcount(const l:tbiniplist):integer;\r
 561 begin\r
 562   result := (length(l)-biniplist_prefixlen) div sizeof(tbinip);\r
 563 end;\r
 564 \r
 565 function biniplist_get(const l:tbiniplist;index:integer):tbinip;\r
 566 begin\r
 567   if (index >= biniplist_getcount(l)) then begin\r
 568     fillchar(result,sizeof(result),0);\r
 569     exit;\r
 570   end;\r
 571   move(l[index*sizeof(tbinip)+1+biniplist_prefixlen],result,sizeof(result));\r
 572 end;\r
 573 \r
 574 procedure biniplist_set(var l:tbiniplist;index:integer;ip:tbinip);\r
 575 begin\r
 576   uniquestring(l);\r
 577   move(ip,l[index*sizeof(tbinip)+1+biniplist_prefixlen],sizeof(ip));\r
 578 end;\r
 579 \r
 580 procedure biniplist_setcount(var l:tbiniplist;newlen:integer);\r
 581 begin\r
 582   setlength(l,(sizeof(tbinip)*newlen)+biniplist_prefixlen);\r
 583 end;\r
 584 \r
 585 procedure biniplist_free(var l:tbiniplist);\r
 586 begin\r
 587   l := '';\r
 588 end;\r
 589 \r
 590 procedure biniplist_addlist;\r
 591 begin\r
 592   l := l + copy(l2,biniplist_prefixlen+1,maxlongint);\r
 593 end;\r
 594 \r
 595 function biniplist_tostr(const l:tbiniplist):thostname;\r
 596 var\r
 597   a:integer;\r
 598 begin\r
 599   result := '(';\r
 600   for a := 0 to biniplist_getcount(l)-1 do begin\r
 601     if result <> '(' then result := result + ', ';\r
 602     result := result + ipbintostr(biniplist_get(l,a));\r
 603   end;\r
 604   result := result + ')';\r
 605 end;\r
 606 \r
 607 function isbiniplist(const l:tbiniplist):boolean;\r
 608 var\r
 609   i : integer;\r
 610 begin\r
 611   for i := 1 to biniplist_prefixlen do begin\r
 612     if biniplist_prefix[i] <> l[i] then begin\r
 613       result := false;\r
 614       exit;\r
 615     end;\r
 616   end;\r
 617   result := true;\r
 618 end;\r
 619 \r
 620 procedure addipsoffamily(var l:tbiniplist;const l2:tbiniplist;family:integer);\r
 621 var\r
 622   a:integer;\r
 623   biniptemp:tbinip;\r
 624 begin\r
 625   for a := biniplist_getcount(l2)-1 downto 0 do begin\r
 626     biniptemp := biniplist_get(l2,a);\r
 627     if (biniptemp.family = family) then biniplist_add(l,biniptemp);\r
 628   end;\r
 629 end;\r
 630 \r
 631 \r
 632 end.\r