<%@Language=VBScript  CODEPAGE="936"%>
<!--#include file="inc/conndb.asa"-->
<!--#include file="inc/function.asp"--> 
<%Server.ScriptTimeOut=5000%>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<link href="<%=indeximg%>/dreamsun.css" rel="stylesheet" type="text/css">

<body bgcolor="#f2f2f2"  leftmargin="0" topmargin="0" marginwidth="0" marginheight="0">

<%
IF Dreamsun_name="" Then
	Response.write backmsg("请先登陆!才可使用上传功能!","")
	Response.Write("<script>window.close();</script>")
Else
	userid = OptTable("select id from "&usertable&" where [username]='"&Dreamsun_name&"'")
	If userid="" Or IsEmpty(userid) Then Response.write backmsg("登陆信息丢失，请重新登陆!","")
End IF

Dim action,url,cdo,stype,upnarr
action=Request.QueryString("action")
stype=Request.QueryString("type")
stype=2
upnarr=Request.Cookies("DreamSun_Post_"&webname)("upload")
'允许上传类型
const UpFileType="gif|jpg|jpeg|bmp|mp3|wma|rar"
const UploadPath="Upload/"


IF IsEmpty(action) or action="" Then
   Call UploadForm()
ElseIF action="upload" Then
   Call UploadFile()
ElseIf action="clearn" Then 
Response.Cookies("DreamSun_Post_"&webname)("upload")=""
   Call UploadForm()
End If

Sub UploadFile()
dim upload,file,formName,id,FileExt,arrUpFileType,i,EnableUpload
set upload=new upload_5xsoft ''建立上传对象
id="文件上传成功:"
UpOption=Cint(upload.Form("UpOption"))
EnableUpload=False

Dim oFSO,oUploadFolder
Set oFSO = Server.CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set oUploadFolder = oFSO.GetFolder(Server.MapPath(UploadPath))
If Err.Number>0 Then
	If Not oFSO.FoldErexists(Server.MapPath(UploadPath)) Then
		oFSO.CreateFolder(Server.MapPath(UploadPath))
	Else
		Response.Write "无效的上传目录或者权限！ &nbsp;<a href='javaScript:history.back(-1)'>重新上传</a>"
		Exit Sub
	End If
End If

for each formName in upload.objFile ''列出所有上传了的文件
 set file=upload.file(formName)  ''生成一个文件对象
 If file.filesize<1 Then
           Response.Write "请先选择你要上传的文件！ &nbsp;<a href='javaScript:history.back(-1)'>重新上传</a>"
           Response.end
 End If
 if left(right(file.filename,5),1) = "." then
  FileExt = lcase(right(file.filename,4))
 Else
  FileExt = lcase(right(file.filename,3))
 End if
  arrUpFileType=split(UpFileType,"|")
  For i=0 To ubound(arrUpFileType)
    If FileExt<>trim(arrUpFileType(i)) Then       
	   EnableUpload=False	   
    ElseIf FileExt=trim(arrUpFileType(i)) Then
       EnableUpload=True
	   Exit For
   End If
  Next
  If Not EnableUpload Then
	 response.write "错误：禁止上传 <font color=red><b>'"& FileExt &"'</b></font> 文件! <a href='javaScript:history.back(-1)'>重新上传</a>"
	 Exit Sub
  End If
  If file.FileSize>0 And EnableUpload=True Then       ''如果 FileSize > 0 说明有文件数据
     If file.FileSize>1024000 Then response.write backmsg("文件超过了规定大小1024K","")
	 file.FileName = FormatName(FileExt)
     file.SaveAs Server.mappath(UploadPath&file.FileName)   ''保存文件
     'Call MathJpeg(UploadPath&file.FileName,FileExt,2)

	   Response.Cookies("DreamSun_Post_"&webname)("upload")=File.FileName&"||"&upnarr
	   If InStr("gif|jpg|jpeg|bmp|png",FileExt)>0 Then 
		   IF UpOption=1 Then
			  Response.write "<script language=javascript>opener.save.contents.value+='[img]"&UploadPath & File.FileName&"[/img]\n';window.close();</script>"
		   ElseIF UpOption=2 Then
			  Response.write "<SCRIPT language=javascript>opener.save.picurl.value='"&UploadPath & File.FileName&"';window.close();</script>"
		   End If
	   ElseIf InStr("rar|doc|pdf|xls",FileExt)>0 Then
			  Response.write "<script language=javascript>opener.save.contents.value+='[url="&UploadPath & File.FileName&"]点击下载[/url]';window.close();</script>"
		Else 
			  Response.write "<script language=javascript>opener.save.contents.value+='"&UploadPath & File.FileName&"';window.close();</script>"
	   End If 

      set file=nothing
  Else response.write "错误：禁止上传 <font color=red><b>'"& FileExt &"'</b></font> 文件! Size："&file.FileSize/1000&" K <a href='javaScript:history.back(-1)'>重新上传</a>"     
  End If
next

