asp上传的图片,白色部分丢失。。求解
请各位大虾帮忙看看:这段代码上传完的照片,凡是白色(强光)的部分,都是黑色,是为什么呢?请帮忙看看!
dim strSaveFileName
strnow =replace(replace(replace(now(), ":", ""), "-", ""), " ", "")
Dim intTotalLine
intTotalLine =Request.Form.Count
Dim strHeadData
strHeadData =ChrB(66) & ChrB(77) & ChrB(230) & ChrB(4) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) &_
ChrB(0) & ChrB(0) & ChrB(54) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(40) & ChrB(0) &_
ChrB(0) & ChrB(0) & ChrB(160) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(120) & ChrB(0) &_
ChrB(0) & ChrB(0) & ChrB(1) & ChrB(0) &_
ChrB(24) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(176) & ChrB(4) &_
ChrB(0) & ChrB(0) & ChrB(18) & ChrB(11) & ChrB(0) & ChrB(0) & ChrB(18) & ChrB(11) &_
ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) &_
ChrB(0) & ChrB(0)
Dim strSaveData, intLoop1, intLoop2, strTempData
For intLoop1 =intTotalLine To 0 Step -1
strTempData =Request.Form("PX"&intLoop1)
strTempData =Split(strTempData, ",")
For intLoop2 =0 To ubound(strTempData)
'strSaveData =strSaveData &toBin(strTempData(intLoop2))
strSaveData =strSaveData &To3(strTempData(intLoop2))
Next
Next
strSaveData =strHeadData & strSaveData
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
%>大家费心了,谢谢!