① 求asp無組件上傳圖片代碼 100分懸賞
ASP無組件上傳圖片源代碼
<%
'上傳方法，0＝無組件，1＝chinaaspupload
dim upload_type
upload_type=upload
dim uploadsuc
dim Forumupload
dim ranNum
dim uploadfiletype
dim upload,file,formName,formPath,iCount,filename,fileExt
response.write "<body leftmargin=0 topmargin=0>"
select case upload_type
case 0
call upload_0()
case 1
call upload_1()
case else
response.write "本系統未開放插件功能"
response.end
end select
sub upload_0()
set upload=new upload_5xSoft ''建立上傳對象
formPath=upload.form("filepath")
''在目錄後加(/)
if right(formPath,1)<>"/" then formPath=formPath&"/"
response.write "<body leftmargin=5 topmargin=3>"
for each formName in upload.file ''列出所有上傳了的文件
set file=upload.file(formName) ''生成一個文件對象
if file.filesize<100 then
response.write "<span style=""font-family: 宋體; font-size: 9pt"">請先選擇你要上傳的圖片 [ <a href=# onclick=history.go(-1)>重新上傳</a> ]</span>"
response.end
end if
if file.filesize>1024000 then
response.write "<span style=""font-family: 宋體; font-size: 9pt"">圖片大小超過了限制 [ <a href=# onclick=history.go(-1)>重新上傳</a> ]</span>"
response.end
end if
fileExt=lcase(getFileExtName(file.fileName))
if fileext<>"jpg" and fileext<>"png" and fileext<>"gif" and fileext<>"bmp" then
response.write "<span style=""font-family: 宋體; font-size: 9pt"">該文件格式不允許上傳 [ <a href=# onclick=history.go(-1)>重新上傳</a> ]</span>"
response.end
end if
randomize
rannum=int(90000*rnd)+10000
filename=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(formPath &filename) ''保存文件
response.write "<script>parent.document.FrmAddLink.photo.value='uploadfile/face/"&FileName&"'</script>"
end if
set file=nothing
next
set upload=nothing
Htmend iCount&" 個文件上傳結束!"
end sub
sub HtmEnd(Msg)
response.write "<span style=""font-family: 宋體; font-size: 9pt"">圖片上傳成功 [ <a href=# onclick=history.go(-1)>重新上傳</a> ]</span>"
response.end
end sub
sub upload_1()
set FileUp=server.createobject("ChinaASP.UpLoad") ''建立上傳對象
filepath=server.MapPath("../uploadfile/face/")
response.write "<body leftmargin=5 topmargin=3>"
for each f in fileup.Files ''列出所有上傳了的文件
if f.filesize<100 then
response.write "<span style=""font-family: 宋體; font-size: 9pt"">請先選擇你要上傳的圖片 [ <a href=# onclick=history.go(-1)>重新上傳</a> ]</span>"
response.end
end if
if f.filesize>1024000 then
response.write "<span style=""font-family: 宋體; font-size: 9pt"">圖片大小超過了限制 [ <a href=# onclick=history.go(-1)>重新上傳</a> ]</span>"
response.end
end if
fileExt=lcase(getFileExtName(f.fileName))
if fileext<>"jpg" and fileext<>"png" and fileext<>"gif" and fileext<>"bmp" then
response.write "<span style=""font-family: 宋體; font-size: 9pt"">該文件格式不允許上傳 [ <a href=# onclick=history.go(-1)>重新上傳</a> ]</span>"
response.end
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 f.FileSize>0 then ''如果 FileSize > 0 說明有文件數據
f.saveas filePath & "\"&filename ''保存文件
response.write "<script>parent.document.FrmAddLink.photo.value='uploadfile/face/"&FileName&"'</script>"
end if
set f=nothing
next
set FileUp=nothing
Htmend iCount&" 個文件上傳結束!"
end sub
sub HtmEnd(Msg)
response.write "<span style=""font-family: 宋體; font-size: 9pt"">圖片上傳成功 [ <a href=# onclick=history.go(-1)>重新上傳</a> ]</span>"
response.end
end sub
%>
② 高分求ASP上傳文件代碼
不多說了，我把源碼傳上網了，你可以打開 http://tonv.b67.53dns.cn 傳文件看看是不是你要的效果。 http://tonv.b67.53dns.cn/view.asp 是文件顯示頁面，我已經把源碼打包傳上去了，編號16的就是，直接點「點擊打開」就可以下載
補充：第一個提交是上傳文件的提交，此時提交後文件會被成功上傳且把路徑和文件名寫入到<input name="content">這個文本域內，也就是你提交到資料庫的欄位
第二個提交是提交index.asp表單的，也就是你自己要提交到資料庫里的表單。簡而言之只要你將代碼弄好了，這個提交就會保存文件名到資料庫，存入資料庫後要顯示文件名和路徑就可以調用<%=rs("content")>，content是你資料庫存放上傳文件名和路徑的欄位名！你再試試，不會我發完整源碼給你，你如果想上傳的時候同時提交到資料庫可以在upload.asp頁面用個隱藏表單。
另外第一個文本域是我測試的時候上傳到資料庫的另外一個欄位title，可以不用管，關鍵部分在第二個文本域，是取得上傳文件名和路徑的欄位
****************************************************************
嘿，都是騙分的嚒，看清楚了樓主要顯示上傳文件名並寫入資料庫，沒問題，看我的： (有四個asp文件，別把代碼復制到一個頁面中了，有什麼問題請補充！如果還不會請告訴我，我把源碼打包發給你！)
UpLoadClass.asp，主要上傳程序，代碼如下：
<%
Class UpLoadClass
Private p_MaxSize,p_TotalSize,p_FileType,p_SavePath,p_AutoSave,p_Error
Private objForm,binForm,binItem,strDate,lngTime
Public FormItem,FileItem
Public Property Get Version
Version="Rumor UpLoadClass Version 2.0B"
End Property
Public Property Get Error
Error=p_Error
End Property
Public Property Get MaxSize
MaxSize=p_MaxSize
End Property
Public Property Let MaxSize(lngSize)
if isNumeric(lngSize) then
p_MaxSize=clng(lngSize)
end if
End Property
Public Property Get TotalSize
TotalSize=p_TotalSize
End Property
Public Property Let TotalSize(lngSize)
if isNumeric(lngSize) then
p_TotalSize=clng(lngSize)
end if
End Property
Public Property Get FileType
FileType=p_FileType
End Property
Public Property Let FileType(strType)
p_FileType=strType
End Property
Public Property Get SavePath
SavePath=p_SavePath
End Property
Public Property Let SavePath(strPath)
p_SavePath=replace(strPath,chr(0),"")
End Property
Public Property Get AutoSave
AutoSave=p_AutoSave
End Property
Public Property Let AutoSave(byVal Flag)
select case Flag
case 0:
case 1:
case 2:
case false:Flag=2
case else:Flag=0
end select
p_AutoSave=Flag
End Property
Private Sub Class_Initialize
p_Error = -1
p_MaxSize = 153600
p_FileType = "jpg/gif"
p_SavePath = ""
p_AutoSave = 0
p_TotalSize= 0
strDate = replace(cstr(Date()),"-","")
lngTime = clng(timer()*1000)
Set binForm = Server.CreateObject("ADODB.Stream")
Set binItem = Server.CreateObject("ADODB.Stream")
Set objForm = Server.CreateObject("Scripting.Dictionary")
objForm.CompareMode = 1
End Sub
Private Sub Class_Terminate
objForm.RemoveAll
Set objForm = nothing
Set binItem = nothing
if p_Error<>4 then binForm.Close()
Set binForm = nothing
End Sub
Public Sub Open()
if p_Error=-1 then
p_Error=0
else
Exit Sub
end if
Dim lngRequestSize,binRequestData,strFormItem,strFileItem
Const strSplit="'"">"
lngRequestSize=Request.TotalBytes
if lngRequestSize<1 or (lngRequestSize>p_TotalSize and p_TotalSize<>0) then
p_Error=4
Exit Sub
end if
binRequestData=Request.BinaryRead(lngRequestSize)
binForm.Type = 1
binForm.Open
binForm.Write binRequestData
Dim bCrLf,strSeparator,intSeparator
bCrLf=ChrB(13)&ChrB(10)
intSeparator=InstrB(1,binRequestData,bCrLf)-1
strSeparator=LeftB(binRequestData,intSeparator)
Dim p_start,p_end,strItem,strInam,intTemp,strTemp
Dim strFtyp,strFnam,strFext,lngFsiz
p_start=intSeparator+2
Do
p_end =InStrB(p_start,binRequestData,bCrLf&bCrLf)+3
binItem.Type=1
binItem.Open
binForm.Position=p_start
binForm.CopyTo binItem,p_end-p_start
binItem.Position=0
binItem.Type=2
binItem.Charset="gb2312"
strItem=binItem.ReadText
binItem.Close()
p_start=p_end
p_end =InStrB(p_start,binRequestData,strSeparator)-1
binItem.Type=1
binItem.Open
binForm.Position=p_start
lngFsiz=p_end-p_start-2
binForm.CopyTo binItem,lngFsiz
intTemp=Instr(39,strItem,"""")
strInam=Mid(strItem,39,intTemp-39)
if Instr(intTemp,strItem,"filename=""")<>0 then
if not objForm.Exists(strInam&"_From") then
strFileItem=strFileItem&strSplit&strInam
if binItem.Size<>0 then
intTemp=intTemp+13
strFtyp=Mid(strItem,Instr(intTemp,strItem,"Content-Type: ")+14)
strTemp=Mid(strItem,intTemp,Instr(intTemp,strItem,"""")-intTemp)
intTemp=InstrRev(strTemp,"\")
strFnam=Mid(strTemp,intTemp+1)
objForm.Add strInam&"_Type",strFtyp
objForm.Add strInam&"_Name",strFnam
objForm.Add strInam&"_Path",Left(strTemp,intTemp)
objForm.Add strInam&"_Size",lngFsiz
if Instr(intTemp,strTemp,".")<>0 then
strFext=Mid(strTemp,InstrRev(strTemp,".")+1)
else
strFext=""
end if
if left(strFtyp,6)="image/" then
binItem.Position=0
binItem.Type=1
strTemp=binItem.read(10)
if strcomp(strTemp,chrb(255) & chrb(216) & chrb(255) & chrb(224) & chrb(0) & chrb(16) & chrb(74) & chrb(70) & chrb(73) & chrb(70),0)=0 then
if Lcase(strFext)<>"jpg" then strFext="jpg"
binItem.Position=3
do while not binItem.EOS
do
intTemp = ascb(binItem.Read(1))
loop while intTemp = 255 and not binItem.EOS
if intTemp < 192 or intTemp > 195 then
binItem.read(Bin2Val(binItem.Read(2))-2)
else
Exit do
end if
do
intTemp = ascb(binItem.Read(1))
loop while intTemp < 255 and not binItem.EOS
loop
binItem.Read(3)
objForm.Add strInam&"_Height",Bin2Val(binItem.Read(2))
objForm.Add strInam&"_Width",Bin2Val(binItem.Read(2))
elseif strcomp(leftB(strTemp,8),chrb(137) & chrb(80) & chrb(78) & chrb(71) & chrb(13) & chrb(10) & chrb(26) & chrb(10),0)=0 then
if Lcase(strFext)<>"png" then strFext="png"
binItem.Position=18
objForm.Add strInam&"_Width",Bin2Val(binItem.Read(2))
binItem.Read(2)
objForm.Add strInam&"_Height",Bin2Val(binItem.Read(2))
elseif strcomp(leftB(strTemp,6),chrb(71) & chrb(73) & chrb(70) & chrb(56) & chrb(57) & chrb(97),0)=0 or strcomp(leftB(strTemp,6),chrb(71) & chrb(73) & chrb(70) & chrb(56) & chrb(55) & chrb(97),0)=0 then
if Lcase(strFext)<>"gif" then strFext="gif"
binItem.Position=6
objForm.Add strInam&"_Width",BinVal2(binItem.Read(2))
objForm.Add strInam&"_Height",BinVal2(binItem.Read(2))
elseif strcomp(leftB(strTemp,2),chrb(66) & chrb(77),0)=0 then
if Lcase(strFext)<>"bmp" then strFext="bmp"
binItem.Position=18
objForm.Add strInam&"_Width",BinVal2(binItem.Read(4))
objForm.Add strInam&"_Height",BinVal2(binItem.Read(4))
end if
end if
objForm.Add strInam&"_Ext",strFext
objForm.Add strInam&"_From",p_start
intTemp=GetFerr(lngFsiz,strFext)
if p_AutoSave<>2 then
objForm.Add strInam&"_Err",intTemp
if intTemp=0 then
if p_AutoSave=0 then
strFnam=GetTimeStr()
if strFext<>"" then strFnam=strFnam&"."&strFext
end if
binItem.SaveToFile Server.MapPath(p_SavePath&strFnam),2
objForm.Add strInam,strFnam
end if
end if
else
objForm.Add strInam&"_Err",-1
end if
end if
else
binItem.Position=0
binItem.Type=2
binItem.Charset="gb2312"
strTemp=binItem.ReadText
if objForm.Exists(strInam) then
objForm(strInam) = objForm(strInam)&","&strTemp
else
strFormItem=strFormItem&strSplit&strInam
objForm.Add strInam,strTemp
end if
end if
binItem.Close()
p_start = p_end+intSeparator+2
loop Until p_start+3>lngRequestSize
FormItem=split(strFormItem,strSplit)
FileItem=split(strFileItem,strSplit)
End Sub
Private Function GetTimeStr()
lngTime=lngTime+1
GetTimeStr=strDate&lngTime
End Function
Private Function GetFerr(lngFsiz,strFext)
dim intFerr
intFerr=0
if lngFsiz>p_MaxSize and p_MaxSize>0 then
if p_Error=0 or p_Error=2 then p_Error=p_Error+1
intFerr=intFerr+1
end if
if Instr(1,LCase("/"&p_FileType&"/"),LCase("/"&strFext&"/"))=0 and p_FileType<>"" then
if p_Error<2 then p_Error=p_Error+2
intFerr=intFerr+2
end if
GetFerr=intFerr
End Function
Public Function Save(Item,strFnam)
Save=false
if objForm.Exists(Item&"_From") then
dim intFerr,strFext
strFext=objForm(Item&"_Ext")
intFerr=GetFerr(objForm(Item&"_Size"),strFext)
if objForm.Exists(Item&"_Err") then
if intFerr=0 then
objForm(Item&"_Err")=0
end if
else
objForm.Add Item&"_Err",intFerr
end if
if intFerr<>0 then Exit Function
if VarType(strFnam)=2 then
select case strFnam
case 0:strFnam=GetTimeStr()
if strFext<>"" then strFnam=strFnam&"."&strFext
case 1:strFnam=objForm(Item&"_Name")
end select
end if
binItem.Type = 1
binItem.Open
binForm.Position = objForm(Item&"_From")
binForm.CopyTo binItem,objForm(Item&"_Size")
binItem.SaveToFile Server.MapPath(p_SavePath&strFnam),2
binItem.Close()
if objForm.Exists(Item) then
objForm(Item)=strFnam
else
objForm.Add Item,strFnam
end if
Save=true
end if
End Function
Public Function GetData(Item)
GetData=""
if objForm.Exists(Item&"_From") then
if GetFerr(objForm(Item&"_Size"),objForm(Item&"_Ext"))<>0 then Exit Function
binForm.Position = objForm(Item&"_From")
GetData=binFormStream.Read(objForm(Item&"_Size"))
end if
End Function
Public Function Form(Item)
if objForm.Exists(Item) then
Form=objForm(Item)
else
Form=""
end if
End Function
Private Function BinVal2(bin)
dim lngValue,i
lngValue = 0
for i = lenb(bin) to 1 step -1
lngValue = lngValue *256 + ascb(midb(bin,i,1))
next
BinVal2=lngValue
End Function
Private Function Bin2Val(bin)
dim lngValue,i
lngValue = 0
for i = 1 to lenb(bin)
lngValue = lngValue *256 + ascb(midb(bin,i,1))
next
Bin2Val=lngValue
End Function
End Class
%>
****************************************************
upload.asp 上傳設置與調用文件，代碼如下：
<!--#include FILE="UpLoadClass.asp"-->
<%
dim request2,ming
'建立上傳對象
set request2=New UpLoadClass
'上傳總大小為20M
request2.TotalSize= 20971520
'單文件最大10M
request2.MaxSize = 10485760
'允許上傳的文件格式
request2.FileType = "rar/zip/jpg"
'設置上傳文件的目錄，使用相對路徑，注意設置的目錄要存在，不然會出錯，如果為設置為空則文件上傳於根目錄下
request2.SavePath="upload/"
request2.open()
'設置ming這個變數等於上傳文件的路徑和文件名
ming = request2.SavePath&request2.Form("strFile1")
'在提交資料庫頁面把文件路徑和文件名寫入表單以供提交
response.write "<script>parent.document.form1.content.value='" & ming & "'</script>"
%>
*************************************************
up.asp，上傳提交表單頁面，代碼如下
<form action="upload.asp" method="post" enctype="multipart/form-data" name="form">
<input type="file" name="strFile1" id="strFile1">
<input type="submit" name="Submit" value="提交">
</form>
*************************************************
index.asp 你自己的提交頁面，我只寫表單部分的代碼
<form name="form1" method="POST" action="">
<input name="title" type="text" id="title">
<br><br>
<input name="content" type="text" id="content">
<br><iframe src="up.asp" name="up" width="300" marginwidth="0" height="30" marginheight="0" align="middle" scrolling="no" frameborder="0"></iframe>
<input type="submit" name="Submit" value="上傳">
<br>
<input type="hidden" name="MM_insert" value="form1">
</form>
OK，完工了，這里用的是風聲無組件上傳，根據你的需要修改成你要的版本，還可以多文件上傳的，你可以下一個風聲的源碼研究看看
另外，程序的主要你要的部分就是upload.asp中的：response.write "<script>parent.document.form1.content.value='" & ming & "'</script>" 這個是把上傳得到的文件名和路徑寫入你要提交的表單，還有你自己的頁面要用<iframe>調用up.asp。還有什麼不懂的可以QQ問我:54660142
③ 如何在asp中使用無組件上傳文件！
2個文件
第一個文件：
<html>
<body>
<center>
<form name="mainForm" enctype="multipart/form-data" action="process.asp" method=post>
<input type=file name=mefile><br>
<input type=submit name=okvalue="OK">
</form>
</center>
</body>
</html>
第二個：
<%
sub pic()
if Request.QueryString("submit")="pic" then
uploadpath="image/face/"
uploadsize="2048"
uploadtype="jpg/gif/png/bmp"
Set Uprequest=new UpLoadClass
Uprequest.SavePath=uploadpath
Uprequest.MaxSize=uploadsize*1024
Uprequest.FileType=uploadtype
AutoSave=true
Uprequest.open
if Uprequest.form("file_Err")<>0 then
select case Uprequest.form("file_Err")
case 1:str="<div style=""padding-top:5px;padding-bottom:5px;""> <font color=blue>上傳不成功!文件超過"&uploadsize&"k [<a href='javascript:history.go(-1)'>重新上傳</a>]</font></div>"
case 2:str="<div style=""padding-top:5px;padding-bottom:5px;""> <font color=blue>上傳不成功!文件格式不對 [<a href='javascript:history.go(-1)']>重新上傳</a>]</font></div>"
case 3:str="<div style=""padding-top:5px;padding-bottom:5px;""> <font color=blue>上傳不成功!文件太大且格式不對 [<a href='javascript:history.go(-1)'>重新上傳</a>]</font></div>"
end select
response.write str
else
response.write "<script language=""javascript"">parent.form2.pic.value='"&Uprequest.SavePath&Uprequest.Form("file")&"';"
response.write "</script>"
response.write "</script>"
size=Uprequest.Form("file_size")
showsize=size & " Byte"
if size>1024 then
size=(size\1024)
showsize=size & " KB"
end if
if size>1024 then
size=(size/1024)
showsize=formatnumber(size,2) & " MB"
end if
response.write "<script language=""javascript"">parent.form2.url.value='"&showsize&"';"
response.write "</script>"
response.write "<div style=""padding-top:5px;padding-bottom:5px;""> <font color=red>文件上傳成功</font> [<a href='javascript:history.go(-1)'>重新上傳</a>]</div>"
end if
Set Uprequest=nothing
end if
response.write "<form name=form action=?action=pic&submit=pic method=post enctype=multipart/form-data>"
response.write "<input type=file name=file class='tx' size='20'> "
response.write "<input type=submit name=submit value=上傳 class=""tx1"">"
response.write "</form>"
end sub
%>
④ asp代碼怎樣實現無組件上傳
一、無組件上傳的原理
我還是一點一點用一個實例來說明的吧，客戶端HTML如下。要瀏覽上傳附件，我們通過<input type="file">元素，但是一定要注意必須設置form的enctype屬性為"multipart/form-data"：
<form method="post" action="upload.asp" enctype="multipart/form-data">
<label>
<input type="file" name="file1" />
</label>
<input type="text" name="filename" value="default filename"/>
<input type="submit" value="Submit"/>
<input type="reset" value="Reset"/>
</form>
在後台asp程序中，以前獲取表單提交的ASCII 數據，非常的容易。但是如果需要獲取上傳的文件，就必須使用Request對象的BinaryRead方法來讀取。BinaryRead方法是對當前輸入流進行指定位元組數的二進制讀取，有點需要注意的是，一旦使用BinaryRead 方法後，再也不能使用Request.Form 或 Request.QueryString 集合了。結合Request對象的TotalBytes屬性，可以將所有表單提交的數據全部變成二進制，不過這些數據都是經過編碼的。首先讓我們來看看這些數據是如何編碼的，有無什麼規律可循，編段代碼，在代碼中我們將BinaryRead讀取的二進制轉化為文本，輸出出來，在後台的upload.asp中（注意該示例不要上傳大文件，否則可能會造成瀏覽器死掉）：
<%
Dim biData, PostData
Size = Request.TotalBytes
biData = Request.BinaryRead(Size)
PostData = BinaryToString(biData,Size)
Response.Write "<pre>" & PostData & "</pre>" '使用pre，原樣輸出格式
' 藉助RecordSet將二進制流轉化成文本
Function BinaryToString(biData,Size)
Const adLongVarChar = 201
Set RS = CreateObject("ADODB.Recordset")
RS.Fields.Append "mBinary", adLongVarChar, Size
RS.Open
RS.AddNew
RS("mBinary").AppendChunk(biData)
RS.Update
BinaryToString = RS("mBinary").Value
RS.Close
End Function
%>
⑤ ASP中上傳圖片怎麼做啊
採用無組件下載代碼。
upfile.asp
<% 'OPTION EXPLICIT%>
<!--#include FILE="upload_5xsoft.inc"-->
<%
dim upload,file,formName,formPath,iCount,MyFile
set upload=new upload_5xSoft ''建立上傳對象
formpath="userdata/" ''得到上傳目錄
nian=Year(Date)
yue=Month(Date)
ri=Day(Date)
if len(nian)<4 then nian="00"&nian
if len(yue)<2 then yue="0"&yue
if len(ri)<2 then ri="0"&ri
ipinit=""
ip=Request.ServerVariables("REMOTE_ADDR")
tmpip=Split(ip,".")
tmpipb=UBound(tmpip)
' ReDim ThisIP(tmpipb)
for i=0 to tmpipb
ThisIp=tmpip(i)
Do WHile len(ThisIP)<3
ThisIP="0"+ThisIP
loop
ipinit=ipinit+ThisIP
next
'Response.write nian&yue&ri&ipinit
'Response.end
for each formName in upload.file ''列出所有上傳了的文件
set file=upload.file(formName) ''生成一個文件對象
if file.FileSize>0 then ''如果 FileSize > 0 說明有文件數據
'MyFile=formPath&File.FileName
'MyFile=File.FileName
shi=Hour(time)
fen=Minute(Time)
Miao=Second(Time)
if len(shi)<2 then shi="0"&shi
if len(fen)<2 then fen="0"&fen
if len(miao)<2 then miao="0"&miao
MyFile=nian&yue&ri&shi&fen&miao&ipinit&".txt"
file.SaveAs Server.mappath(formPath&MyFile) ''保存文件
response.write file.FilePath&"#"&file.FileName&"#"&" ("&file.FileSize&") => "&MyFile&" 成功!<br>"
end if
set file=nothing
next
set upload=nothing ''刪除此對象
%>
upload_5xsoft.inc
<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT>
dim upfile_5xSoft_Stream
Class upload_5xSoft
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="HTTP上傳程序 Version 1.0"
if Request.TotalBytes<1 then Exit Sub
set Form=CreateObject("Scripting.Dictionary")
set File=CreateObject("Scripting.Dictionary")
set upfile_5xSoft_Stream=CreateObject("Adodb.Stream")
upfile_5xSoft_Stream.mode=3
upfile_5xSoft_Stream.type=1
upfile_5xSoft_Stream.open
upfile_5xSoft_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_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&Chr(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 InString<>0 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<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_5xSoft_Stream.position=FileStart-1
upfile_5xSoft_Stream.to dr,FileSize
dr.SaveToFile FullPath,2
dr.Close
set dr=nothing
SaveAs=0
end function
End Class
</SCRIPT>
⑥ 求asp有上傳進度條的無組件上傳代碼
艾恩Ajax無刷新上傳高級上傳實例
本上傳使用的類為本人原創上傳類,經修改後用於無刷新上傳(普通上傳同樣可用)
詳細顯示上傳過程,包括進度條，上傳百分比，總上傳數據大小，當前上傳數據大小，上傳進程時間等。。。
進度條樣式可自行修改，樣式文件為css.css
具體進程信息請查看js/custom.js中的getInformation(info)中的信息對象的說明
本次給上傳類增加了一個方法setApp,用來設置Application;
調用方法Upload.setApp state,total,current,description
參數說明:
state--當前狀態,建議取值請查看js/custom.js中的getInformation(info)函數中的狀態說明
total--總上傳數據大小
current--已上傳數據大小
description--描述,主要是在出現錯誤的時候使用，一般使用空值即可
請保留upload.asp中對Application的設置(共四處,最後一處可選擇性刪除)
下載 ： http://down.chinaz.com/soft/24892.htm
⑦ ASP 無組件上傳文件:怎麼把文件存在指定的文件夾里
在這個ASP上傳類中，一般會有一個Save或者SaveAs方法，參數是要保存的文件地址。如
myUpLoad.SaveAs "D:\FileUpload\Test.rar"
一般網上下載的ASP無組件下載類都附帶有一套簡單的示例文件，可以好好看看。