📄 upload.aspx

📁 一个真正的CMS系统,可以完全实现建站自动化,用.NET开发.
💻 ASPX
📖 第 1 页 / 共 2 页
字号:
12 下一页
<%@ Page language="VB" AutoEventWireup="false" aspCompat="True" validateRequest="False" %>

<!--#include file="config.aspx"-->

<%
'######################################
' eWebEditor v3.00 - Advanced online web based WYSIWYG HTML editor.
' Copyright (c) 2003-2004 eWebSoft.com
'
' For further information go to http://www.ewebsoft.com/
' This copyright notice MUST stay intact for use.
'######################################
%>

<%

Call InitUpload()

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

Select Case sAction
Case "REMOTE"
	Call DoCreateNewDir()
	Call DoRemote()
Case "SAVE"
	Call ShowForm()
	Call DoCreateNewDir()
	Call DoSave()
Case Else
	Call ShowForm()
End Select

%>

<script language="vb" runat="server">
Dim sAction As String
Dim sType As String, sStyleName As String, sLanguage As String
Dim sAllowExt As String, nAllowSize As Integer, sUploadDir As String, nUploadObject As Integer, nAutoDir As Integer, sBaseUrl As String, sContentPath As String
Dim sFileExt As String, sOriginalFileName As String, sSaveFileName As String, sPathFileName As String, nFileNum As Integer
Dim nSLTFlag As Integer, nSLTMinSize As Integer, nSLTOkSize As Integer, nSYFlag As Integer, sSYText As String, sSYFontColor As String, nSYFontSize As Integer, sSYFontName As String, sSYPicPath As String, nSLTSYObject As Integer, sSLTSYExt As String, nSYMinSize As Integer, sSYShadowColor As String, nSYShadowOffset As Integer

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

	Response.Write ("<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%' >" & _
	"</form>")

	Response.Write ("<script language=javascript>" & VBCrlf & _
	"" & VBCrlf & _
	"var sAllowExt = """ & sAllowExt & """;" & VBCrlf & _
	"" & VBCrlf & _
	"function CheckUploadForm() {" & VBCrlf & _
	"	if (!IsExt(document.myform.uploadfile.value,sAllowExt)){" & VBCrlf & _
	"		parent.UploadError('lang[""ErrUploadInvalidExt""]+"":'+sAllowExt+'""');" & VBCrlf & _
	"		return false;" & VBCrlf & _
	"	}" & VBCrlf & _
	"	return true" & VBCrlf & _
	"}" & VBCrlf & _
	"" & VBCrlf & _
	"var oForm = document.myform ;" & VBCrlf & _
	"oForm.attachEvent(""onsubmit"", CheckUploadForm) ;" & VBCrlf & _
	"if (! oForm.submitUpload) oForm.submitUpload = new Array() ;" & VBCrlf & _
	"oForm.submitUpload[oForm.submitUpload.length] = CheckUploadForm ;" & VBCrlf & _
	"if (! oForm.originalSubmit) {" & VBCrlf & _
	"	oForm.originalSubmit = oForm.submit ;" & VBCrlf & _
	"	oForm.submit = function() {" & VBCrlf & _
	"		if (this.submitUpload) {" & VBCrlf & _
	"			for (var i = 0 ; i < this.submitUpload.length ; i++) {" & VBCrlf & _
	"				this.submitUpload[i]() ;" & VBCrlf & _
	"			}" & VBCrlf & _
	"		}" & VBCrlf & _
	"		this.originalSubmit() ;" & VBCrlf & _
	"	}" & VBCrlf & _
	"}" & VBCrlf & _
	"" & VBCrlf & _
	"try {" & VBCrlf & _
	"	parent.UploadLoaded();" & VBCrlf & _
	"}" & VBCrlf & _
	"catch(e){" & VBCrlf & _
	"}" & VBCrlf & _
	"" & VBCrlf & _
	"</s" & "cript>" & VBCrlf )

	Response.Write ("</body></html>")

End Sub 


Sub DoSave()

	Select Case nUploadObject
	Case 1
		Call DoUpload_ASPUpload()
	Case 2
		Call DoUpload_SAFileUP()
	Case 3
		Call DoUpload_LyfUpload()
	Case Else
		Call DoUpload_ASPDotNet()
	End Select

	Dim s_SmallImageFile As String, s_SmallImagePathFile As String, s_SmallImageScript As String
	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
	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 makeImageSY(s_Path As String, s_File As String)
	If nSYFlag = 0 Then Exit Sub
	If isValidSLTSYExt(s_File) = False Then Exit Sub

	On Error Resume Next
	Dim nOriginalWidth

	Select Case nSLTSYObject
	Case 0
		Dim image As System.Drawing.Image = System.Drawing.Image.FromFile(Server.Mappath(s_Path & s_File))
		nOriginalWidth = image.Width
		If nSYMinSize > nOriginalWidth Then Exit Sub

		Dim bitmap As New System.Drawing.Bitmap(image.Width, image.Height, System.Drawing.Imaging.PixelFormat.Format32bppArgb)
		Dim g As System.Drawing.Graphics = System.Drawing.Graphics.FromImage(bitmap)
		g.DrawImage(image, 0, 0, image.Width, image.Height)

		If nSYFlag = 1 Then
			Dim f As System.Drawing.Font, b As System.Drawing.Brush
			f = new System.Drawing.Font(sSYFontName, nSYFontSize)
			b = new System.Drawing.SolidBrush(System.Drawing.ColorTranslator.FromHtml("#" & sSYShadowColor))
			g.DrawString(sSYText, f, b, 5+nSYShadowOffset, 5+nSYShadowOffset)
			b = new System.Drawing.SolidBrush(System.Drawing.ColorTranslator.FromHtml("#" & sSYFontColor))
			g.DrawString(sSYText, f, b, 5, 5)
		Else
			Dim copyImage As System.Drawing.Image = System.Drawing.Image.FromFile(Server.Mappath(sSYPicPath))
			g.DrawImage(copyImage, new System.Drawing.Rectangle(0, 0, copyImage.Width, copyImage.Height), 0, 0, copyImage.Width, copyImage.Height, System.Drawing.GraphicsUnit.Pixel)
			copyImage.Dispose()
		End If
		g.Dispose()
		image.Dispose()

		bitmap.Save(Server.Mappath(s_Path & s_File))
		bitmap.Dispose()

	Case Else
		Dim oImage, oLogo
		If IsObjInstalled("Persits.Jpeg") = False Then Exit Sub
		oImage = Server.CreateObject("Persits.Jpeg")
		oImage.Open (Server.Mappath(s_Path & s_File))
		nOriginalWidth = oImage.OriginalWidth
		If nSYMinSize > nOriginalWidth Then Exit Sub
		If nSYFlag = 1 Then
			oImage.Canvas.Font.Color = CInt("&H" & sSYFontColor)
			oImage.Canvas.Font.Family = sSYFontName
			'oImage.Canvas.Font.Bold = True
			oImage.Canvas.Font.Size = nSYFontSize
			oImage.Canvas.Font.ShadowColor = CInt("&H" & sSYShadowColor)
			oImage.Canvas.Font.ShadowXOffset = nSYShadowOffset
			oImage.Canvas.Font.ShadowYOffset = nSYShadowOffset
			oImage.Canvas.Print (5, 5, sSYText)
			oImage.Save (Server.Mappath(s_Path & s_File))
		End If
		If nSYFlag = 2 Then
			oLogo = Server.CreateObject("Persits.Jpeg")
			oLogo.Open (Server.Mappath(sSYPicPath))
			oImage.DrawImage (0, 0, oLogo)
			oImage.SendBinary()
			oLogo = Nothing
		End If
		oImage = Nothing

	End Select

End Sub

Function makeImageSLT(s_Path As String, s_File As String, s_SmallFile As String)
	makeImageSLT = False
	If nSLTFlag = 0 Then Exit Function
	If isValidSLTSYExt(s_File) = False Then Exit Function

	On Error Resume Next
	Dim nOriginalWidth As Integer, nOriginalHeight As Integer, nWidth As Integer, nHeight As Integer
	
	Select Case nSLTSYObject
	Case 0
		Dim image As System.Drawing.Image = System.Drawing.Image.FromFile(Server.Mappath(s_Path & s_File))
		nOriginalWidth = image.Width
		nOriginalHeight = image.Height
		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

		Dim bitmap As New System.Drawing.Bitmap(nWidth, nHeight, System.Drawing.Imaging.PixelFormat.Format32bppArgb)
		Dim g As System.Drawing.Graphics = System.Drawing.Graphics.FromImage(bitmap)
		g.Clear(System.Drawing.Color.Transparent)
		g.DrawImage(image, new System.Drawing.Rectangle(0, 0, nWidth, nHeight))
		image.Dispose()

		Dim s_Ext As String, s_Mime As String
		s_Ext = LCase(Mid(s_File, InstrRev(s_File, ".")+1))
		Select Case s_Ext
		Case "png"
			s_Mime = "image/png"
		Case "tif", "tiff"
			s_Mime = "image/tiff"
		Case "bmp"
			s_Mime = "image/bmp"
		Case Else
			s_Mime = "image/jpeg"
		End Select

		Dim parameters As New System.Drawing.Imaging.EncoderParameters(1)
		parameters.Param(0) = new System.Drawing.Imaging.EncoderParameter(System.Drawing.Imaging.Encoder.Quality, 90)
		bitmap.Save(Server.Mappath(s_Path & s_SmallFile), GetCodecInfo(s_Mime), parameters)
		parameters.Dispose()
		
		g.Dispose()
		bitmap.Dispose()
	
	Case 1
		Dim oImage
		If IsObjInstalled("Persits.Jpeg") = False Then Exit Function
		oImage = Server.CreateObject("Persits.Jpeg")
		oImage.Open (Server.Mappath(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 (Server.Mappath(s_Path & s_SmallFile))
		oImage = Nothing

	End Select

	makeImageSLT = True
End Function

Function GetCodecInfo(s_Mime As String)
	Dim CodecInfo() As System.Drawing.Imaging.ImageCodecInfo = System.Drawing.Imaging.ImageCodecInfo.GetImageEncoders()
	Dim ici As System.Drawing.Imaging.ImageCodecInfo
	For Each ici In CodecInfo
		If ici.MimeType = s_Mime Then
			GetCodecInfo = ici
		End If
	Next
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
	sContent = Request.Form("eWebEditor_UploadText")

	If sAllowExt <> "" Then
		sContent = ReplaceRemoteUrl(sContent, sAllowExt)
	End If

	Response.Write ("<HTML><HEAD><meta http-equiv='Content-Type' content='text/html; charset=UTF-8'></head><body>" & _
		"<TITLE>eWebEditor</TITLE>" & _
		"<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 sCreateDir
	Select Case nAutoDir
	Case 1
		sCreateDir = Left(FormatTime(Now(), 4), 4)
	Case 2
		sCreateDir = Left(FormatTime(Now(), 4), 6)
	Case 3
		sCreateDir = Left(FormatTime(Now(), 4), 8)
	Case Else
		Exit Sub
	End Select
	sUploadDir = sUploadDir & sCreateDir & "/"
	sContentPath = sContentPath & sCreateDir & "/"
	
	Dim oDir As System.IO.Directory
	If oDir.Exists(Server.Mappath(sUploadDir)) = False Then
		oDir.CreateDirectory(Server.Mappath(sUploadDir))
	End If
End Sub

Sub DoUpload_LyfUpload()
	On Error Resume Next
	Dim oUpload, sResult, sOriginalFile
	oUpload = Server.CreateObject("LyfUpload.UploadFile")
	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", Server.Mappath(sUploadDir), True, sSaveFileName)

	Select Case sResult
	Case "0"
		Call OutScript("parent.UploadError('lang[""ErrUploadSizeLimit""]+"":" & nAllowSize & "KB""')")
	Case ""
		Call OutScript("parent.UploadError('lang[""ErrUploadInvalidFile""]')")
	Case "1"
		Call OutScript("parent.UploadError('lang[""ErrUploadInvalidExt""]+"":" & sAllowExt & """')")
	End Select
	
	oUpload = Nothing
End Sub
12 下一页
⌨️ 快捷键说明

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