📄 upload.asp

📁 这是一个企业管理的网站源码
💻 ASP
📖 第 1 页 / 共 2 页
字号:
12 下一页
<% Option Explicit %>
<%
'######################################
' eWebEditor v5.5 - Advanced online web based WYSIWYG HTML editor.
' Copyright (c) 2003-2008 eWebSoft.com
'
' For further information go to http://www.ewebsoft.com/
' This copyright notice MUST stay intact for use.
'######################################
%>
<!--#include file="config.asp"-->
<!--#include file="upfileclass.asp"-->
<%
Server.ScriptTimeOut = 1800
Dim sType, sStyleName, sCusDir, sParamSYFlag
Dim sAllowExt, nAllowSize, sUploadDir, nUploadObject, nAutoDir, sBaseUrl, sContentPath
Dim sFileExt, sOriginalFileName, sSaveFileName, sPathFileName, nFileNum
Dim nSLTFlag, nSLTMinSize, nSLTOkSize, nSYWZFlag, sSYText, sSYFontColor, nSYFontSize, sSYFontName, sSYPicPath, nSLTSYObject, sSLTSYExt, nSYWZMinWidth, sSYShadowColor, nSYShadowOffset, nSYWZMinHeight, nSYWZPosition, nSYWZTextWidth, nSYWZTextHeight, nSYWZPaddingH, nSYWZPaddingV, nSYTPFlag, nSYTPMinWidth, nSYTPMinHeight, nSYTPPosition, nSYTPPaddingH, nSYTPPaddingV, nSYTPImageWidth, nSYTPImageHeight, nSYTPOpacity, nCusDirFlag
Call InitUpload()
Dim sAction
sAction = UCase(Trim(Request.QueryString("action")))
Call DoCreateNewDir()
Select Case sAction
	Case "LOCAL"
		Call DoLocal()
	Case "REMOTE"
		Call DoRemote()
	Case "SAVE"
		Call DoSave()
End Select

