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