📄 upload.asp

📁 Art2008 CMS是一款具有强大的功能的基于ASP语言的网站管理软件
💻 ASP
📖 第 1 页 / 共 2 页
字号:
12 下一页
<% Option Explicit %>
<%
Session("eWebEditor_Original_CodePage") = Session.CodePage
Session.CodePage = 936
%>
<!--#include file="config.asp"-->
<!--#include file="upfileclass.asp"-->
<!--#include file ="admin_chk.asp"-->
<!--#include file="../../admin/Include/Art_cls.asp"-->
<%
Server.ScriptTimeOut = 1800

Dim sType, sStyleName, sLanguage,pops
Dim sAllowExt, nAllowSize, sUploadDir, nUploadObject, nAutoDir, sBaseUrl, sContentPath
Dim sFileExt, sOriginalFileName, sSaveFileName, sPathFileName, nFileNum
Dim nSLTFlag, nSLTMinSize, nSLTOkSize, nSYFlag, sSYText, sSYFontColor, nSYFontSize, sSYFontName, sSYPicPath, nSLTSYObject, sSLTSYExt, nSYMinSize, sSYShadowColor, nSYShadowOffset
Call InitUpload()

Dim sAction
sAction = UCase(Trim(Request.QueryString("action")))

Select Case sAction
Case "REMOTE"
	Call DoCreateNewDir()
	Call DoRemote()
Case "SAVE"
	Call ShowForm()
	Call DoCreateNewDir()
	Call DoSave()
Case "LOCAL"
	Call DoCreateNewDir()
	Call DoSaveword()
	'Call DoRemote()
Case Else
	Call ShowForm()
End Select
Session.CodePage = Session("eWebEditor_Original_CodePage")

Sub ShowForm()
%>
<HTML>
<HEAD>
<TITLE>eWebEditor</TITLE>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<script language="javascript" src="../dialog/dialog.js"></script>
<link href='../language/<%=sLanguage%>.css' type='text/css' rel='stylesheet'>
<link href='../dialog/dialog.css' type='text/css' rel='stylesheet'>
</head>
<body class=upload>

<form action="?action=save&type=<%=sType%>&style=<%=sStyleName%>&language=<%=sLanguage%>" method=post name=myform enctype="multipart/form-data">
<input type=file name=uploadfile size=1 style="width:100%" onChange="originalfile.value=this.value">
<input type=hidden name=originalfile value="">
</form>

<script language=javascript>

var sAllowExt = "<%=sAllowExt%>";

function CheckUploadForm() {
	if (!IsExt(document.myform.uploadfile.value,sAllowExt)){
		parent.UploadError('lang["ErrUploadInvalidExt"]+":'+sAllowExt+'"');
		return false;
	}
	return true
}

var oForm = document.myform ;
oForm.attachEvent("onsubmit", CheckUploadForm) ;
if (! oForm.submitUpload) oForm.submitUpload = new Array() ;
oForm.submitUpload[oForm.submitUpload.length] = CheckUploadForm ;
if (! oForm.originalSubmit) {
	oForm.originalSubmit = oForm.submit ;
	oForm.submit = function() {
		if (this.submitUpload) {
			for (var i = 0 ; i < this.submitUpload.length ; i++) {
				this.submitUpload[i]() ;
			}
		}
		this.originalSubmit() ;
	}
}

try {
	parent.UploadLoaded();
}
catch(e){
}

</script>

</body>
</html>
<% 
End Sub 

Sub DoSave()
dim jpeg,jpeg1,path,waterpath,coverpath
	Call DoUpload_Class()

	Dim s_SmallImageFile, s_SmallImagePathFile, s_SmallImageScript
	s_SmallImagePathFile = ""
	s_SmallImageScript = ""
	s_SmallImageFile = ""
	sPathFileName = sContentPath & sSaveFileName
if nSLTFlag=1 then
On Error Resume Next
Set Jpeg = Server.CreateObject("Persits.Jpeg")
if Err then
   Call OutScript("parent.UploadSaved('" & sPathFileName & "','" & s_SmallImagePathFile & "');var obj=parent.dialogArguments.dialogArguments;if (!obj) obj=parent.dialogArguments;try{obj.addUploadFile('" & sOriginalFileName & "', '" & sSaveFileName & "', '" & sPathFileName & "');} catch(e){} " & s_SmallImageScript)

