如何更改上传图片的名字

[wingcn]

图片上传后，文件写入数据库，图片传至IMG目录下。现在想用日期格式给图片命名，写入数据库的路径已经改成了日期格式，可图片的名字还是没更改过来，请高手帮忙赐教，万分感谢！


<---upload.asp--->
<%
Dim FormData, FormSize, Divider, bCrLf
FormSize = Request.TotalBytes
FormData = Request.BinaryRead(FormSize)
bCrLf = ChrB(13) & ChrB(10)
Divider = LeftB(FormData, InStrB(FormData, bCrLf) - 1)
Function SaveFile(FormFileField, Path, MaxSize, SavType)
Dim StreamObj,StreamObj1
Set StreamObj = Server.CreateObject("ADODB.Stream")
Set StreamObj1 = Server.CreateObject("ADODB.Stream")
StreamObj.Mode = 3
StreamObj1.Mode = 3
StreamObj.Type = 1
StreamObj1.Type = 1
SaveFile = ""
StartPos = LenB(Divider) + 2
FormFileField = Chr(34) & FormFileField & Chr(34)
If Right(Path,1) <> "\" Then
Path = Path & "\"
End If
Do While StartPos > 0
strlen = InStrB(StartPos, FormData, bCrLf) - StartPos
SearchStr = MidB(FormData, StartPos, strlen)
If InStr(bin2str(SearchStr), FormFileField) > 0 Then
FileName = bin2str(GetFileName(SearchStr,path,SavType))
If FileName <> "" Then
FileStart = InStrB(StartPos, FormData, bCrLf & bCrLf) + 4
FileLen = InStrB(StartPos, FormData, Divider) - 2 - FileStart
If FileLen <= MaxSize*1024 Then
FileContent = MidB(FormData, FileStart, FileLen)
StreamObj.Open
StreamObj1.Open
StreamObj.Write FormData
StreamObj.Position=FileStart-1
StreamObj.CopyTo StreamObj1,FileLen
If SavType =0 Then
SavType = 1
End If
StreamObj1.SaveToFile Path & FileName, SavType
StreamObj.Close
StreamObj1.Close
If SaveFile <> "" Then
SaveFile = SaveFile & "," & FileName
Else
SaveFile = FileName
End If
Else
If SaveFile <> "" Then
SaveFile = SaveFile & ",*TooBig*"
Else
SaveFile = "*TooBig*"
End If
End If
End If
End If
If InStrB(StartPos, FormData, Divider) < 1 Then
Exit Do
End If
StartPos = InStrB(StartPos, FormData, Divider) + LenB(Divider) + 2
Loop
End Function

Function GetFormVal(FormName)
GetFormVal = ""
StartPos = LenB(Divider) + 2
FormName = Chr(34) & FormName & Chr(34)
Do While StartPos > 0
strlen = InStrB(StartPos, FormData, bCrLf) - StartPos
SearchStr = MidB(FormData, StartPos, strlen)
If InStr(bin2str(SearchStr), FormName) > 0 Then
ValStart = InStrB(StartPos, FormData, bCrLf & bCrLf) + 4
ValLen = InStrB(StartPos, FormData, Divider) - 2 - ValStart
ValContent = MidB(FormData, ValStart, ValLen)
If GetFormVal <> "" Then
GetFormVal = GetFormVal & "," & bin2str(ValContent)
Else
GetFormVal = bin2str(ValContent)
End If
End If
If InStrB(StartPos, FormData, Divider) < 1 Then
Exit Do
End If
StartPos = InStrB(StartPos, FormData, Divider) + LenB(Divider) + 2
Loop
End Function

Function bin2str(binstr)
Dim varlen, clow, ccc, skipflag
skipflag = 0
ccc = ""
varlen = LenB(binstr)
For i = 1 To varlen
If skipflag = 0 Then
clow = MidB(binstr, i, 1)
If AscB(clow) > 127 Then
ccc = ccc & Chr(AscW(MidB(binstr, i + 1, 1) & clow))
skipflag = 1
Else
ccc = ccc & Chr(AscB(clow))
End If
Else
skipflag = 0
End If
Next
bin2str = ccc
End Function

Function str2bin(str)
For i = 1 To Len(str)
str2bin = str2bin & ChrB(Asc(Mid(str, i, 1)))
Next
End Function

