批量上传 路径问题
<%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%><%
'on error resume next
db="/date/20096291446321816.asp"
connstr="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(DB)
set conn=server.createobject("ADODB.CONNECTION")
conn.open connstr
dim oUpFileStream
call wenjiansc("\") '这里可以设置存放目录
sub wenjiansc(a)
dim upload,file,formName,iCount,fileurl
if left(a,1)="\" then a=right(a,len(a)-1)
if right(a,1)<>"\" then a=a&"\"
if a="\" then a=""
set upload=new upload_5xSoft ''建立上传对象
bclass=upload.Form("bclass")
sclass=upload.Form("sclass")
nam=upload.Form("nam")
If nam="" then nam="默认分类"
for each formName in upload.file ''列出所有上传了的文件
set file=upload.file(formName) ''生成一个文件对象
filekzmzz=filekzm(file.FileName)
if filekzmzz="gif" or filekzmzz="jpg" or filekzmzz="jpeg" or filekzmzz="bmp" or filekzmzz="png" or filekzmzz="mp3" then
if file.FileSize>0 then ''如果 FileSize > 0 说明有文件数据
filenames="UploadFiles/"&Radom()
filename0="../"&filenames
RESPONSE.WRITE Server.mappath(filename0)
'file.SaveAs Server.mappath(a&filename0) ''保存文件
's="Insert Into honor(nam,about,pic,bclass,sclass) Values('"&nam&"','"&nam&"','"&filenames&"',"&bclass&","&sclass&")"
'conn.Execute("Insert Into honor(nam,about,pic,bclass,sclass) Values('"&nam&"','"&nam&"','"&filenames&"',"&bclass&","&sclass&")")
set file=nothing
end if
end if
next
'开始生成缩略图 并写入数据库
Set Jpeg = Server.CreateObject("Persits.Jpeg")
sql="select * from honor where bclass="&bclass&" and sclass="&sclass&" order by id desc"
set rs=server.createobject("adodb.recordset")
rs.open sql,conn,3,3
do while not rs.eof
n="UploadFiles/"&Radom()
p=server.MapPath("../"&rs("pic"))
Jpeg.Open p
Jpeg.Width = 217
Jpeg.Height = 145
Jpeg.Save server.MapPath("../"&n)
rs("pics")=n
rs.update
rs.movenext
loop
' Response.Write(s)
Response.Write("上传成功，生成缩略图成功。")
set upload=nothing
end sub
Function filekzm(textS)
dim p,ii,c
c=len(texts)
for ii=1 to 10
p=mid(texts,c-ii,1)
if p="." then
filekzm=lcase(mid(texts,c-ii+1,ii))
exit for
end if
next
end function
Function Radom()
Randomize
trnd = 1000 + Int(1000 * Rnd)
tdat = Now()
tyea = Year(tdat)
tmon = Month(tdat)
tday = Day(tdat)
thou = Hour(tdat)
tmin = Minute(tdat)
tsec = Second(tdat)
Radom = tyea&tmon&tday&thou&tmin&tsec&trnd&".jpg"
End Function
Class upload_5xSoft
dim Form,File,Version
Private Sub Class_Initialize
dim RequestBinDate,sStart,bCrLf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,oFileInfo
dim iFileSize,sFilePath,sFileType,sFormvalue,sFileName
dim iFindStart,iFindEnd
dim iFormStart,iFormEnd,sFormName
Version="无组件上传类"
set Form=Server.CreateObject("Scripting.Dictionary")
set File=Server.CreateObject("Scripting.Dictionary")
if Request.TotalBytes<1 then Exit Sub
set tStream = Server.CreateObject("adodb.stream")
set oUpFileStream = Server.CreateObject("adodb.stream")
oUpFileStream.Type = 1
oUpFileStream.Mode =3
oUpFileStream.Open
oUpFileStream.Write Request.BinaryRead(Request.TotalBytes)
oUpFileStream.Position=0
RequestBinDate =oUpFileStream.Read
iFormStart = 1
iFormEnd = LenB(RequestBinDate)
bCrLf = chrB(13) & chrB(10)
sStart = MidB(RequestBinDate,1, InStrB(iFormStart,RequestBinDate,bCrLf)-1)
iStart = LenB (sStart)
iFormStart=iFormStart+iStart+1
while (iFormStart + 10) < iFormEnd
iInfoEnd = InStrB(iFormStart,RequestBinDate,bCrLf & bCrLf)+3
tStream.Type = 1
tStream.Mode =3
tStream.Open
oUpFileStream.Position = iFormStart
oUpFileStream.CopyTo tStream,iInfoEnd-iFormStart
tStream.Position = 0
tStream.Type = 2
tStream.Charset ="utf-8"
sInfo = tStream.ReadText
'取得表单项目名称
iFormStart = InStrB(iInfoEnd,RequestBinDate,sStart)
iFindStart = InStr(22,sInfo,"name=""",1)+6
iFindEnd = InStr(iFindStart,sInfo,"""",1)
sFormName = Mid (sinfo,iFindStart,iFindEnd-iFindStart)
'如果是文件
if InStr (45,sInfo,"filename=""",1) > 0 then
set oFileInfo=new FileInfo
'取得文件名
iFindStart = InStr(iFindEnd,sInfo,"filename=""",1)+10
iFindEnd = InStr(iFindStart,sInfo,"""",1)
sFileName = Mid (sinfo,iFindStart,iFindEnd-iFindStart)
oFileInfo.FileName=getFileName(sFileName)
oFileInfo.FilePath=getFilePath(sFileName)
'取得文件类型
iFindStart = InStr(iFindEnd,sInfo,"Content-Type: ",1)+14
iFindEnd = InStr(iFindStart,sInfo,vbCr)
oFileInfo.FileType =Mid (sinfo,iFindStart,iFindEnd-iFindStart)
oFileInfo.FileStart =iInfoEnd
oFileInfo.FileSize = iFormStart -iInfoEnd -3
oFileInfo.FormName=sFormName
file.add sFormName,oFileInfo
else
'如果是表单项目
tStream.Close
tStream.Type =1
tStream.Mode =3
tStream.Open
oUpFileStream.Position = iInfoEnd
oUpFileStream.CopyTo tStream,iFormStart-iInfoEnd-3
tStream.Position = 0
tStream.Type = 2
tStream.Charset ="utf-8"
sFormvalue = tStream.ReadText
form.Add sFormName,sFormvalue
end if
tStream.Close
iFormStart=iFormStart+iStart+1
wend
RequestBinDate=""
set tStream =nothing
End Sub
Private Sub Class_Terminate
if not Request.TotalBytes<1 then
form.RemoveAll
file.RemoveAll
set form=nothing
set file=nothing
oUpFileStream.Close
set oUpFileStream =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
End Class
Class FileInfo
dim FormName,FileName,FilePath,FileSize,FileType,FileStart
Private Sub Class_Initialize
FileName = ""
FilePath = ""
FileSize = 0
FileStart= 0
FormName = ""
FileType = ""
End Sub
Public function SaveAs(FullPath)
dim oFileStream,ErrorChar,i
SaveAs=1
if trim(fullpath)="" or right(fullpath,1)="/" then exit function
set oFileStream=CreateObject("Adodb.Stream")
oFileStream.Type=1
oFileStream.Mode=3
oFileStream.Open
oUpFileStream.position=FileStart
oUpFileStream.copyto oFileStream,FileSize
oFileStream.SaveToFile FullPath,2
oFileStream.Close
set oFileStream=nothing
SaveAs=0
end function
End Class
Function filekzm(textS)
dim p,ii,c
c=len(texts)
for ii=1 to 10
p=mid(texts,c-ii,1)
if p="." then
filekzm=lcase(mid(texts,c-ii+1,ii))
exit for
end if
next
end function
function ObjTest(strObj)
on error resume next
ObjTest=false
set TestObj=server.CreateObject (strObj)
If -2147221005 <> Err then
ObjTest = True
end if
set TestObj=nothing
end function
%>
以上图片批量上传代码 upload.asp 放在根目录地下的时候能正常上传，可放到文件夹地下就无法上传了，
注 upload.asp 这个文件是在admin里面的。
我放置的目录是 根目录/xuni/zhanting/程序目录
程序目录包括文件和管理员目录admin admin里面有这个文件upload.asp
请问怎么样修改代码能让其不在根目录的情况下也能上传成功， 红色部分我都改过filenames="/zhanting/UploadFiles/"&Radom()
filenames="根目录/xuni/zhanting/UploadFiles/"&Radom() 这两种改了之后还是生成不了缩略图 大图也上传不成功。
望高手指点，急用。
