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