set upload=nothing  ''删除此对象
End Sub

Function FormatName(FileExt)
 	FormatName = DateToStr(Now(),"YmdHIS")&"_"&userid&"."&FileExt
End Function


Function checkmuma(mfile)
	Set fso = Server.CreateObject("Scripting.FileSystemObject")
		if fso.FileExists(server.Mappath(mfile)) then
			set readFile=fso.openTextFile(server.Mappath(mfile))
				checkmuma=readFile.readall
			readFile.Close
			If checkmuma<>"" Then
				checkmuma=LCase(checkmuma)
				If InStr(checkmuma,Chr(60)&Chr(37))>0 Or InStr(checkmuma,Chr(37)&Chr(60))>0 Or (InStr(checkmuma," if ")>0 And InStr(checkmuma," then ")>0) Or (InStr(checkmuma," for ")>0 And InStr(checkmuma," next ")>0) Or (InStr(checkmuma," select ")>0 And InStr(checkmuma," case ")>0) Or (InStr(checkmuma," do ")>0 And InStr(checkmuma," while ")>0) Then 
					fso.deletefile(server.mappath(mfile))
					checkmuma=1
				Else
					checkmuma=0
				End If
			Else
				checkmuma="文件无内容！"
			End If
		Else
			checkmuma="上传失败！"
		end if
	set fso=nothing
End Function

Sub UploadForm()
%>
<FORM action="?action=upload" method="post" encType="multipart/form-data">
<table width="95%" border="0" align="center" cellpadding="5" cellspacing="1" >
    <tr> 
      <th align="center">文件上传</th>
    </tr>
    <tr> 
      <td height="20" align="center" ID="strMsg">允许上传的文件类型：<%=UpFileType%></td>
    </tr>
    <tr> 
      <td align="center"><input type="file" name="file1" size=30>
        <input type="hidden" name="filename">
     <input type="submit" name="Submit" value="上传" onClick="filename.value=file1.value;" class=button>
 </td>
    </tr>
    <tr> 
      <td align="center">上传选项：         
        <input name="UpOption" type="radio" id="UpOption1" value="1" checked>        
        <label for=upOption1>文章内容</label>
        <input name="UpOption" type="radio" id="UpOption2" value="2">
        <label For=upOption2>幻灯片</label>
    </tr>
    <tr>
      <td align="left">
        <%
If upnarr<>"" Then 
If InStr(upnarr,"||")>0 Then
response.write "本电脑近期上传的图片历史记录：<a href=""?action=clearn"">清空记录</a><BR>"
If right(upnarr,2)="||" Then upnarr=Left(upnarr,Len(upnarr)-2)
arrUpFileName=split(upnarr,"||")
For i=0 To ubound(arrUpFileName)
If InStr("gif|jpg|jpeg|bmp|png",GetFileExtName(trim(arrUpFileName(i))))>0 Then 
response.write trim(arrUpFileName(i))&"&nbsp;<a href=""javascript:"" onClick=""opener.save.contents.value+='[img]"&UploadPath &  trim(arrUpFileName(i))&"[/img]\n'"">插入文章</a> "
Else 
response.write trim(arrUpFileName(i))&"&nbsp;<a href=""javascript:"" onClick=""opener.save.contents.value+='"&UploadPath &  trim(arrUpFileName(i))&"'"">插入文章</a> "
End If 
If GetFileExtName(trim(arrUpFileName(i)))="jpg" Or GetFileExtName(trim(arrUpFileName(i)))="jpeg" Then 
response.write" <a href=""javascript:"" onClick=""opener.save.picurl.value='"&UploadPath &  trim(arrUpFileName(i))&"'"">插入幻灯</a>"
End If 
response.write "<BR>"
  Next
End If
End If%>
      </td>
    </tr>
	 </table>
<%
response.write  "</FORM>"
End Sub
%>
</body>
</html>
<%

Function GetFileExtName(fileName)
	Dim pos
	pos=InStrRev(filename,".")
	If pos>0 Then 
		getFileExtName=LCase(Mid(fileName,pos+1))
	Else
		getFileExtName=""
	End If
End Function




dim Data_5xsoft

Class upload_5xsoft
  
dim objForm,objFile,Version

Public function Form(strForm)
   strForm=lcase(strForm)
   if not objForm.exists(strForm) then
     Form=""
   else
     Form=objForm(strForm)
   end if
 end function

Public function File(strFile)
   strFile=lcase(strFile)
   if not objFile.exists(strFile) then
     set File=new FileInfo
   else
     set File=objFile(strFile)
   end if
 end function


