Posted to tcl by patthoyts at Tue Jun 24 20:51:15 GMT 2008view raw
- # C:\temp\t2i.vfs>tclkitsh86 ip.tcl
- # yours: 62.128.158.232 35.61 microseconds per iteration
- # mine : 62.128.158.232 4.42 microseconds per iteration
- # mine2: 62.128.158.232 3.96 microseconds per iteration
- # yours: 1048616680 55.97 microseconds per iteration
- # mine : 1048616680 42.98 microseconds per iteration
- # mine2: 1048616680 6.89 microseconds per iteration
- proc long2ip {long} {
- set x $long
- set d [expr $x % 256]
- set x [expr ($x-$d)/256]
- set c [expr $x % 256]
- set x [expr ($x-$c)/256]
- set b [expr $x % 256]
- set x [expr ($x-$b)/256]
- set a [expr $x % 256]
- return "$a.$b.$c.$d"
- }
- proc ip2long {ip} {
- if ![regexp {([0-9]+)\.([0-9]+)\.([0-9]+)\.([0-9]+)} $ip -> a b c d] {
- return 0
- }
- return [expr (($a*256+$b)*256+$c)*256+$d]
- }
- # -------------------------------------------------------------------------
- proc long2ip_pat {long} {
- set x $long
- set d [expr {$x % 256}]
- set x [expr {($x-$d)/256}]
- set c [expr {$x % 256}]
- set x [expr {($x-$c)/256}]
- set b [expr {$x % 256}]
- set x [expr {($x-$b)/256}]
- set a [expr {$x % 256}]
- return "$a.$b.$c.$d"
- }
- proc long2ip_pat2 {long} {
- set a [expr {($long >> 24) & 0xff}]
- set b [expr {($long >> 16) & 0xff}]
- set c [expr {($long >> 8) & 0xff}]
- set d [expr { $long & 0xff}]
- return "$a.$b.$c.$d"
- }
- proc ip2long_pat {ip} {
- if {![regexp {([0-9]+)\.([0-9]+)\.([0-9]+)\.([0-9]+)} $ip -> a b c d]} {
- return 0
- }
- return [expr {(($a*256+$b)*256+$c)*256+$d}]
- }
- proc ip2long_pat2 {ip} {
- set octets [split $ip .]
- if {[llength $octets] != 4} { return 0 }
- foreach oct $octets { if {$oct < 0 || $oct > 255} { return 0 } }
- foreach {a b c d} $octets break
- return [expr {($a << 24) | ($b << 16) | ($c << 8) | $d}]
- }
- proc Test {} {
- set addr [expr {0x3e809ee8}]
- puts "yours: [long2ip $addr]\t[time {long2ip $addr} 100]"
- puts "mine : [long2ip_pat $addr]\t[time {long2ip_pat $addr} 100]"
- puts "mine2: [long2ip_pat2 $addr]\t[time {long2ip_pat2 $addr} 100]"
- set ip 62.128.158.232
- puts "yours: [ip2long $ip]\t[time {ip2long $ip} 100]"
- puts "mine : [ip2long_pat $ip]\t[time {ip2long_pat $ip} 100]"
- puts "mine2: [ip2long_pat2 $ip]\t[time {ip2long_pat2 $ip} 100]"
- }
- if {!$tcl_interactive} {
- set r [catch [linsert $argv 0 Test] err]
- if {$r} {puts $errorInfo}
- exit $r
- }