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