jquery上传插件uploadify在asp中的使用[附件]jquery
jquery上传插件uploadify的官方地址是:http://www.uploadify.com/,功能很强大,支持多文件上传,进度条,可以控制是否选中图片后马上上传。但是官方提供的是php的,而在网上搜索提供的也只有asp.net的,而没有asp的。经过一段搜索和自己摸索,终于找到了uploadify在asp的使用方法。
首先我们需要一个asp上传类,这里的名字是uploader.asp,根据热心网友“lijie”的留言,生成的文件名可能会出现重复已经做了修正,并加入了真正意义上的图片判断,而不是仅仅通过判断后缀名,防止被人上传伪装成图片的木马文件。修正后的代码如下:
<%
' For examples, documentation, and your own free copy, go to:
' http://www.freeaspupload.net
' Note: You can copy and use this script for free and you can make changes
' to the code, but you cannot remove the above comment.
'Changes:
'Aug 2, 2005: Add support for checkboxes and other input elements with multiple values
'Jan 6, 2009: Lars added ASP_CHUNK_SIZE
const DEFAULT_ASP_CHUNK_SIZE = 200000
Class Uploader
Public UploadedFiles
Public FormElements
Private VarArrayBinRequest
Private StreamRequest
Private uploadedYet
Private internalChunkSize
Private Sub Class_Initialize()
Set UploadedFiles = Server.CreateObject("Scripting.Dictionary")
Set FormElements = Server.CreateObject("Scripting.Dictionary")
Set StreamRequest = Server.CreateObject("ADODB.Stream")
StreamRequest.Type = 2 ' adTypeText
StreamRequest.Open
uploadedYet = false
internalChunkSize = DEFAULT_ASP_CHUNK_SIZE
End Sub
Private Sub Class_Terminate()
If IsObject(UploadedFiles) Then
UploadedFiles.RemoveAll()
Set UploadedFiles = Nothing
End If
If IsObject(FormElements) Then
FormElements.RemoveAll()
Set FormElements = Nothing
End If
StreamRequest.Close
Set StreamRequest = Nothing
End Sub
Public Property Get Form(sIndex)
Form = ""
If FormElements.Exists(LCase(sIndex)) Then Form = FormElements.Item(LCase(sIndex))
End Property
Public Property Get Files()
Files = UploadedFiles.Items
End Property
Public Property Get Exists(sIndex)
Exists = false
If FormElements.Exists(LCase(sIndex)) Then Exists = true
End Property
Public Property Get FileExists(sIndex)
FileExists = false
if UploadedFiles.Exists(LCase(sIndex)) then FileExists = true
End Property
Public Property Get chunkSize()
chunkSize = internalChunkSize
End Property
Public Property Let chunkSize(sz)
internalChunkSize = sz
End Property
'Calls Upload to extract the data from the binary request and then saves the uploaded files
Public Sub Save(path)
Dim streamFile, fileItem
if Right(path, 1) <> "\" then path = path & "\"
if not uploadedYet then Upload
For Each fileItem In UploadedFiles.Items
Set streamFile = Server.CreateObject("ADODB.Stream")
streamFile.Type = 1
streamFile.Open
StreamRequest.Position=fileItem.Start
StreamRequest.CopyTo streamFile, fileItem.Length
'add by ahuinan 2010-8-28
Dim newffname:newffname=GetFileName(path, fileItem.FileName)
streamFile.SaveToFile newffname, 2
'判断文件类型是否正确
If Not CheckFileType(newffname) then
Set fso = CreateObject("Scripting.FileSystemObject")
Set ficn = fso.GetFile(Server.mappath(filename))
ficn.delete
set ficn=nothing
set fso=nothing
End If
streamFile.close
Set streamFile = Nothing
'Response.Write(newffname)
fileItem.Path = path & fileItem.FileName
Next
End Sub
public sub SaveOne(path, num, byref outFileName, byref outLocalFileName)
Dim streamFile, fileItems, fileItem, fs
set fs = Server.CreateObject("Scripting.FileSystemObject")
if Right(path, 1) <> "\" then path = path & "\"
if not uploadedYet then Upload
if UploadedFiles.Count > 0 then
fileItems = UploadedFiles.Items
set fileItem = fileItems(num)
outFileName = fileItem.FileName
outLocalFileName = GetFileName(path, outFileName)
Set streamFile = Server.CreateObject("ADODB.Stream")
streamFile.Type = 1
streamFile.Open
StreamRequest.Position = fileItem.Start
StreamRequest.CopyTo streamFile, fileItem.Length
streamFile.SaveToFile path & outLocalFileName, 2
streamFile.close
Set streamFile = Nothing
fileItem.Path = path & filename
end if
end sub
Public Function SaveBinRequest(path) ' For debugging purposes
StreamRequest.SaveToFile path & "\debugStream.bin", 2
End Function
Public Sub DumpData() 'only works if files are plain text
Dim i, aKeys, f
response.write "Form Items:<br>"
aKeys = FormElements.Keys
For i = 0 To FormElements.Count -1 ' Iterate the array
response.write aKeys(i) & " = " & FormElements.Item(aKeys(i)) & "<BR>"
Next
response.write "Uploaded Files:<br>"
For Each f In UploadedFiles.Items
response.write "Name: " & f.FileName & "<br>"
response.write "Type: " & f.ContentType & "<br>"
response.write "Start: " & f.Start & "<br>"
response.write "Size: " & f.Length & "<br>"
Next
End Sub
Public Sub Upload()
Dim nCurPos, nDataBoundPos, nLastSepPos
Dim nPosFile, nPosBound
Dim sFieldName, osPathSep, auxStr
Dim readBytes, readLoop, tmpBinRequest
'RFC1867 Tokens
Dim vDataSep
Dim tNewLine, tDoubleQuotes, tTerm, tFilename, tName, tContentDisp, tContentType
tNewLine = String2Byte(Chr(13))
tDoubleQuotes = String2Byte(Chr(34))
tTerm = String2Byte("--")
tFilename = String2Byte("filename=""")
tName = String2Byte("name=""")
tContentDisp = String2Byte("Content-Disposition")
tContentType = String2Byte("Content-Type:")
uploadedYet = true
'on error resume next
readBytes = internalChunkSize
VarArrayBinRequest = Request.BinaryRead(readBytes)
VarArrayBinRequest = midb(VarArrayBinRequest, 1, lenb(VarArrayBinRequest))
for readLoop = 0 to 300000
tmpBinRequest = Request.BinaryRead(readBytes)
if readBytes < 1 then exit for
VarArrayBinRequest = VarArrayBinRequest & midb(tmpBinRequest, 1, lenb(tmpBinRequest))
next
if Err.Number <> 0 then
response.write "<br><br><B>System reported this error:</B><p>"
response.write Err.Description & "<p>"
response.write "The most likely cause for this error is the incorrect setup of AspMaxRequestEntityAllowed in IIS MetaBase. Please see instructions in the <A HREF='http://www.freeaspupload.net/freeaspupload/requirements.asp'>requirements page of freeaspupload.net</A>.<p>"
Exit Sub
end if
on error goto 0 'reset error handling
nCurPos = FindToken(tNewLine,1) 'Note: nCurPos is 1-based (and so is InstrB, MidB, etc)
If nCurPos <= 1 Then Exit Sub
'vDataSep is a separator like -----------------------------21763138716045
vDataSep = MidB(VarArrayBinRequest, 1, nCurPos-1)
'Start of current separator
nDataBoundPos = 1
'Beginning of last line
nLastSepPos = FindToken(vDataSep & tTerm, 1)
Do Until nDataBoundPos = nLastSepPos
nCurPos = SkipToken(tContentDisp, nDataBoundPos)
nCurPos = SkipToken(tName, nCurPos)
sFieldName = ExtractField(tDoubleQuotes, nCurPos)
nPosFile = FindToken(tFilename, nCurPos)
nPosBound = FindToken(vDataSep, nCurPos)
If nPosFile <> 0 And nPosFile < nPosBound Then
Dim oUploadFile
Set oUploadFile = New UploadedFile
nCurPos = SkipToken(tFilename, nCurPos)
auxStr = ExtractField(tDoubleQuotes, nCurPos)
' We are interested only in the name of the file, not the whole path
' Path separator is \ in windows, / in UNIX
' While IE seems to put the whole pathname in the stream, Mozilla seem to
' only put the actual file name, so UNIX paths may be rare. But not impossible.
osPathSep = "\"
if InStr(auxStr, osPathSep) = 0 then osPathSep = "/"
oUploadFile.FileName = Right(auxStr, Len(auxStr)-InStrRev(auxStr, osPathSep))
if (Len(oUploadFile.FileName) > 0) then 'File field not left empty
nCurPos = SkipToken(tContentType, nCurPos)
auxStr = ExtractField(tNewLine, nCurPos)
' NN on UNIX puts things like this in the stream:
' ?? python py type=?? python application/x-python
oUploadFile.ContentType = Right(auxStr, Len(auxStr)-InStrRev(auxStr, " "))
nCurPos = FindToken(tNewLine, nCurPos) + 4 'skip empty line
oUploadFile.Start = nCurPos+1
oUploadFile.Length = FindToken(vDataSep, nCurPos) - 2 - nCurPos
If oUploadFile.Length > 0 Then UploadedFiles.Add LCase(sFieldName), oUploadFile
End If
Else
Dim nEndOfData
nCurPos = FindToken(tNewLine, nCurPos) + 4 'skip empty line
nEndOfData = FindToken(vDataSep, nCurPos) - 2
If Not FormElements.Exists(LCase(sFieldName)) Then
FormElements.Add LCase(sFieldName), Byte2String(MidB(VarArrayBinRequest, nCurPos, nEndOfData-nCurPos))
else
FormElements.Item(LCase(sFieldName))= FormElements.Item(LCase(sFieldName)) & ", " & Byte2String(MidB(VarArrayBinRequest, nCurPos, nEndOfData-nCurPos))
end if
End If
'Advance to next separator
nDataBoundPos = FindToken(vDataSep, nCurPos)
Loop
StreamRequest.WriteText(VarArrayBinRequest)
End Sub
Private Function SkipToken(sToken, nStart)
SkipToken = InstrB(nStart, VarArrayBinRequest, sToken)
If SkipToken = 0 then
Response.write "Error in parsing uploaded binary request. The most likely cause for this error is the incorrect setup of AspMaxRequestEntityAllowed in IIS MetaBase. Please see instructions in the <A HREF='http://www.freeaspupload.net/freeaspupload/requirements.asp'>requirements page of freeaspupload.net</A>.<p>"
Response.End
end if
SkipToken = SkipToken + LenB(sToken)
End Function
Private Function FindToken(sToken, nStart)
FindToken = InstrB(nStart, VarArrayBinRequest, sToken)
End Function
Private Function ExtractField(sToken, nStart)
Dim nEnd
nEnd = InstrB(nStart, VarArrayBinRequest, sToken)
If nEnd = 0 then
Response.write "Error in parsing uploaded binary request."
Response.End
end if
ExtractField = Byte2String(MidB(VarArrayBinRequest, nStart, nEnd-nStart))
End Function
'String to byte string conversion
Private Function String2Byte(sString)
Dim i
For i = 1 to Len(sString)
String2Byte = String2Byte & ChrB(AscB(Mid(sString,i,1)))
Next
End Function
'Byte string to string conversion
Private Function Byte2String(bsString)
Dim i
dim b1, b2, b3, b4
Byte2String =""
For i = 1 to LenB(bsString)
if AscB(MidB(bsString,i,1)) < 128 then
' One byte
Byte2String = Byte2String & ChrW(AscB(MidB(bsString,i,1)))
elseif AscB(MidB(bsString,i,1)) < 224 then
' Two bytes
b1 = AscB(MidB(bsString,i,1))
b2 = AscB(MidB(bsString,i+1,1))
Byte2String = Byte2String & ChrW((((b1 AND 28) / 4) * 256 + (b1 AND 3) * 64 + (b2 AND 63)))
i = i + 1
elseif AscB(MidB(bsString,i,1)) < 240 then
' Three bytes
b1 = AscB(MidB(bsString,i,1))
b2 = AscB(MidB(bsString,i+1,1))
b3 = AscB(MidB(bsString,i+2,1))
Byte2String = Byte2String & ChrW(((b1 AND 15) * 16 + (b2 AND 60)) * 256 + (b2 AND 3) * 64 + (b3 AND 63))
i = i + 2
else
' Four bytes
b1 = AscB(MidB(bsString,i,1))
b2 = AscB(MidB(bsString,i+1,1))
b3 = AscB(MidB(bsString,i+2,1))
b4 = AscB(MidB(bsString,i+3,1))
' Don't know how to handle this, I believe Microsoft doesn't support these characters so I replace them with a "^"
'Byte2String = Byte2String & ChrW(((b1 AND 3) * 64 + (b2 AND 63)) & "," & (((b1 AND 28) / 4) * 256 + (b1 AND 3) * 64 + (b2 AND 63)))
Byte2String = Byte2String & "^"
i = i + 3
end if
Next
End Function
End Class
Class UploadedFile
Public ContentType
Public Start
Public Length
Public Path
Private nameOfFile
' Need to remove characters that are valid in UNIX, but not in Windows
Public Property Let FileName(fN)
nameOfFile = fN
nameOfFile = SubstNoReg(nameOfFile, "\", "_")
nameOfFile = SubstNoReg(nameOfFile, "/", "_")
nameOfFile = SubstNoReg(nameOfFile, ":", "_")
nameOfFile = SubstNoReg(nameOfFile, "*", "_")
nameOfFile = SubstNoReg(nameOfFile, "?", "_")
nameOfFile = SubstNoReg(nameOfFile, """", "_")
nameOfFile = SubstNoReg(nameOfFile, "<", "_")
nameOfFile = SubstNoReg(nameOfFile, ">", "_")
nameOfFile = SubstNoReg(nameOfFile, "|", "_")
End Property
Public Property Get FileName()
FileName = nameOfFile
End Property
'Public Property Get FileN()ame
End Class
' Does not depend on RegEx, which is not available on older VBScript
' Is not recursive, which means it will not run out of stack space
Function SubstNoReg(initialStr, oldStr, newStr)
Dim currentPos, oldStrPos, skip
If IsNull(initialStr) Or Len(initialStr) = 0 Then
SubstNoReg = ""
ElseIf IsNull(oldStr) Or Len(oldStr) = 0 Then
SubstNoReg = initialStr
Else
If IsNull(newStr) Then newStr = ""
currentPos = 1
oldStrPos = 0
SubstNoReg = ""
skip = Len(oldStr)
Do While currentPos <= Len(initialStr)
oldStrPos = InStr(currentPos, initialStr, oldStr)
If oldStrPos = 0 Then
SubstNoReg = SubstNoReg & Mid(initialStr, currentPos, Len(initialStr) - currentPos + 1)
currentPos = Len(initialStr) + 1
Else
SubstNoReg = SubstNoReg & Mid(initialStr, currentPos, oldStrPos - currentPos) & newStr
currentPos = oldStrPos + skip
End If
Loop
End If
End Function
Function GetRnd(lowerNum,upperNum)
Dim unit,RndNum,Fun_X
unit = upperNum - lowerNum
Redim MyArray(unit)
For Fun_I=0 To unit
myArray(Fun_I)= lowerNum + Fun_I
Next
For Fun_I=0 To round(unit)
RndNum = getRndNumber(Fun_I,unit)
Fun_X = myArray(RndNum)
myArray(RndNum)=myArray(Fun_I)
myArray(Fun_I)=Fun_X
Next
GetRnd = Join(myArray)
End Function
Function getRndNumber(lowerbound,upperbound)
Randomize
getRndNumber=Int((upperbound-lowerbound+1)*Rnd+lowerbound)
End Function
Function GetFileName(strSaveToPath, FileName)
dim dtNow,ranNum
dtNow=Now()
GetFileName=year(dtNow) & right("0" & month(dtNow),1) & right("0" & day(dtNow),1) & right("0" & hour(dtNow),1) & right("0" & minute(dtNow),1) & right("0" & second(dtNow),2) & getRndNumber(1000,9999)
Response.Write(GetFileName & Right(FileName,4))
GetFileName = strSaveToPath & "\" & GetFileName & Right(FileName,4)
End Function
'******************************************************************
'CheckFileType 函数用来检查文件是否为图片文件
'参数filename是本地文件的路径
'如果是文件jpeg,gif,bmp,png图片中的一种,函数返回true,否则返回false
'******************************************************************
const adTypeBinary=1
dim jpg(1):jpg(0)=CByte(&HFF):jpg(1)=CByte(&HD8)
dim bmp(1):bmp(0)=CByte(&H42):bmp(1)=CByte(&H4D)
dim png(3):png(0)=CByte(&H89):png(1)=CByte(&H50):png(2)=CByte(&H4E):png(3)=CByte(&H47)
dim gif(5):gif(0)=CByte(&H47):gif(1)=CByte(&H49):gif(2)=CByte(&H46):gif(3)=CByte(&H39):gif(4)=CByte(&H38):gif(5)=CByte(&H61)
function CheckFileType(filename)
on error resume next
CheckFileType=false
filename=LCase(filename)
dim fstream,fileExt,stamp,i
fileExt=mid(filename,InStrRev(filename,".")+1)
set fstream=Server.createobject("ADODB.Stream")
fstream.Open
fstream.Type=adTypeBinary
fstream.LoadFromFile filename
fstream.position=0
select case fileExt
case "jpg","jpeg"
stamp=fstream.read(2)
for i=0 to 1
if ascB(MidB(stamp,i+1,1))=jpg(i) then CheckFileType=true else CheckFileType=false
next
case "gif"
stamp=fstream.read(6)
for i=0 to 5
if ascB(MidB(stamp,i+1,1))=gif(i) then CheckFileType=true else CheckFileType=false
next
case "png"
stamp=fstream.read(4)
for i=0 to 3
if ascB(MidB(stamp,i+1,1))=png(i) then CheckFileType=true else CheckFileType=false
next
case "bmp"
stamp=fstream.read(2)
for i=0 to 1
if ascB(MidB(stamp,i+1,1))=bmp(i) then CheckFileType=true else CheckFileType=false
next
end select
fstream.Close
set fseteam=nothing
if err.number<>0 then CheckFileType=false
end function
%>
点上传后接收的文件upload.asp,这里我们把文件上传到文件夹upload
<%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%>
<!-- #include file="uploader.asp" -->
<%
Response.Expires = -1
Server.ScriptTimeout = 600
Set Upload = New Uploader
Upload.Save(Server.MapPath("upload"))
Response.Write("<HTML><HEAD></HEAD><BODY>成功</BODY></HTML>")
%>
前台HMTL代码如下:
<link rel="Stylesheet" href="uploadify.css" />
<script src="http://ajax.googleapis.com/ajax/libs/jquery/1.4.2/jquery.min.js" type="text/javascript"></script>
<script type="text/javascript" src="swfobject.js"></script>
<script type="text/javascript" src="jquery.uploadify.v2.1.0.js"></script>
<script language="javascript" type="text/javascript">
$(document).ready(function() {
$("#uploadify").uploadify({
'uploader': 'uploadify.swf',
'script': 'upload.asp',
'cancelImg': 'cancel.png',
'folder': 'upload',
'queueID': 'fileQueue',
'auto': false,
'multi': true,
'method':'post'
});
});
</script>
</head>
<body>
<form id="form1" enctype="multipart/form-data" >
<input type="file" name="uploadify" id="uploadify" />
<a href="javascript:$('#uploadify').uploadifyUpload()">上传</a>| <a href="javascript:$('#uploadify').uploadifyClearQueue()"> 取消上传</a>
<div id="fileQueue"></div>
</form>
</body>
如果需要限制上传类型,可以加入以下参数:
'fileDesc' : 'rar文件或zip文件',
'fileExt' : '*.rar;*.zip'
效果如下,选择图片的时候只能选择符合条件的图片了。
实际使用中我们经常要拿到重新生成后的文件名,赋值到一个隐藏文本框中好存进数据库,uploadify提供了一个函数非常好onComplete,看下代码:
$(document).ready(function() {
$("#uploadify").uploadify({
'uploader': 'uploadify.swf',
'script': 'upload.asp',
'cancelImg': 'cancel.png',
'folder': 'upload',
'queueID': 'fileQueue',
'auto': false,
'multi': true,
'method':'post',
onComplete:function(event,queueID,fileObj,response,data){
alert(response);
},
});
});
response是返回的值,没错,看到这里,我们需要在刚才那个upload.asp中输出上传后的文件名。这个需要修改那个uploader.asp,我加上了按日期命名,让图片的命名更符合实际使用,从压缩包从下载吧!
完整代码下载:点击下载
我要评论