Posted to tcl by patthoyts at Tue Jun 24 20:51:15 GMT 2008view pretty

# 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
}