**FreeDB Access** [Beware] - I just wanted to share the following code, which bodges up a quick FreeDB access for reading CD tracklistings. It's not pretty, but it works. It uses the windows application diskid.exe which reads the CDID from the disc in the drive, see http://discid.sourceforge.net/%|%DiscID%|% ====== package require http set alldata {} set cds {} set tracks {} set cats {blues classical country data folk jazz newage reggae rock soundtrack misc} proc query {} { global cds tracks cats alldata set cds "" set tracks "" set r [catch {set ret [exec discid cdaudio]}] if {$r!=0} { tk_messageBox -message "No CD in drive or other error" return } set did [lindex $ret 0] set cdtemp "" foreach c $cats { set token [::http::geturl "http://freedb.freedb.org/~cddb/cddb.cgi?cmd=cddb+read+$c+$did&hello=name+host.com+W4CDTL+1.0&proto=1"] upvar #0 $token state set data $state(body) if {$data==""} {tk_messageBox -message "Try again - no data"; return} # 210 is code for found CD if {[lindex $data 0]==210} { lappend cdtemp $state(body) } } if {[llength $cdtemp]==0} {set cds "No Matches Found";return} set newcds "" foreach cd $cdtemp { set cd [split $cd "\n"] set lines [list] foreach l $cd { set r [split $l ""] set first [lindex $r 0] if {$first == "D" || $first == "T"} { set l [lindex [split $l "="] 1] lappend lines $l } } lappend newcds $lines lappend cds "[lindex $lines 0] - [lindex $lines 1]" } set alldata $newcds update } set last 0 proc cdselected {} { global cds tracks alldata last set tracks "" set w [.cds curselection] set last $w set trtemp [lrange [lindex $alldata $w] 2 end] set num 1 foreach tr $trtemp { lappend tracks "$num - $tr" incr num } } proc url x { #set x [regsub -all -nocase {htm} $x {ht%6D}] exec rundll32 url.dll,FileProtocolHandler $x & } proc print {} { global alldata tracks last set tracks "" set l [lindex $alldata $last] set trtemp [lrange [lindex $alldata $last] 2 end] set num 1 foreach tr $trtemp { lappend tracks "$num - $tr" incr num } # Add formatting here... set output "
$t |