end if
Path = Server.MapPath(sPathFileName) 
Jpeg.Open Path
if Jpeg.Width > nSLTMinSize then
Jpeg.Width =nSLTOkSize
Jpeg.Height = nSLTOkSize*3/4
Jpeg.Save Server.MapPath(sContentPath&"small/"& sSaveFileName)
s_SmallImagePathFile = sContentPath&"small/"&sSaveFileName
s_SmallImageFile="small/"& sSaveFileName
s_SmallImageScript = "try{obj.addUploadFile('" & sOriginalFileName & "', '" & s_SmallImageFile & "', '" & s_SmallImagePathFile & "');} catch(e){} "
response.Write(s_SmallImageFile)
end if
Set Jpeg = Nothing
end if
if nSYFlag=1 then 

waterpath=Server.MapPath(sPathFileName)
On Error Resume Next
Set Jpeg = Server.CreateObject("Persits.Jpeg")
if Err then
   Call OutScript("parent.UploadSaved('" & sPathFileName & "','" & s_SmallImagePathFile & "');var obj=parent.dialogArguments.dialogArguments;if (!obj) obj=parent.dialogArguments;try{obj.addUploadFile('" & sOriginalFileName & "', '" & sSaveFileName & "', '" & sPathFileName & "');} catch(e){} " & s_SmallImageScript)

end if

Jpeg.Open waterpath
Jpeg.Canvas.Font.Color ="&H"&sSYFontColor 
Jpeg.Canvas.Pen.Color ="&H"&sSYFontColor
Jpeg.Canvas.Font.Family = "'"& sSYFontName &"'"
Jpeg.Canvas.Font.Bold = True
Jpeg.Canvas.Font.Size = 15 
Jpeg.Canvas.Font.BkColor=&H5FD211
Jpeg.Canvas.Font.Quality = 4 '0 (Default), 1 (Draft), 2 (Proof), 3 (Non-Antialiased), 4 (Antialiased) 
Jpeg.Canvas.Font.BkMode = "Transparent" ' to make antialiasing work
Jpeg.Canvas.Print Jpeg.OriginalWidth-120, Jpeg.OriginalHeight-35, sSYText

Jpeg.Canvas.Pen.Color ="&H"&sSYShadowColor 
Jpeg.Canvas.Pen.Width = nSYShadowOffset
Jpeg.Canvas.Brush.Solid = False 
Jpeg.Canvas.DrawBar nSYShadowOffset, nSYShadowOffset, Jpeg.Width, Jpeg.Height
Jpeg.Save Server.MapPath(sPathFileName)
Set Jpeg=Nothing
end if
if nSYFlag=2 then 
waterpath=Server.MapPath(sPathFileName)
coverpath=Server.MapPath(sSYPicPath)
On Error Resume Next
Set Jpeg = Server.CreateObject("Persits.Jpeg")
Set Jpeg1 = Server.CreateObject("Persits.Jpeg")
if Err then
   Call OutScript("parent.UploadSaved('" & sPathFileName & "','" & s_SmallImagePathFile & "');var obj=parent.dialogArguments.dialogArguments;if (!obj) obj=parent.dialogArguments;try{obj.addUploadFile('" & sOriginalFileName & "', '" & sSaveFileName & "', '" & sPathFileName & "');} catch(e){} " & s_SmallImageScript)

end if
Jpeg.Open waterpath
Jpeg1.Open coverpath
if Jpeg.height >= nSYMinSize then
Jpeg.Canvas.Pen.Color  = &HFFFFFF 
Jpeg.Canvas.Pen.Width  = 0    
Jpeg.Canvas.Brush.Solid = False   
Jpeg.Canvas.Bar 0, 0, Jpeg.Width, Jpeg.Height 
Jpeg.Width = Jpeg.Width
Jpeg.height = Jpeg.height
Jpeg.Sharpen 1, 120
Jpeg.DrawImage Jpeg.Width-Jpeg1.Width, Jpeg.Height-Jpeg1.Height, Jpeg1, 0.8, &HFFFFFF 

Jpeg.Save Server.MapPath(sPathFileName)
end if
Set Jpeg=Nothing
Set Jpeg1=Nothing
end if
   
	dim rsnewsx
	set rsnewsx = Server.CreateObject("ADODB.RecordSet")
	rsnewsx.Open "select * from [config]",conn,1,1
	
	If rsnewsx("MarkComponent") <> "0" Then 
	call ArtThumb.AddWaterMark( sContentPath & sSaveFileName ) 'art添加上传图片水印效果
	end if
		
	If rsnewsx("ThumbComponent") <> "0" And (Not IsNull(rsnewsx("ThumbComponent"))) then
    call ArtThumb.CreateThumbs(sContentPath & sSaveFileName,sContentPath&"small/"&sSaveFileName)'art添加缩图功能  	
    s_SmallImagePathFile = sContentPath&"small/"&sSaveFileName
	s_SmallImageFile="small/"& sSaveFileName
	s_SmallImageScript = "try{obj.addUploadFile('" & sOriginalFileName & "', '" & s_SmallImageFile & "', '" & s_SmallImagePathFile & "');} catch(e){} "
    response.Write(s_SmallImageFile)
   	end if
	rsnewsx.close
	set rsnewsx=nothing
	
   Call OutScript("parent.UploadSaved('" & sPathFileName & "','" & s_SmallImagePathFile & "');var obj=parent.dialogArguments.dialogArguments;if (!obj) obj=parent.dialogArguments;try{obj.addUploadFile('" & sOriginalFileName & "', '" & sSaveFileName & "', '" & sPathFileName & "');} catch(e){} " & s_SmallImageScript)
  
  
