| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 462 人关注过本帖
标题:asp上传的图片,白色部分丢失。。求解
只看楼主 加入收藏
boyfuture
Rank: 1
等 级:新手上路
帖 子:552
专家分:0
注 册:2005-12-20
结帖率:88.89%
收藏
 问题点数:0 回复次数:0 
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
%>大家费心了,谢谢!
搜索更多相关主题的帖子: ChrB asp 求解 
2008-04-21 22:33
快速回复:asp上传的图片,白色部分丢失。。求解
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.015023 second(s), 8 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved