asp 无组件文件上传代码

YPE html PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN" "http://www.**w*3.org/TR/REC-html40/loose.dtd">

css" type="text/css">

fuptype=session("fuptype")'上传类型
fupname=session("fupname")'文件名
frmname=session("frmname")'form名
bdname=session("bdname") '表单名
if fuptype="" or fupname="" or frmname="" then
response.write ""
response.end
end if
%>

set upload=new upload_5xsoft
set file=upload.file("file1")
if file.fileSize>0 then
filename=fupname+"."
filenameend=file.filename
filenameend=split(filenameend,".")
n=UBound(filenameend)
filename=filename&filenameend(n)
if fuptype"db" then
if file.fileSize>1572864 then
response.write ""
response.end
end if
end if
if fuptype="adv" or fuptype="pic" then
if LCase(filenameend(n))"gif" and LCase(filenameend(n))"jpg" and LCase(filenameend(n))"doc" and LCase(filenameend(n))"xls" and LCase(filenameend(n))"rar" and LCase(filenameend(n))"zip" and LCase(filenameend(n))"txt" then
response.write ""
response.end
end if
end if
if fuptype="pic" then
savepath="../pic_1/"&filename
end If

file.saveAs Server.mappath(savepath)
'response.write "文件上传成功!上传文件的物理路径为："
'response.write ""&Server.mappath(savepath)&"

"
'response.write ""
'response.write "

"
response.write ""

%>
else
response.write ""
response.end
end if
set upload=nothing
session("fuptype")=""
session("fupname")=""
session("frmname")=""
%>

下面是upload_5xsoft.inc文件直接下载保存这段代码

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_5xSoft_Stream.Position=theStart-1
stemp=""
for i=1 to theLen
if upfile_5xSoft_Stream.EOS then Exit for
c=ascB(upfile_5xSoft_Stream.Read(1))
If c > 127 Then
if upfile_5xSoft_Stream.EOS then Exit for
stemp=stemp&Chrw(AscW(ChrB(AscB(upfile_5xSoft_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_5xSoft_Stream.Size-theLen
if i>upfile_5xSoft_Stream.size then exit Function
upfile_5xSoft_Stream.Position=i-1
if AscB(upfile_5xSoft_Stream.Read(1))=AscB(midB(Str,1)) then
InString=i
for j=2 to theLen
if upfile_5xSoft_Stream.EOS then
inString=0
Exit for
end if
if AscB(upfile_5xSoft_Stream.Read(1))AscB(MidB(Str,j,1)) then
InString=0
Exit For
end if
next
if InString0 then Exit Function
end if
next
End Function

Private Sub Class_Terminate
form.RemoveAll
file.RemoveAll
set form=nothing
set file=nothing
upfile_5xSoft_Stream.close
set upfile_5xSoft_Stream=nothing
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 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_5xSoft_Stream.position=FileStart-1
upfile_5xSoft_Stream.copyto dr,FileSize
dr.SaveToFile FullPath,2
dr.Close
set dr=nothing
SaveAs=0
end function
End Class