星星博客's Archiver

cnangel 发表于 2005-8-25 20:02

用 perl 实现文件上传

[color=red]作者:keendom
email: [email]keendom@sina.com[/email]
日期:00-6-29 13:28:47[/color]
示例的 HTML 文件如下:[code]
<html>
<body>
<form method="POST" action="psupload.cgi" ENCTYPE="multipart/form-data">
File 1:
<input type="file" name="FILE1">
<br>
File 2:
<input type="file" name="FILE2">
<br>
<input type="submit" value="Upload!">
</form>
</body>
</html>
[/code]
后台的 Perl 程序如下:
[code]
&#35;!/usr/bin/perl
&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;
&#35;&#35; Perl Services Upload Helper v1.0 &#35;&#35;
&#35;&#35; http://www.perlservices.com &#35;&#35;
&#35;&#35; perlservices@perlservices.com &#35;&#35;
&#35;&#35; &#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;
&#35;&#35; You should carefully read all of the following terms and conditions &#35;&#35;
&#35;&#35; before using this program. Your use of this software indicates your &#35;&#35;
&#35;&#35; acceptance of this license agreement and warranty. &#35;&#35;
&#35;&#35; This program is being distributed as freeware. It may be used &#35;&#35;
&#35;&#35; free of charge, but not modified below the line specified. This copyright &#35;&#35;
&#35;&#35; must remain intact. &#35;&#35;
&#35;&#35; &#35;&#35;
&#35;&#35; By using this program you agree to indemnify Perl Services from any &#35;&#35;
&#35;&#35; liability. &#35;&#35;
&#35;&#35; &#35;&#35;
&#35;&#35; Selling the code for this program without prior written consent is &#35;&#35;
&#35;&#35; expressly forbidden. Obtain permission before redistributing this &#35;&#35;
&#35;&#35; program over the Internet or in any other medium. In all cases the &#35;&#35;
&#35;&#35; copyright must remain intact. &#35;&#35;
&#35;&#35; &#35;&#35;
&#35;&#35; There are security hazards involved with this script. Read the readme file&#35;&#35;
&#35;&#35; before using the script. &#35;&#35;
&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;
&#35;&#35;
&#35;&#35; Start setting up options here:
&#35;&#35; Your path to where you want your files uploaded.
&#35;&#35; Note: NO trailing slash
&#36;basedir = "/home/path/to/directory";
&#35;&#35; Do you wish to allow all file types? yes/no (no capital letters)
&#36;allowall = "yes";
&#35;&#35; If the above = "no"; then which is the only extention to allow?
&#35;&#35; Remember to have the LAST 4 characters i.e. .ext
&#36;theext = ".gif";
&#35;&#35; The page you wish it to forward to when done:
&#35;&#35; I.E. http://www.mydomainname.com/thankyou.html
&#36;donepage = "http://www.perlservices.com/";
&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;
&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;
&#35;&#35; DO NOT EDIT OR COPY BELOW THIS LINE &#35;&#35;
&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;
&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;&#35;
use CGI;
&#36;onnum = 1;
while (&#36;onnum != 11) {
my &#36;req = new CGI;
my &#36;file = &#36;req->param("FILE&#36;onnum");
if (&#36;file ne "") {
my &#36;fileName = &#36;file;
&#36;fileName =~ s!^.*(\\|\/)!!;
&#36;newmain = &#36;fileName;
if (&#36;allowall ne "yes") {
if (lc(substr(&#36;newmain,length(&#36;newmain) - 4,4)) ne &#36;theext){
&#36;filenotgood = "yes";
}
}
if (&#36;filenotgood ne "yes") {
open (OUTFILE, ">&#36;basedir/&#36;fileName");
print "&#36;basedir/&#36;fileName<br>";
while (my &#36;bytesread = read(&#36;file, my &#36;buffer, 1024)) {
print OUTFILE &#36;buffer;
}
close (OUTFILE);
}
}
&#36;onnum++;
}
print "Content-type: text/html\n";
print "Location:&#36;donepage\n\n";
[/code]

页: [1]

Powered by Discuz! Archiver 7.0.0  © 2001-2009 Comsenz Inc.