?? uploadphoto.asp
字號:
<!--#include file="conn.asp"-->
<%
Response.Expires = -1
Response.AddHeader "Pragma", "no-cache"
Response.AddHeader "Cache-Control", "no-cache, must-revalidate"
dim strSaveFileName
strnow =replace(replace(replace(now(), ":", ""), "-", ""), " ", "")
strSaveFileName =strNow &".jpg"
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")
Jpeg.OpenBinary strSaveData
Jpeg.Width = Jpeg.OriginalWidth
Jpeg.Height = Jpeg.OriginalHeight
' 保存縮略圖到指定文件夾下
Jpeg.Save Server.MapPath("image_photo/"& strSaveFileName)
Set Jpeg = Nothing
call DataConnect '打開數據庫
on error resume next
set rs =server.CreateObject("adodb.recordset")
sql ="select * from [img]"
rs.open sql,conn,1,3
rs.addnew
rs("userid")="測試用戶"
rs("addtime") =now()
rs("myshow")="image_photo/"& strSaveFileName
rs.update
rs.close
set rs =nothing
response.Write("thisfile="& strSaveFileName)
call DataDisConnect '關閉數據庫
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
%>
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -