Piloter une caméra IP GrandTec

 

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