Sub DoSave()
	Response.Write "<html><head><title>eWebEditor</title><meta http-equiv='Content-Type' content='text/html; charset=gb2312'></head><body>"
	Select Case nUploadObject
		Case 1
			Call DoUpload_ASPUpload()
		Case 2
			Call DoUpload_SAFileUP()
		Case 3
			Call DoUpload_LyfUpload()
		Case Else
			Call DoUpload_Class()
	End Select
	Dim s_SmallImageFile, s_SmallImagePathFile, s_SmallImageScript
	s_SmallImageFile = getSmallImageFile(sSaveFileName)
	s_SmallImagePathFile = ""
	s_SmallImageScript = ""
	If makeImageSLT(sUploadDir, sSaveFileName, s_SmallImageFile) = True Then
		Call makeImageSY(sUploadDir, s_SmallImageFile)
		Call makeImageSY(sUploadDir, sSaveFileName)
		s_SmallImagePathFile = sContentPath & s_SmallImageFile
		s_SmallImageScript = "try{obj.addUploadFile('" & sOriginalFileName & "', '" & s_SmallImageFile & "', '" & s_SmallImagePathFile & "');} catch(e){} "
	Else
		s_SmallImageFile = ""
		Call makeImageSY(sUploadDir, sSaveFileName)
	End If
	sPathFileName = sContentPath & sSaveFileName
	sOriginalFileName = Replace(sOriginalFileName, "'", "\'")
	sOriginalFileName = Replace(sOriginalFileName, """", "\""")
	Call OutScript("parent.UploadSaved('" & sPathFileName & "','" & s_SmallImagePathFile & "');var obj=parent.dialogArguments;if((!obj.eWebEditor)||(!obj.eWebEditor_Temp_HTML)||(!obj.eWebEditor_UploadForm)){obj=parent.dialogArguments.dialogArguments;} try{obj.addUploadFile('" & sOriginalFileName & "', '" & sSaveFileName & "', '" & sPathFileName & "');} catch(e){} " & s_SmallImageScript)
End Sub

Sub DoLocal()
	Select Case nUploadObject
		Case 1
			Call DoUpload_ASPUpload()
		Case 2
			Call DoUpload_SAFileUP()
		Case 3
			Call DoUpload_LyfUpload()
		Case Else
			Call DoUpload_Class()
	End Select
	sPathFileName = sContentPath & sSaveFileName
	Response.Write sPathFileName
End Sub

Sub makeImageSY(s_Path, s_File)
	If nSYWZFlag = 0 And nSYTPFlag = 0 Then Exit Sub
	If isValidSLTSYExt(s_File) = False Then Exit Sub
	On Error Resume Next
	Dim nOriginalWidth, nOriginalHeight, posX, posY
	Dim oImage, oLogo
	Select Case nSLTSYObject
		Case 0
		If IsObjInstalled("Persits.Jpeg") = False Then Exit Sub
		Set oImage = Server.CreateObject("Persits.Jpeg")
		If nSYWZFlag = 1 Then
			oImage.Open (s_Path & s_File)
			nOriginalWidth = oImage.OriginalWidth
			nOriginalHeight = oImage.OriginalHeight
			If nOriginalWidth<nSYWZMinWidth Or nOriginalHeight<nSYWZMinHeight Then Exit Sub
			randomize
			nSYWZPosition = int(rnd()*9+1)
			posX = getSYPosX(nSYWZPosition, nOriginalWidth, nSYWZTextWidth+nSYShadowOffset, nSYWZPaddingH)
			posY = getSYPosY(nSYWZPosition, nOriginalHeight, nSYWZTextHeight+nSYShadowOffset, nSYWZPaddingV)
			oImage.Canvas.Font.Color = Clng("&H" & sSYFontColor)
			oImage.Canvas.Font.Family = sSYFontName
			oImage.Canvas.Font.Size = nSYFontSize
			oImage.Canvas.Font.ShadowColor = Clng("&H" & sSYShadowColor)
			oImage.Canvas.Font.ShadowXOffset = nSYShadowOffset
			oImage.Canvas.Font.ShadowYOffset = nSYShadowOffset
			oImage.Canvas.Print posX, posY, sSYText
			oImage.Save (s_Path & s_File)
		End If
		If nSYTPFlag = 1 Then
			oImage.Open (s_Path & s_File)
			nOriginalWidth = oImage.OriginalWidth
			nOriginalHeight = oImage.OriginalHeight
			If nOriginalWidth<nSYTPMinWidth Or nOriginalHeight<nSYTPMinHeight Then Exit Sub
			randomize
			nSYTPPosition = int(rnd()*9+1)
			If nSYTPPosition = nSYWZPosition then
				nSYTPPosition = nSYTPPosition -1
				If nSYTPPosition = 0 Then
					nSYTPPosition = 2
				End If
			End If
			posX = getSYPosX(nSYTPPosition, nOriginalWidth, nSYTPImageWidth, nSYTPPaddingH)
			posY = getSYPosY(nSYTPPosition, nOriginalHeight, nSYTPImageHeight, nSYTPPaddingV)
			Set oLogo = Server.CreateObject("Persits.Jpeg")
			oLogo.Open Server.Mappath(sSYPicPath)
			oImage.DrawImage posX, posY, oLogo, nSYTPOpacity, &HFFFFFF
			oImage.Save (s_Path & s_File)
			Set oLogo = Nothing
		End If
		Set oImage = Nothing
		Case Else
	End Select
End Sub

Function getSYPosX(posFlag, originalW, syW, paddingH)
	Select Case posFlag
		Case 1, 2, 3
			getSYPosX = paddingH
		Case 4, 5, 6
			getSYPosX = (originalW - syW) \ 2
		Case 7, 8, 9
			getSYPosX = originalW - paddingH - syW
	End Select
End Function

Function getSYPosY(posFlag, originalH, syH, paddingV)
	Select Case posFlag
		Case 1, 4, 7
			getSYPosY = paddingV
		Case 2, 5, 8
			getSYPosY = (originalH - syH) \ 2
		Case 3, 6, 9
			getSYPosY = originalH - paddingV - syH
	End Select
End Function

Function makeImageSLT(s_Path, s_File, s_SmallFile)
	makeImageSLT = False
	If nSLTFlag = 0 Then Exit Function
	If isValidSLTSYExt(s_File) = False Then Exit Function
	Dim nOriginalWidth, nOriginalHeight, nWidth, nHeight
	Dim oImage
	Select Case nSLTSYObject
		Case 0
			If IsObjInstalled("Persits.Jpeg") = False Then Exit Function
			Set oImage = Server.CreateObject("Persits.Jpeg")
			oImage.Open (s_Path & s_File)
			nOriginalWidth = oImage.OriginalWidth
			nOriginalHeight = oImage.OriginalHeight
			If nOriginalWidth < nSLTMinSize And nOriginalHeight < nSLTMinSize Then Exit Function
			If nOriginalWidth > nOriginalHeight Then
				nWidth = nSLTOkSize
				nHeight = (nSLTOkSize / nOriginalWidth) * nOriginalHeight
			Else
				nHeight = nSLTOkSize
				nWidth = (nSLTOkSize / nOriginalHeight) * nOriginalWidth
			End If
			oImage.Width = nWidth
			oImage.Height = nHeight
			oImage.Save (s_Path & s_SmallFile)
			Set oImage = Nothing
		Case Else
	End Select
	makeImageSLT = True
End Function

Function isValidSLTSYExt(s_File)
	Dim b, i, aExt, sExt
	b = False
	sExt = LCase(Mid(s_File, InstrRev(s_File, ".")+1))
	aExt = Split(LCase(sSLTSYExt), "|")
	For i = 0 To UBound(aExt)
		If aExt(i) = sExt Then
			b = True
			Exit For
		End If
	Next
	isValidSLTSYExt = b
End Function

Function getSmallImageFile(s_File)
	Dim n
	n = InstrRev(s_File, ".")
	getSmallImageFile = Left(s_File, n-1) & "_s." & Mid(s_File, n+1)
End Function

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>eWebEditor</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()
	Dim a, i
	If nCusDirFlag = 1 Then
		a = Split(sCusDir, "/")
		For i = 0 To UBound(a)
			If a(i) <> "" Then
				Call CreateFolder(a(i))
			End If
		Next
	End If
	Dim s_DateDir
	Select Case nAutoDir
	Case 1
		s_DateDir = Left(FormatTime(Now(), 4), 4)
	Case 2
		s_DateDir = Left(FormatTime(Now(), 4), 6)
	Case 3
		s_DateDir = Left(FormatTime(Now(), 4), 8)
	Case Else
		s_DateDir = ""
	End Select
	If s_DateDir <> "" Then
		Call CreateFolder(s_DateDir)
	End If
End Sub

Sub CreateFolder(s_Folder)
	If IsObjInstalled("Scripting.FileSystemObject") = False Then
		Exit Sub
	End If
	sUploadDir = sUploadDir & s_Folder & "\"
	sContentPath = sContentPath & s_Folder & "/"
	Dim fso
	Set fso = Server.CreateObject("Scripting.FileSystemObject")
	If fso.FolderExists(sUploadDir) = False Then
		fso.CreateFolder sUploadDir
	End If
	Set fso = Nothing
End Sub

Sub DoUpload_LyfUpload()
	On Error Resume Next
	Dim oUpload, sResult, sOriginalFile
	Set oUpload = Server.CreateObject("LyfUpload.UploadFile")
	oUpload.CodePage = 936
	oUpload.ExtName = Replace(sAllowExt, "|", ",")
	oUpload.MaxSize = nAllowSize*1024
	sOriginalFile = oUpload.Request("originalfile")
	sOriginalFileName = Mid(sOriginalFile, InStrRev(sOriginalFile, "\") + 1)
	sFileExt = LCase(Mid(sOriginalFileName, InStrRev(sOriginalFileName, ".") + 1))
	Call CheckValidExt(sFileExt)
	sSaveFileName = GetRndFileName(sFileExt)
	sResult = oUpload.SaveFile("uploadfile", sUploadDir, True, sSaveFileName)
	Select Case sResult
	Case "0"
		Call OutScript("parent.UploadError('size')")
	Case ""
		Call OutScript("parent.UploadError('file')")
	Case "1"
		Call OutScript("parent.UploadError('ext')")
	End Select
	Set oUpload = Nothing
End Sub

Sub DoUpload_SAFileUp()
	On Error Resume Next
	Dim oFileUp
	Set oFileUp = Server.CreateObject("SoftArtisans.FileUp")
	oFileUp.CodePage = 936
	oFileUp.Path = sUploadDir
	If oFileUp.Form("uploadfile").TotalBytes > nAllowSize*1024 Then
		Err.Clear
		Call OutScript("parent.UploadError('size')")
	End If
	If oFileUp.Form("uploadfile").IsEmpty Then
		Call OutScript("parent.UploadError('file')")
	End If
	Dim sShortFileName
	sShortFileName = Mid(oFileUp.Form("uploadfile").UserFilename, InstrRev(oFileUp.Form("uploadfile").UserFilename, "\") + 1)
	sFileExt = LCase(Mid(sShortFileName, InStrRev(sShortFileName, ".") + 1))
	Call CheckValidExt(sFileExt)
	sOriginalFileName = sShortFileName
	sSaveFileName = GetRndFileName(sFileExt)
	oFileUp.Form("uploadfile").SaveAs (sUploadDir & sSaveFileName)
	Set oFileUp = Nothing
End Sub

Sub DoUpload_ASPUpload()
	On Error Resume Next
	Dim oUpload, oFile, nCount
	Set oUpload = Server.CreateObject("Persits.Upload")
	oUpload.CodePage = 936
	oUpload.SetMaxSize nAllowSize*1024, True
	nCount = oUpload.Save
	If nCount < 1 Then
		Call OutScript("parent.UploadError('file')")
	End If
	If Err.Number = 8 Then
		Err.Clear
		Call OutScript("parent.UploadError('size')")
	End If
	Set oFile = oUpload.Files("uploadfile")
	sFileExt = LCase(Mid(oFile.Ext, 2))
	Call CheckValidExt(sFileExt)
	sOriginalFileName = oFile.FileName
	sSaveFileName = GetRndFileName(sFileExt)
	oFile.SaveAs (sUploadDir & sSaveFileName)
	Set oFile = Nothing
	Set oUpload = Nothing
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
12 下一页
💿 文件大小 2249 K
👤 上传用户 feiguohaihu
📂 所属分类企业管理
🏷️ 相关标签

#企业管理 #网站 #源码
⌨️ 快捷键说明

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