,还算简单,你自己稍微修改一下设置就可以用:
---upload.asp---
<%
Dim Upfile_Kings_Stream
Class Upload_Kings
Dim Form,File
Private Sub Class_Initialize
Dim iStart,iFileNameStart,iFileNameEnd,iEnd,vbEnter,iFormStart,iFormEnd,theFile
Dim strDiv,mFormName,mFormValue,mFileName,mFileSize,mFilePath,iDivLen,mStr
Set Form=CreateObject("Scripting.Dictionary")
Set File=CreateObject("Scripting.Dictionary")
Set Upfile_Kings_Stream=CreateObject("Adodb.Stream")
Upfile_Kings_Stream.Mode=3
Upfile_Kings_Stream.Type=1
Upfile_Kings_Stream.Open
Upfile_Kings_Stream.Write Request.BinaryRead(Request.TotalBytes)
vbEnter=Chr(13)&Chr(10)
iDivLen=inString(1,vbEnter)+1
strDiv=subString(1,iDivLen)
iFormStart=iDivLen
iFormEnd=inString(iformStart,strDiv)-1
While iFormStart < iFormEnd
iStart=inString(iFormStart,"name=""")
iEnd=inString(iStart+6,"""")
mFormName=subString(iStart+6,iEnd-iStart-6)
iFileNameStart=inString(iEnd+1,"filename=""")
If iFileNameStart>0 And iFileNameStart
mFileName=subString(iFileNameStart+10,iFileNameEnd-iFileNameStart-10)
iStart=inString(iFileNameEnd+1,vbEnter&vbEnter)
iEnd=inString(iStart+4,vbEnter&strDiv)
If iEnd>iStart Then
mFileSize=iEnd-iStart-4
Else
mFileSize=0
End If
Set theFile=New FileInfo
theFile.FileName=getFileName(mFileName)
theFile.FileSize=mFileSize
theFile.FileStart=iStart+4
File.Add mFormName,theFile
End If
iFormStart=iformEnd+iDivLen
iFormEnd=inString(iformStart,strDiv)-1
Wend
End Sub
Private Function subString(theStart,theLen)
Dim i,c,stemp
Upfile_Kings_Stream.Position=theStart-1
stemp=""
For i=1 To theLen
If Upfile_Kings_Stream.EOS Then Exit For
c=ascB(Upfile_Kings_Stream.Read(1))
If c > 127 Then
If Upfile_Kings_Stream.EOS Then Exit For
stemp=stemp&Chr(AscW(ChrB(AscB(Upfile_Kings_Stream.Read(1)))&ChrB(c)))
i=i+1
Else
stemp=stemp&Chr(c)
End If
Next
subString=stemp
End Function
Private Function inString(theStart,varStr)
Dim i,j,bt,theLen,str
InString=0
Str=toByte(varStr)
theLen=LenB(Str)
For i=theStart To Upfile_Kings_Stream.Size-theLen
If i>Upfile_Kings_Stream.Size Then Exit Function
Upfile_Kings_Stream.Position=i-1
If AscB(Upfile_Kings_Stream.Read(1))=AscB(midB(Str,1)) Then
InString=i
For j=2 To theLen
If Upfile_Kings_Stream.EOS Then
inString=0
Exit for
End If
If AscB(Upfile_Kings_Stream.Read(1))<>AscB(MidB(Str,j,1)) Then
InString=0
Exit For
End if
Next
If InString<>0 Then Exit Function
End If
Next
End Function
Private Function GetFileName(FullPath)
If FullPath <> "" Then
GetFileName = Mid(FullPath,InStrRev(FullPath, "\")+1)
Else
GetFileName = ""
End If
End Function
Private Function toByte(Str)
Dim i,iCode,c,iLow,iHigh
toByte=""
For i=1 To Len(Str)
c=Mid(Str,i,1)
iCode =Asc(c)
If iCode<0 Then iCode = iCode + 65535
If iCode>255 Then
iLow = Left(Hex(Asc(c)),2)
iHigh =Right(Hex(Asc(c)),2)
toByte = toByte & chrB("&H"&iLow) & chrB("&H"&iHigh)
Else
toByte = toByte & chrB(AscB(c))
End If
Next
End function
End Class
Class FileInfo
Dim FormName,FileName,FilePath,FileSize,FileStart
Private Sub Class_Initialize
FileName = ""
FilePath = ""
FileSize = 0
FileStart= 0
FormName = ""
End Sub
Public Function SaveAs(FullPath)
dim dr,ErrorChar,i
SaveAs=1
If trim(fullpath)="" or FileSize=0 or FileStart=0 or FileName="" Then Exit Function
If FileStart=0 or right(fullpath,1)="/" Then Exit Function
Set dr=CreateObject("Adodb.Stream")
dr.Mode=3
dr.Type=1
dr.Open
Upfile_Kings_Stream.Position=FileStart-1
Upfile_Kings_Stream.Copyto dr,FileSize
dr.SaveToFile FullPath,2
dr.Close
Set dr=Nothing
SaveAs=0
End Function
End Class
%>
---uploadfile.asp---
<%
Dim AffixSize,AffixType,FilePath
AffixSize=100 '设置上传文件大小,单位为K
AffixType=".swf" '设置上传文件格式,用“|”分隔
Server.ScriptTimeOut=5000 '超时设置
FilePath="UploadFiles" '设置上传文件的目录
If Request("action")="saveupload" Then
Dim Affix,i
Dim Upload,File,Fso
Dim formName,FileName,FileType,FileSize,TotalBytes,ErrorType,ranNum,FullPath
Set Upload=New Upload_Kings
For Each formName In Upload.File
Set File=Upload.File(formName)
FileName=File.FileName
FileType=Lcase(Mid(FileName,InStrRev(FileName, ".")))
Affix=Split(AffixType,"|")
For i = 0 To UBound(Affix)
If FileType=Affix(i) Then
ErrorType=0
Exit For
Else
ErrorType=1
End If
Next
If ErrorType=1 Then
Response.Write("文件格式错误!")
Response.End
End If
FileSize=File.FileSize
If FileSize<1 Then
Response.Write("请先选择你要上传的文件!")
Response.End
End If
If FileSize>AffixSize*1024 Then
Response.Write("文件大小不得超过 "&AffixSize&" K\n当前的文件大小为 "&Int(FileSize/1024)&" K")
Response.End
End If
FullPath=Server.Mappath(FilePath)
Set Fso=Server.CreateObject("Scripting.FileSystemObject")
If Not Fso.FolderExists(FullPath) Then Fso.CreateFolder(FullPath)
Set Fso=Nothing
'Randomize
'ranNum=Int(9000*Rnd)+1000
'FileName=Year(Now)&Month(Now)&Day(Now)&Hour(Now)&Minute(Now)&Second(Now)&ranNum&FileType
File.SaveAs FullPath&"\"&FileName
Set File=Nothing
Next
Set Upload=Nothing
Response.Write "上传成功
查看文件 继续上传"
Response.End
End If
%>
应该是服务器网速太慢,导致上传过程中断
一般的服务器上传2M以下的文件问题较少。
是不是你的那个文件夹没有上传权限呢。