<%Server.ScriptTimeOut=5000%>
<html>
<head>
<title>文件上传</title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<link rel="stylesheet" type="text/css" href="guanli.css">
</head>
<body> 
<!--#include file="upload_Chengsoft.asp"-->
<%
TempFP=Mth()
TempFM="../UploadFiles/"
Call CreatFolder_Obj(TempFM,TempFP)
FormPath=TempFM&TempFP&"/"
iCount=0
PicUrl=""
PicUrl_1=""
PicUrl_2=""
PicUrl_Num=""
Set Upload=New upload_5xsoft ''建立上传对象

Set file=upload.file("photoimg")  ''生成一个文件对象
fileExt=lcase(right(file.filename,4))
Tp=FileExt

If file.FileSize>0 Then
	if lcase(fileEXT)<>".gif" and lcase(fileEXT)<>".jpg" and lcase(fileEXT)<>".png" and lcase(fileEXT)<>".bmp" and lcase(fileEXT)<>".jpeg" then
	response.write "<script>alert('文件上传格式不正确,请选择上传图片');self.close()</script>"
	response.end
	end if 
	'-----------------/设置文件格式判断/------------------------
	if file.FileSize>2048000 Then
		Response.Write "<script>alert('文件不能超过2M');self.close()</script>"
		Response.End
	End If
	ranNum=int(900*rnd)+100
	PicUrl=FormPath&year(now()) & month(now()) & day(now()) & hour(now()) & minute(now()) & second(now())&ranNum&FileEXT
	File.SaveAs Server.mappath(PicUrl)
	if isobjinstalled("persits.jpeg") then
	call AspJpeg_Small(PicUrl)
	end if
	PicUrl_1=PicUrl	
Else	
End If
set file=nothing

function isobjinstalled(strclassstring)
    on error resume next
    isobjinstalled = false
    err = 0
    dim xtestobj
    set xtestobj = server.createobject(strclassstring)
    if 0 = err then isobjinstalled = true
    set xtestobj = nothing
    err = 0
end function

Function AspJpeg_Small(FileName)
	Dim Jpeg,PicWidth,PicHeight
	PicWidth=640'目标图片宽度
	PicHeight=0
	Set Jpeg = Server.CreateObject("Persits.Jpeg")  ' 建立对象
	Jpeg.Open Server.mappath(FileName)' 图片所在位置	
	if Jpeg.OriginalWidth > PicWidth then
		Jpeg.Width = PicWidth
		if PicHeight=0 then
		Jpeg.Height = PicWidth/Jpeg.OriginalWidth * Jpeg.OriginalHeight
		else
		Jpeg.Height = PicHeight
		end if
		Jpeg.Sharpen 1, 130
		Jpeg.Quality=80
		Jpeg.Save Server.mappath(FileName)' 保存文件
	end if
	Set Jpeg = Nothing
end function

if session("imgnum")="" then
session("imgnum")=0
else
session("imgnum")=session("imgnum")+1
end if

if session("imgurlstr")="" then
session("imgurlstr")=PicUrl_1
else
session("imgurlstr")=session("imgurlstr")&PicUrl_1
end if

response.Write "<div id=""img"&session("imgnum")&"""><img src="&PicUrl_1&"><br><button value=""img"&session("imgnum")&""" name=""del"">删除</button></div> "

'获取当前月份函数
Function Mth()
	Mth=DatePart("yyyy",Date())&"-"&DatePart("m",Date())
End Function
'无条件创建文件夹
Sub CreatFolder_Obj(FolderDir,FolderName)
	Set Fs=CreateObject("Scripting.FileSystemObject")
	MyFolder=Server.MapPath(FolderDir&FolderName)
	If NOT fs.folderexists(MyFolder) Then
    	Fs.CreateFolder(MyFolder)
	End If
	If Fs.FolderExists(MyFolder) Then
		'文件夹被创建成功或文件夹已经存在！
	Else
		'创建失败！
	End If
End Sub
'无条件删除文件夹
Sub DelFolder(FolderDir,FolderName)
	Set Fs=CreateObject("Scripting.FileSystemObject")
	MyFolder=Server.MapPath(FolderDir&FolderName)
	If Fs.FolderExists(MyFolder) Then
		Set Remdir=Fs.GetFolder(MyFolder)
		    Remdir.Delete
		Set Remdir=Nothing
	End If
	If NOT Fs.FolderExists(MyFolder) Then
		'文件夹删除成功!
	Else
	    '删除失败
	End If
End Sub
function MakedownName()
	dim fname
	fname = now()
	fname = replace(fname,"-","")
	fname = replace(fname," ","") 
	fname = replace(fname,":","")
	fname = replace(fname,"PM","")
	fname = replace(fname,"AM","")
	fname = replace(fname,"上午","")
	fname = replace(fname,"下午","")
	fname = int(fname) + int((10-1+1)*Rnd + 1)
	MakedownName=fname
end function 
%>