一个asp无组件上传的实例

答案：<% 
'判断是否添加了文件 
Dim ulFileName, ulResult 

ulSaveToPath="/upload" '保存文件路径 
ulMaxFileSize = 1000000 '文件大小限制 1000,000 

ulResult = DoUploadFile(ulMaxFileSize, ulFileName) 

Function DoUploadFile(MaxUpLoadSize, FileName) 
Dim Upload, File, formName, formPath, FileExt 
FileName = "" 
Set Upload = New upload_yfly '建立上传对象 

IF IsNull(Upload.File) THEN 
DoUploadFile= 6 
EXIT Function 
END IF 

IF Upload.File.Count = 0 Then 
DoUploadFile= 5 'No File uploaded 
Else 
Set File = Upload.File("ulFileToUpload") 
If File.FileName = "" Then 
DoUploadFile= 4 'No File uploaded 
Else 
'上传文件不是空的时候处理上传 
'在目录后加(/) 
formPath=upload.Form("ulSaveFilePath") 

If Right(formPath, 1) <> "/" Then 
formPath = formPath & "/" 
End If 

If File.FileSize < 100 Then 
DoUploadFile= 1 '文件大小太小 
Exit Function 
End If 

If File.FileSize > MaxUpLoadSize Then 
DoUploadFile= 2 '文件大小超过了限制 
Exit Function 
End If 

FileExt = LCase(Right(File.FileName, 4)) 
uploadsuc = False 

If Not (FileExt = ".gif" Or FileExt = ".jpg") Then 
DoUploadFile= 3 '文件格式不正确 
Exit Function 
End If 

Randomize 
ranNum = Int(90000 * Rnd) + 10000 
'文件名 
FileName = formPath & Year(Now) & Month(Now) & Day(Now) & Hour(Now) & Minute(Now) & Second(Now) & ranNum & FileExt 

If File.FileSize > 0 Then ''如果 FileSize > 0 说明有文件数据 
File.SaveAs server.mappath(FileName) ''保存文件 
End If 
DoUploadFile= 0 
End If 
Set File = Nothing 
End If 
Set Upload = Nothing '删除此对象 
End Function 

%> 


<SCRIPT RUNAT="SERVER" LANGUAGE="VBSCRIPT"> 

dim upfile_yfly_Stream 

Class upload_yfly 

dim Form,File,Version 

Private Sub Class_Initialize 
dim iStart,iFileNameStart,iFileNameEnd,iEnd,vbEnter,iFormStart,iFormEnd,theFile 
dim strDiv,mFormName,mFormValue,mFileName,mFileSize,mFilePath,iDivLen,mStr 
Version="" 
File = NULL 
Form = Null 
upfile_yfly_Stream=NULL 
if Request.TotalBytes<1 then Exit Sub 
set Form=CreateObject("Scripting.Dictionary") 
set File=CreateObject("Scripting.Dictionary") 
set upfile_yfly_Stream=CreateObject("Adodb.Stream") 
upfile_yfly_Stream.mode=3 
upfile_yfly_Stream.type=1 
upfile_yfly_Stream.open 
upfile_yfly_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<iFormEnd then 
iFileNameEnd=inString(iFileNameStart+10,"""") 
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.FilePath=getFilePath(mFileName) 
theFile.FileSize=mFileSize 
theFile.FileStart=iStart+4 
theFile.FormName=FormName 
file.add mFormName,theFile 
else 
iStart=inString(iEnd+1,vbEnter&vbEnter) 
iEnd=inString(iStart+4,vbEnter&strDiv) 

if iEnd>iStart then 
mFormValue=subString(iStart+4,iEnd-iStart-4) 
else 
mFormValue="" 
end if 
form.Add mFormName,mFormValue 
end if 

iFormStart=iformEnd+iDivLen 
iFormEnd=inString(iformStart,strDiv)-1 
wend 
End Sub 

Private Function subString(theStart,theLen) 
dim i,c,stemp 
upfile_yfly_Stream.Position=theStart-1 
stemp="" 
for i=1 to theLen 
if upfile_yfly_Stream.EOS then Exit for 
c=ascB(upfile_yfly_Stream.Read(1)) 
If c > 127 Then 
if upfile_yfly_Stream.EOS then Exit for 
stemp=stemp&Chr(AscW(ChrB(AscB(upfile_yfly_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_yfly_Stream.Size-theLen 
if i>upfile_yfly_Stream.size then exit Function 
upfile_yfly_Stream.Position=i-1 
if AscB(upfile_yfly_Stream.Read(1))=AscB(midB(Str,1)) then 
InString=i 
for j=2 to theLen 
if upfile_yfly_Stream.EOS then 
inString=0 
Exit for 
end if 
if AscB(upfile_yfly_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 Sub Class_Terminate 
if not isNull(Form) then 
form.RemoveAll 
set form=nothing 
end if 
if not isNull(File) then 
file.RemoveAll 
set file=nothing 
end if 
if not isNull(upfile_yfly_Stream) then 
upfile_yfly_Stream.close 
set upfile_yfly_Stream=nothing 
end if 
End Sub 


Private function GetFilePath(FullPath) 
If FullPath <> "" Then 
GetFilePath = left(FullPath,InStrRev(FullPath, "\")) 
Else 
GetFilePath = "" 
End If 
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_yfly_Stream.position=FileStart-1 
upfile_yfly_Stream.copyto dr,FileSize 
dr.SaveToFile FullPath,2 
dr.Close 
set dr=nothing 
SaveAs=0 
end function 
End Class 
</SCRIPT> 

上一个：利用@字符实现二级域名系统
下一个：最短的无组件上传代码（仅9行）