Dim Jpeg
Set Jpeg = Server.CreateObject("Persits.Jpeg")
if Err Then
Err.Clear()
strSaveFileName =strNow &".bmp"
call DataConnect '打开数据库
set rs =server.CreateObject("adodb.recordset")
sql ="select * from [img]"
rs.open sql,conn,1,3
rs.addnew
rs("id") =strnow
rs("addtime") =now
rs("imgdata").AppendChunk(strSaveData)
rs.update
rs.close
set rs =nothing
set rs =conn.execute("select * from [img] where id ="& strnow)
img_size =rs("imgdata").ActualSize
saa= rs("imgdata").GetChunk(img_size)
set rs =nothing
Call SaveStream("image_photo/"& strSaveFileName, saa)
set rs =server.CreateObject("adodb.recordset")
sql ="select * from [myphoto]"
rs.open sql,conn,1,3
rs.addnew
rs("userid") ="测试用户"
rs("update")=now()
rs("myshow")="image_photo/"& strSaveFileName
rs.update
rs.close
set rs =nothing
conn.execute("delete from [img] where id ="& strnow)
call DataDisConnect '关闭数据库
else
strSaveFileName =strNow &".jpg"
Jpeg.OpenBinary strSaveData
Jpeg.Width = Jpeg.OriginalWidth
Jpeg.Height = Jpeg.OriginalHeight
' 保存缩略图到指定文件夹下
Jpeg.Save Server.MapPath("image_photo/"& strSaveFileName)
' 注销实例
Set Jpeg = Nothing
'数据库处理
call DataConnect '打开数据库
set rs =server.CreateObject("adodb.recordset")
sql ="select * from [myphoto]"
rs.open sql,conn,1,3
rs.addnew
rs("userid") ="测试用户"
rs("update")=now()
rs("myshow")="image_photo/"& strSaveFileName
rs.update
rs.close
set rs =nothing
call DataDisConnect '关闭数据库
end if
response.Write("thisfile="& strSaveFileName)
Function To3(nums)
Dim myArray()
Dim iii, tmp
For iii=1 To 3
tmp=Mid(nums,iii*2-1,2)
Redim Preserve myArray(iii)
myArray(iii) =chn10(tmp)
'myArray(iii) =tmp
Next
To3 = ChrB(myArray(3))&ChrB(myArray(2))&ChrB(myArray(1))
End Function
Function toBin(str)
Dim intTemp, binTemp, strTemp
For intTemp =1 To 6 Step 2
strTemp =Mid(str, intTemp, 2)
binTemp =binTemp & ChrB(chn10(strTemp))
Next
toBin =binTemp
End Function
Function chn10(nums)
Dim tmp, tmpstr, intLoop4
nums_len=Len(nums)
For intLoop4=1 To nums_len
tmp=Mid(nums,intLoop4,1)
If IsNumeric(tmp) Then
tmp=tmp * 16 * (16^(nums_len-intLoop4-1))
Else
tmp=(ASC(UCase(tmp))-55) * (16^(nums_len-intLoop4))
End If
tmpstr=tmpstr+tmp
Next
chn10 = tmpstr
End Function
Sub SaveStream(paR_strFile, paR_streamContent)
Dim objStream
Set objStream =Server.CreateObject("ADODB.Stream")
with objStream
.Type =1
.Open
.Write paR_streamContent
.SaveToFile Server.Mappath(paR_strFile), 2
.Close()
End with
Set objStream =Nothing
End Sub
%>