Kroc :
GrandTec est une société Coréenne qui vend des caméras IP pas chères ([1]) mais qui ne fonctionne que sous Windows avec cette grosse daube d'Internet Explorer 6 (ou 7), ce qui est mal !
Le matériel étant pas mal, j'ai voulu le faire marcher sans IE et sur tous les OS, donc avec Tk.
Après un combat épique, Xavier et moi sommes arrivés à capturer l'image en faisant comme ça :
# Initialisation eTclKit : if {![info exists ::etcl::topdir]} { set ::etcl::topdir [file join [::etcl::etcl vfspath] main] set oldpath $::auto_path set ::auto_path {} foreach p $oldpath { if {[string first [info name] $p] != -1} {lappend ::auto_path $p} } unset oldpath p if {[file isdirectory [file join $::etcl::topdir lib]]} { if {[lsearch -exact $::auto_path [file join $::etcl::topdir lib]] < 0} { set ::auto_path [linsert $::auto_path 0 [file join $::etcl::topdir lib]] } } } package require Tk package require base64 package require pixane # Configuration par défaut de la caméra : set ::ip 192.168.1.100 set ::user root set ::pwd admin # Variables : set ::boundary "" set ::ready 0 set ::CL 0 set ::N "" # Lit le socket : proc reader {} { if {![eof $::sock]} { if {$::ready && $::CL} { set data "" set justread "" read $::sock 2 incr ::CL -2 while {$::CL} { incr ::CL [expr -[string length $justread]] set justread [read $::sock $::CL] append data $justread } # On mêt à jour l'image avec les données collectées : catch {image create photo CAP -data $data -format {jpeg}} ::N update idletasks unset data set ::ready 0 set ::CL 0 } else { set data [string trim [gets $::sock] "\r"] # On recherche le séparateur d'images : if {[string length $::boundary] && $data eq $::boundary} { # On change d'image : set ::ready 0 } elseif {[string first "Content-Length" $data] != -1} { set ::CL [expr round([lindex [split $data ": "] end].0)] } elseif {![string length $data]} { set ::ready 1 } elseif {[string first "x-mixed-replace" $data] != -1} { set ::boundary [lindex [split $data =] end] } } } } # Ouverture connection : proc connect {} { if {[catch {socket $::ip 80} ::sock]} {exit} fconfigure $::sock -buffering none -translation binary -encoding binary fileevent $::sock readable ::reader package require base64 set ident [::base64::encode [join "$::user $::pwd" :]]\r\n puts -nonewline $::sock "GET /video.cgi HTTP/1.0\r\n" puts -nonewline $::sock "Connection: Keep-Alive\r\n" puts -nonewline $::sock "Authorization: Basic $ident" puts -nonewline $::sock "\r\n" } # lance tout le truc : image create photo CAP -width 640 -height 480 grid [label .l01 -image CAP] -columnspan 4 -row 0 -column 0 # Utilisateur et mot de passe : grid [label .l11 -text "User :"] -row 1 -column 0 grid [entry .e11 -textvariable user] -row 1 -column 1 grid [label .l12 -text "Pwd :"] -row 1 -column 2 grid [entry .e12 -textvariable pwd] -row 1 -column 3 # IP et boutons : grid [label .l21 -text "IP:"] -row 2 -column 0 grid [entry .e21 -textvariable ip] -row 2 -column 1 grid [button .b21 -text go -command connect] -row 2 -column 2 grid [button .b22 -text ciao -command exit] -row 2 -column 3
Testé sous Windows et Mac OS X avec Tclkit 8.4.15 et eTcl 1.0.1.
Capture d'écran (celui de gauche c'est Xavier et celui de droite c'est Kroc) :
Kroc - 15/10/2009 : A la demande de Fred, ajout de deux champs pour pouvoir choisir l'utilisateur et le mot de passe.
Télécharger l'eTclPack pour Windows (implique que vous acceptez la licence Evolane qui est ici : [2]) : http://wfr.tcl.tk/fichiers/pub/GrandTec.exe
Pour info : le script ci-dessus est utilisé chez une copine pour surveiller la naissance des poulains dans un élevage de chevaux ici : http://www.harasdemela.fr