File Upload Example
Here are two files that I use to upload files to Tclhttpd. They can be loaded in the custom directory.
Create a "hup" directory under the Doc_Root directory where the files will be uploaded. The upfile.tcl file displays a page that allows you to select the files you want to upload. It also lists the files that are currently in the "hup" directory and gives you a check box option to deletethem. The fileupload.tcl handles the upload of files and has some javascipt which causes the upfile page to be retrieved again.
Point your browser to http://yourserver/upfile
Direct_Url /upfile UpFile proc UpFile {} { global env set html "You can upload files to the /hup directory. The files currently in the /hup directory are listed in the table below.\n" append html "<FORM action=/upfile/filedelete method=post>\n\ <CENTER>\n\ <TABLE bgcolor=\"#cc3300\" bordercolor=\"#cc3300\" border=\"1\" cellpadding=\"3\" cellspacing=\"3\">\n\ <TH> Delete </TH> <TH> Files in /hup/ Directory </TH>\n" set file "" foreach f [glob -nocomplain -- [Doc_Root]/hup/*] { set file [file tail $f] append html "<TR><TD ALIGN=center><INPUT type=\"CHECKBOX\" name=\"$file\"></TD><TD> $file </TD></TR>\n" } append html "<TR><TD ALIGN=center COLSPAN=\"2\"><input type=submit value=\"Delete Files\"></TD></TR>\n\ </TABLE>\n\ </CENTRE>\n\ </FORM>" append html "<form ENCtype=multipart/form-data action=/fileupload method=post>\n" append html "File <input type=file name=the_file>\n" append html "<p>\n" append html "<input type=submit>\n" append html "</form>\n" return $html } proc UpFile/filedelete {args} { global env foreach {name value} $args { file delete [Doc_Root]/hup/$name } set html "<Html>\n" append html "<Head>\n" append html "<SCRIPT LANGUAGE=\"JavaScript\">\n" append html "function topWindow()\{\n" append html "window.location.href=\"http://$env(HTTP_HOST)/upfile\";\n" append html "\}\n" append html "onLoad=topWindow();\n" append html "</script>" append html "</Head>" append html "<Body>" append html "</Body>" append html "</Html>" return $html }
package require httpd::upload Upload_Url /fileupload [Doc_Root]/hup FileUpload proc FileUpload {args} { global env # Generate Page Header set html "<Html>\n" append html "<Head>\n" append html "<SCRIPT LANGUAGE=\"JavaScript\">\n" append html "function topWindow()\{\n" append html "window.location.href=\"http://$env(HTTP_HOST)/upfile\";\n" append html "\}\n" append html "onLoad=topWindow();\n" append html "</script>\n" append html "</Head>\n" append html "<Body>\n" append html "</Body>\n" append html "</Html>\n" return $html }