Function GetFileName(str,path,savtype)
Set fs = Server.CreateObject("Scripting.FileSystemObject")
str = RightB(str,LenB(str)-InstrB(str,str2bin("filename="))-9)
GetFileName = ""
FileName = ""
For i = LenB(str) To 1 Step -1
If MidB(str, i, 1) = ChrB(Asc("\")) Then
FileName = MidB(str, i + 1, LenB(str) - i - 1)
Exit For
End If
Next
If savtype = 0 and fs.FileExists(path & bin2str(FileName)) = True Then
hFileName = FileName
rFileName = ""
For i = LenB(FileName) To 1 Step -1
If MidB(FileName, i, 1) = ChrB(Asc(".")) Then
hFileName = LeftB(FileName, i-1)
rFileName = RightB(FileName, LenB(FileName)-i+1)
Exit For
End If
Next
For i = 0 to 9999
'hFileName = hFileName & str2bin(i)
If fs.FileExists(path & bin2str(hFileName) & i & bin2str(rFileName)) = False Then
FileName = hFileName & str2bin(i) & rFileName
Exit For
End If
Next
End If
Set fs = Nothing
GetFileName = FileName
End Function
%>


<---chk.asp--->
<!--#include file="upload.asp"-->
<%
autoname=year(now)&month(now)&day(now)&hour(now)&minute(now)&second(now)
set rs=Server.CreateObject("adodb.recordset")
rs.Open "SELECT * FROM products",conn,1,3
path = Server.MapPath("./img/")
filename = SaveFile("img",path,6000,0)
if filename<>"" then
If filename <> "*TooBig*" Then
path1="img/"&autoname&".jpg"
'path1="img/"&filename
else
Response.write "<script>alert('图片过大!!!');history.back();</script>"
Response.end
end if
else
path1="img/none.jpg"
end if
rs.addnew
rs("img")=path1
%>

[whb147]

<!--#INCLUDE FILE="../data.asp" -->
<!--#INCLUDE FILE="../mouse.js" -->
<!--#INCLUDE FILE="..\function.asp" -->
<%

set rs=server.createobject("ADODB.recordset")
rs.Open "SELECT * FROM S_WenJianCunFang Where ID is null",conn,1,3
rs.addnew

application("downdir")="../download/YiQiSheBei/"
'if Session("Ulogin")<>"yes" then
'Response.Redirect ("index.htm")'end if
ip= Request.ServerVariables("REMOTE_ADDR")
nowtime=now()
sj=CStr(date())
'sj=cstr(year(nowtime))+"-"+cstr(month(nowtime))+"-"+cstr(day(nowtime))+" "+cstr(hour(nowtime))+":"+right("0"+cstr(minute(nowtime)),2)+":"+right("0"+cstr(second(nowtime)),2)
%>
<!--#include FILE="..\upload_5xsoft.inc"-->
<%
dim upload,file,formName,formPath,iCount
set upload=new upload_5xSoft ''建立上传对象
'--------将日期转化成文件名--------
function MakedownName()
dim fname
fname = now()
fname = replace(fname,"-","")
fname = replace(fname," ","")
fname = replace(fname,":","")
fname = replace(fname,"PM","")
fname = replace(fname,"AM","")
fname = replace(fname,"上午","")
fname = replace(fname,"下午","")
fname = int(fname) + int((10-1+1)*Rnd + 1)
MakedownName=fname
end function
formPath="../download/YiQiSheBei/"
id=upload.form("ShenGouMingCheng")
iCount=0
for each formName in upload.file ''列出所有上传了的文件
set file=upload.file(formName) ''生成一个文件对象
if file.FileSize>0 then ''如果 FileSize > 0 说明有文件数据
newname=MakedownName()&"."&mid(file.FileName,InStrRev(file.FileName, ".")+1)

file.SaveAs Server.mappath(formPath&newname) ''保存文件
iCount=iCount+1
else
response.write "未找到文件   <A HREF=javascript:history.back(1)>返回</A>"
response.end
end if

next

rs("ID") =upload.form("ShenGouMingCheng")
rs("FName") =file.FileName
rs("FExplain") = upload.form("WenJianShuoMing")
'rs("UpNmae") =
rs("LuJIng") =application("downdir")&newname
rs("IP")=ip
rs("SCTime")=sj
rs.Update
rs.close
Set rs=nothing
url=upload.form("url")
'response.write url

%>

[xieyj]

这么长的代码，不想看，能不能将名字不能改变的过程贴出来？

[whb147]

//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.copyto dr,FileSize
dr.SaveToFile FullPath,2
dr.Close
set dr=nothing
SaveAs=0
end function
End Class
</SCRIPT>

[whb147]

这个绝对能行，我就是用这个的，
结贴吧，呵呵]

[jiazhuo]

行，同意！

[nchen123]

用的着这么复杂么，用fso不就可以了

[topmonkey]

5xSoft的上传类在保存文件的时候直接就可以改名。

[wingcn]

不好意思5xSoft的无组件我不会用，也看不懂，我只是想在自己代码的基础上修改，谁能教我啊