End Sub

Sub DoRemote()
	Dim sContent, i
	For i = 1 To Request.Form("eWebEditor_UploadText").Count 
		sContent = sContent & Request.Form("eWebEditor_UploadText")(i) 
	Next
	If sAllowExt <> "" Then
		sContent = ReplaceRemoteUrl(sContent, sAllowExt)
	End If

	Response.Write "<HTML><HEAD><TITLE>远程上传</TITLE><meta http-equiv='Content-Type' content='text/html; charset=gb2312'></head><body>" & _
		"<input type=hidden id=UploadText value=""" & inHTML(sContent) & """>" & _
		"</body></html>"

	Call OutScriptNoBack("parent.setHTML(UploadText.value);try{parent.addUploadFile('" & sOriginalFileName & "', '" & sSaveFileName & "', '" & sPathFileName & "');} catch(e){} parent.remoteUploadOK();")

End Sub

Sub DoCreateNewDir()
End Sub

Sub DoUpload_Class()
	On Error Resume Next
	Dim oUpload, oFile
	Set oUpload = New upfile_class

	oUpload.GetData nAllowSize*1024

	If oUpload.Err > 0 Then
		Select Case oUpload.Err
		Case 1
			Call OutScript("parent.UploadError('lang[""ErrUploadInvalidFile""]')")
		Case 2
			Call OutScript("parent.UploadError('lang[""ErrUploadSizeLimit""]+"":" & nAllowSize & "KB""')")
		End Select
	End If

	Set oFile = oUpload.File("uploadfile")
	sFileExt = LCase(oFile.FileExt)
	Call CheckValidExt(sFileExt)
	sOriginalFileName = oFile.FileName
	sSaveFileName = GetRndFileName(sFileExt)

	Dim str_Mappath
	str_Mappath = Server.Mappath(sUploadDir & sSaveFileName)
	sFileExt = LCase(Mid(str_Mappath, InstrRev(str_Mappath, ".") + 1))
	Call CheckValidExt(sFileExt)

	oFile.SaveToFile str_Mappath
	Set oFile = Nothing
	Set oUpload = Nothing
	
End Sub

Function GetRndFileName(sExt)
	Dim sRnd
	Randomize
	sRnd = Int(900 * Rnd) + 100
	GetRndFileName = FormatTime(Now(), 5) & sRnd & "." & sExt
End Function

Sub OutScript(str)
	
	Response.Write "<script language=javascript>" & str & ";history.back()</script>"
	Session.CodePage = Session("eWebEditor_Original_CodePage")
	Response.End
End Sub

Sub OutScriptNoBack(str)
	Response.Write "<script language=javascript>" & str & "</script>"
End Sub

Sub CheckValidExt(sExt)
	Dim b, i, aExt
	b = False
	aExt = Split(sAllowExt, "|")
	For i = 0 To UBound(aExt)
		If LCase(aExt(i)) = sExt Then
			b = True
			Exit For
		End If
	Next
	If b = False Then
		Call OutScript("parent.UploadError('lang[""ErrUploadInvalidExt""]+"":" & sAllowExt & """')")
	End If
End Sub

Sub InitUpload()
	sType = UCase(Trim(Request.QueryString("type")))
	sStyleName = Trim(Request.QueryString("style"))
	sLanguage = Trim(Request.QueryString("language"))

	Dim i, aStyleConfig, bValidStyle
	bValidStyle = False
	For i = 1 To Ubound(aStyle)
		aStyleConfig = Split(aStyle(i), "|||")
		If Lcase(sStyleName) = Lcase(aStyleConfig(0)) Then
			bValidStyle = True
			Exit For
		End If
	Next

	If bValidStyle = False Then
		OutScript("parent.UploadError('lang[""ErrInvalidStyle""]')")
	End If
12 下一页
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -