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
}