Private Sub Class_Initialize
dim iStart,iFileNameStart,iFileNameEnd,iEnd,vbEnter,iFormStart,iFormEnd,theFile
dim strDiv,mFormName,mFormValue,mFileName,mFileSize,mFilePath,iDivLen,mStr
Version=""
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
response.write "<body bgcolor='#f3f3f3'>"
dim upload,file,formName,formPath,iCount,filename,fileExt,info
set upload=new upload_5xSoft ''建立上传对象
formPath="../loupan_imgs/" ''文件上传后存放的目录
if right(formPath,1)<>"/" then formPath=formPath&"/"
iCount=0
for each formName in upload.file ''列出所有上传了的文件
set file=upload.file(formName) ''生成一个文件对象
info = "无标题"
if upload.form("info")<>"" then
info = upload.form("info") '''''''''''''''''''''关键所在××××××××××××××××
response.write info
end if
if file.filesize<100 then
response.write "<font size=2>请先选择你要上传的图片 [ <a href=# onclick=history.go(-1)>重新上传</a> ]</font>"
response.end
end if
if file.filesize>100000 then
response.write "<font size=2>图片大小超过了限制 [ <a href=# onclick=history.go(-1)>重新上传</a> ]</font>"
response.end
end if
fileExt=lcase(right(file.filename,4))
if fileEXT<>".gif" and fileEXT<>".jpg" then
response.write "<font size=2>文件格式不对 [ <a href=# onclick=history.go(-1)>重新上传</a> ]</font>"
response.end
end if
filename=formPath&year(now)&month(now)&day(now)&hour(now)&minute(now)&second(now)&file.FileName
filename1=year(now)&month(now)&day(now)&hour(now)&minute(now)&second(now)&file.FileName
if file.FileSize>0 then ''如果 FileSize > 0 说明有文件数据
file.SaveAs Server.mappath(filename) ''保存文件
iCount=iCount+1
end if
set file=nothing
next
set upload=nothing ''删除此对象
session("upface")="done"
Htmend iCount&" 个文件上传结束!"
sub HtmEnd(Msg)
set upload=nothing
response.write "<script>"
response.write "document.write('<font size=2>图片上传成功,</font>');"
response.write "</script>"
end sub
<%
Function str2bin(varstr)
str2bin=""
For i=1 To Len(varstr)
varchar=mid(varstr,i,1)
varasc = Asc(varchar)
' asc对中文字符求出来的值可能为负数,
' 加上65536就可求出它的无符号数值
' -1在机器内是用补码表示的0xffff,
' 其无符号值为65535,65535=-1+65536
' 其他负数依次类推。
If varasc<0 Then
varasc = varasc + 65535
End If
'对中文的处理:把双字节低位和高位分开
If varasc>255 Then
varlow = Left(Hex(Asc(varchar)),2)
varhigh = right(Hex(Asc(varchar)),2)
str2bin = str2bin & chrB("&H" & varlow) & chrB("&H" & varhigh)
Else
str2bin = str2bin & chrB(AscB(varchar))
End If
Next
End Function
Function bin2str(binstr)
Dim varlen,clow,ccc,skipflag
'中文字符Skip标志
skipflag=0
ccc = ""
If Not IsNull(binstr) Then
varlen=LenB(binstr)
For i=1 To varlen
If skipflag=0 Then
clow = MidB(binstr,i,1)
'判断是否中文的字符
If AscB(clow) > 127 Then
'AscW会把二进制的中文双字节字符高位和低位反转,所以要先把中文的高低位反转
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
End If
bin2str = ccc
End Function
%>
if newsid<>0 then
set conn=Server.CreateObject("ADODB.Connection")
conn.ConnectionString=conn_string
conn.Open
sql="Insert into newsimage(image_name,image_newsid) values('"
sql=sql & filename & "'," & newsid & ")"
conn.Execute(sql)
conn.close
set conn=nothing
%>
虽然可以在一个SQL server BIOB 列中保存一个图片,但是最好将图片的URL保存在数据库表中而不保存图片本身,下面是通过名为myIMAGES的数据库表中检索各个图片的URL在一行中显示几个图片:
<%
set con =server.createobject("ADODB.Connection")
con.open"FILE NAME=C:\mydatelink.UDL"
mySQL="SELECT image_URL from myimages"
set rs =con.execute(mySQL)
while not rs.eof
%>
<img src ="<%=rs("image_URL")%>">
<%
RS.MoveNext
Wend
%>
虽然可以在一个SQL server BIOB 列中保存一个图片,但是最好将图片的URL保存在数据库表中而不保存图片本身,下面是通过名为myIMAGES的数据库表中检索各个图片的URL在一行中显示几个图片:
<%
set con =server.createobject("ADODB.Connection")
con.open"FILE NAME=C:\mydatelink.UDL"
mySQL="SELECT image_URL from myimages"
set rs =con.execute(mySQL)
while not rs.eof
%>
<img src ="<%=rs("image_URL")>">
<%RS.MoveNext
Wend
%>