Private Sub Class_Initialize 
  dim RequestData,sStart,vbCrlf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,theFile
  dim iFileSize,sFilePath,sFileType,sFormValue,sFileName
  dim iFindStart,iFindEnd
  dim iFormStart,iFormEnd,sFormName
  Version="化境HTTP上传程序 Version 2.0"
  set objForm=Server.CreateObject("Scripting.Dictionary")
  set objFile=Server.CreateObject("Scripting.Dictionary")
  if Request.TotalBytes<1 then Exit Sub
  set tStream = Server.CreateObject("adodb.stream")
  set Data_5xsoft = Server.CreateObject("adodb.stream")
  Data_5xsoft.Type = 1
  Data_5xsoft.Mode =3
  Data_5xsoft.Open
  Data_5xsoft.Write  Request.BinaryRead(Request.TotalBytes)
  Data_5xsoft.Position=0
  RequestData =Data_5xsoft.Read 

  iFormStart = 1
  iFormEnd = LenB(RequestData)
  vbCrlf = chrB(13) & chrB(10)
  sStart = MidB(RequestData,1, InStrB(iFormStart,RequestData,vbCrlf)-1)
  iStart = LenB (sStart)
  iFormStart=iFormStart+iStart+1
  while (iFormStart + 10) < iFormEnd 
	iInfoEnd = InStrB(iFormStart,RequestData,vbCrlf & vbCrlf)+3
	tStream.Type = 1
	tStream.Mode =3
	tStream.Open
	Data_5xsoft.Position = iFormStart
	Data_5xsoft.CopyTo tStream,iInfoEnd-iFormStart
	tStream.Position = 0
	tStream.Type = 2
	tStream.Charset ="gb2312"
	sInfo = tStream.ReadText
	tStream.Close
	'取得表单项目名称
	iFormStart = InStrB(iInfoEnd,RequestData,sStart)
	iFindStart = InStr(22,sInfo,"name=""",1)+6
	iFindEnd = InStr(iFindStart,sInfo,"""",1)
	sFormName = lcase(Mid (sinfo,iFindStart,iFindEnd-iFindStart))
	'如果是文件
	if InStr (45,sInfo,"filename=""",1) > 0 then
		set theFile=new FileInfo
		'取得文件名
		iFindStart = InStr(iFindEnd,sInfo,"filename=""",1)+10
		iFindEnd = InStr(iFindStart,sInfo,"""",1)
		sFileName = Mid (sinfo,iFindStart,iFindEnd-iFindStart)
		theFile.FileName=getFileName(sFileName)
		theFile.FilePath=getFilePath(sFileName)
		'取得文件类型
		iFindStart = InStr(iFindEnd,sInfo,"Content-Type: ",1)+14
		iFindEnd = InStr(iFindStart,sInfo,vbCr)
		theFile.FileType =Mid (sinfo,iFindStart,iFindEnd-iFindStart)
		theFile.FileStart =iInfoEnd
		theFile.FileSize = iFormStart -iInfoEnd -3
		theFile.FormName=sFormName
		if not objFile.Exists(sFormName) then
		  objFile.add sFormName,theFile
		end if
	else
	'如果是表单项目
		tStream.Type =1
		tStream.Mode =3
		tStream.Open
		Data_5xsoft.Position = iInfoEnd 
		Data_5xsoft.CopyTo tStream,iFormStart-iInfoEnd-3
		tStream.Position = 0
		tStream.Type = 2
		tStream.Charset ="gb2312"
	        sFormValue = tStream.ReadText 
	        tStream.Close
		if objForm.Exists(sFormName) then
		  objForm(sFormName)=objForm(sFormName)&", "&sFormValue		  
		else
		  objForm.Add sFormName,sFormValue
		end if
	end if
	iFormStart=iFormStart+iStart+1
	wend
  RequestData=""
  set tStream =nothing
End Sub

Private Sub Class_Terminate  
 if Request.TotalBytes>0 then
	objForm.RemoveAll
	objFile.RemoveAll
	set objForm=nothing
	set objFile=nothing
	Data_5xsoft.Close
	set Data_5xsoft =nothing
 end if
End Sub
   
 
 Private function GetFilePath(FullPath)
  If FullPath <> "" Then
   GetFilePath = left(FullPath,InStrRev(FullPath, "\"))
  Else
   GetFilePath = ""
  End If
 End  function
 
 Private function GetFileName(FullPath)
  If FullPath <> "" Then
   GetFileName = mid(FullPath,InStrRev(FullPath, "\")+1)
  Else
   GetFileName = ""
  End If
 End  function
End Class

Class FileInfo
  dim FormName,FileName,FilePath,FileSize,FileType,FileStart
  Private Sub Class_Initialize 
    FileName = ""
    FilePath = ""
    FileSize = 0
    FileStart= 0
    FormName = ""
    FileType = ""
  End Sub
  
 Public function SaveAs(FullPath)
    dim dr,ErrorChar,i
    SaveAs=true
    if trim(fullpath)="" or FileStart=0 or FileName="" or right(fullpath,1)="/" then exit function
    set dr=CreateObject("Adodb.Stream")
    dr.Mode=3
    dr.Type=1
    dr.Open
    Data_5xsoft.position=FileStart
    Data_5xsoft.copyto dr,FileSize
    dr.SaveToFile FullPath,2
    dr.Close
    set dr=nothing 
    SaveAs=false
  end function
  End Class
%>