Version 7 of File Upload example

Updated 2003-02-03 23:38:08

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 delete them. The fileupload.tcl handles the upload of files and has some javascript which causes the upfile page to be retrieved again.

Point your browser to http://yourserver/upfile

********* Save to upfile.tcl *****

   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
   }

************ Save to fileupload.tcl *****************

   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
   }

Question about Upload_Url: The optional argument

 -maxbytes nnn

doesn't seem to work. So the webserver has to receive a hole file before seeing that it is too large and purging it. Although running a mutlithread-supporting version of tcl an tclhttpd, the optional parameter

 -thread 1

hangs the fileupload process. Can anyone help? mailto:[email protected] .


I don't think some of the arguments in the upload.tcl file are implemented. I had a similiar experience with -maxfiles nnn. I posted the TclHttpd mailing list and Brent Welch the author confirmed it wasn't. He was very kind and wrote some code which helped me get the feature to work but I don't think the code made it into the production release. Search the TclHttpd mailing list archive http://sourceforge.net/mail/?group_id=12884 or join the list and ask, everyone is friendly and willing to help. Michael Hankinson


Category Internet