<% @LANGUAGE = "VBSCRIPT" codepage= "936"%>
<! DOCTYPE HTML PUBLIC "-//W3C//DTD XHTML 1.0 transitional//en" "Http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd ">
<meta http-equiv= "Content-type" content= "text/html; charset=gb2312 "/>
<title></title>
<style>
td{font-size:12px;}
</style>
<body>
<table border=0 cellpadding=0 cellspacing=0 width=400>
<form id= "Form1" Name= "Form1" method= "Post" action= "2.asp Tutorial" onsubmit= "return F ()" >
<TR>
<TD colspan=2 align= "center" ><b></b></TD>
</TR>
<TR>
<TD> title </TD>
<td><input type= "text" name= "title" ></TD>
</TR>
<TR>
<TD> Documents </TD>
<td><input name= "pic" type= "text" id= "pic" size= "/><input type=" button "Name=" Submit "value=" Browse ... " onclick= "window.open (' upload.asp?fuptype=pic&frmname=form1&bdname=pic ');" /></td>
</TR>
<TR>
<TD colspan=2 align= "center" ><input type= "Submit" value= "Save" style= "width:150px". ></TD>
</TR>
</form>
</TABLE>
<script language= "JavaScript Tutorial" >
function f ()
{
if (document.form1.title.value== "")
{
Alert ("Title cannot be blank");
return false;
}
if (document.form1.pic.value== "")
{
Alert ("Picture cannot be blank");
return false;
}
}
</script>
</body>
upload.asp file
<form method= "POST" enctype= "Multipart/form-data" action= "Act=upload" >
<input type= "File" size= "Name=" file1 "><input type=" submit "value=" Upload ">
</form>
<%
If Request ("act") = "Upload" Then
'****************************************
' Function: AspUpload has component upload file
' Author: wangsdong
' URL: www.111cn.net tutorial
' Original source tutorial, reprint please keep this information, thank you
'****************************************
Allowext = "Jpg,png,gif,zip,rar,sql,txt,bak"
filesize=4194304
' On Error Resume Next
' New AspUpload Object
Set Upload = Server.CreateObject ("Persits.upload")
' Limit file size
Upload.setmaxsize FileSize, True
' Upload path--Test directory under current directory
If session ("Fuptype") = "pic" Then
Path= "Images/pic"
Else
Path= "Images/test"
End If
Uploaddir = Server.MapPath (path)
Autocreatefolder (uploaddir) ' Create folder
' Attempt to create a path folder, true to ignore directory already existing error
' Upload.createdirectory Uploaddir, True
' Upload files to server memory first
Count = Upload.Save ()
' Detect upload Errors
If Err.Number = 8 Then
Response.Write Chinese2unicode ("Error: File too large!")
Response.End
Else
If Err <> 0 Then
Response.Write Chinese2unicode ("Error occurred:")
Response.Write Chinese2unicode (Err.Description)
Response.End
End If
End If
' Response.Write Chinese2unicode ("Total" & Count & "Files") & "<br><br>"
' Specify a form file to upload
Set File = upload.files ("File1")
If not File are nothing Then
' Get the original filename
' filename = File.filename ' If you use the original filename, please remove the preceding single quote
Filename=replace (replace (now (), "", ""), "-", ""), ":", "") &file.ext ' with time as filename
' Get file name extension
Fileext = File.ext
v=path& "/" &filename
' Detect if the file format is qualified
Chkstr = "," &lcase (Allowext) & ","
If Instr (Chkstr, "," &right (fileext,3) & ",") <= 0 Then
Response.Write Chinese2unicode ("Error: Incorrect file type!")
Response.Write "<br>"
Response.Write Chinese2unicode ("Allow only:" &allowext)
' Remove temporary files in memory to free memory or hard disk space (also available with copy, move two instructions)
File.delete
' Detects if a file exists
ElseIf upload.fileexists (Uploaddir & "" & Filename) Then
File.saveas Uploaddir & "" & Filename
Response.Write Chinese2unicode ("Overwrite files with same file name:") & File.path
' Save file
Else
File.saveas Uploaddir & "" & Filename
' Response.Write Chinese2unicode ("File saved to:") & File.path
' V=replace (Uploadfilepath&file.filename, "...) /","")
Response.Write "<script>opener.document." &session ("Frmname") & "." &session ("Bdname") & ". Value= '" &v& "; Window.close ();</script>"
End If
Else
Response.Write Chinese2unicode ("Error: You did not select File!")
End If
Else
Session ("Fuptype") =request ("Fuptype") ' Upload type
Session ("Frmname") =request ("Frmname") ' form name
Session ("Bdname") =request ("Bdname") ' Table Single-name
End If
' gb2312 to Unicode to solve Chinese garbled problem
function Chinese2unicode (STR)
Dim i
Dim Str_one
Dim Str_unicode
For I=1 to Len (STR)
Str_one=mid (str,i,1)
STR_UNICODE=STR_UNICODE&CHR (38)
STR_UNICODE=STR_UNICODE&CHR (35)
STR_UNICODE=STR_UNICODE&CHR (120)
str_unicode=str_unicode& Hex (AscW (Str_one))
STR_UNICODE=STR_UNICODE&CHR (59)
Next
Response.Write Str_unicode
End Function
'--------------------------------
' Automatically create a specified multilevel folder
' strpath is an absolute path
Function Autocreatefolder (strpath) ' as Boolean '
On Error Resume Next
Dim Astrpath, Ulngpath, I, strTmpPath
Dim objFSO
If InStr (strpath, "") <=0 or InStr (strpath, ":") <= 0 Then
Autocreatefolder = False
Exit Function
End If
Set objFSO = Server.CreateObject ("Scripting.FileSystemObject")
If objfso.folderexists (strpath) Then
Autocreatefolder = True
Exit Function
End If
Astrpath = Split (strpath, "")
Ulngpath = UBound (Astrpath)
strTmpPath = ""
For i = 0 to Ulngpath
strTmpPath = strTmpPath & Astrpath (i) & ""
If not objfso.folderexists (strTmpPath) Then
' Create
Objfso.createfolder (strTmpPath)
End If
Next
Set objFSO = Nothing
If ERR = 0 Then
Autocreatefolder = True
Else
Autocreatefolder = False
End If
End Function
%>