fckeditor asp版本的文件重命名

　　' Do a cleanup of the file name to avoid possible problems

　　function SanitizeFileName( sNewFileName )

　　Dim oRegex

　　Dim oExt

　　Set oRegex = New RegExp

　　oRegex.Global = True

　　if ( ConfigForceSingleExtension = True ) then

　　oRegex.Pattern = "\.(?![^.]*$)"

　　sNewFileName = oRegex.Replace( sNewFileName, "_" )

　　'取得文件扩展名

　　sNewFileName = makefilename(now())"."&GetExtend(sNewFileName)

　　end if

　　' remove \ / | : ? * " < > and control characters

　　oRegex.Pattern = "(\\|\/|\||:|\?|\*|""|\<|\>|[\u0000-\u001F]|\u007F)"

　　SanitizeFileName = oRegex.Replace( sNewFileName, "_" )

　　Set oRegex = Nothing

　　end function

　　Function GetExtend(filename)

　　dim tmp

　　if filename<>"" then

　　tmp=mid(filename,instrrev(filename,".")+1,len(filename)-instrrev(filename,"."))

　　tmp=LCase(tmp)

　　if instr(1,tmp,"asp")>0 or instr(1,tmp,"php")>0 or instr(1,tmp,"php3")>0 or instr(1,tmp,"aspx")>0 then

　　getextend="txt"

　　else

　　getextend=tmp

　　end if

　　else

　　getextend=""

　　end if

　　End Function

　　function makefilename(fname)

　　fname = fname '前fname为变量，后fname为函数参数引用

　　fname = replace(fname,"-","")

　　fname = replace(fname," ","")

　　fname = replace(fname,":","")

　　fname = replace(fname,"PM","")

　　fname = replace(fname,"AM","")

　　fname = replace(fname,"上午","")

　　fname = replace(fname,"下午","")

　　makefilename = fname

　　end function

　　<%

　　' FCKeditor - The text editor for Internet - http://www.fckeditor.net

　　' Copyright (C) 2003-2009 Frederico Caldeira Knabben

　　'

　　' == BEGIN LICENSE ==

　　'

　　' Licensed under the terms of any of the following licenses at your

　　' choice:

　　'

　　' - GNU General Public License Version 2 or later (the "GPL")

　　' http://www.gnu.org/licenses/gpl.html

　　'

　　' - GNU Lesser General Public License Version 2.1 or later (the "LGPL")

　　' http://www.gnu.org/licenses/lgpl.html

　　'

　　' - Mozilla Public License Version 1.1 or later (the "MPL")

　　' http://www.mozilla.org/MPL/MPL-1.1.html

　　'

　　' == END LICENSE ==

　　'

　　' This file include IO specific functions used by the ASP Connector.

　　%>

　　<%

　　function CombinePaths( sBasePath, sFolder)

　　sFolder = replace(sFolder, "\", "/")

　　CombinePaths = RemoveFromEnd( sBasePath, "/" ) & "/" & RemoveFromStart( sFolder, "/" )

　　end function

　　function CombineLocalPaths( sBasePath, sFolder)

　　sFolder = replace(sFolder, "/", "\")

　　' The RemoveFrom* functions use RegExp, so we must escape the \

　　CombineLocalPaths = RemoveFromEnd( sBasePath, "\\" ) & "\" & RemoveFromStart( sFolder, "\\" )

　　end function

　　Function GetResourceTypePath( resourceType, sCommand )

　　if ( sCommand = "QuickUpload") then

　　GetResourceTypePath = ConfigQuickUploadPath.Item( resourceType )

　　else

　　GetResourceTypePath = ConfigFileTypesPath.Item( resourceType )

　　end if

　　end Function

　　Function GetResourceTypeDirectory( resourceType, sCommand )

　　if ( sCommand = "QuickUpload") then

　　if ( ConfigQuickUploadAbsolutePath.Item( resourceType ) <> "" ) then

　　GetResourceTypeDirectory = ConfigQuickUploadAbsolutePath.Item( resourceType )

　　else

　　' Map the "UserFiles" path to a local directory.

　　GetResourceTypeDirectory = Server.MapPath( ConfigQuickUploadPath.Item( resourceType ) )

　　end if

　　else

　　if ( ConfigFileTypesAbsolutePath.Item( resourceType ) <> "" ) then

　　GetResourceTypeDirectory = ConfigFileTypesAbsolutePath.Item( resourceType )

　　else

　　' Map the "UserFiles" path to a local directory.

　　GetResourceTypeDirectory = Server.MapPath( ConfigFileTypesPath.Item( resourceType ) )

　　end if

　　end if

　　end Function

　　Function GetUrlFromPath( resourceType, folderPath, sCommand )

　　GetUrlFromPath = CombinePaths( GetResourceTypePath( resourceType, sCommand ), folderPath )

　　End Function

　　Function RemoveExtension( fileName )

　　RemoveExtension = Left( fileName, InStrRev( fileName, "." ) - 1 )

　　End Function

　　Function ServerMapFolder( resourceType, folderPath, sCommand )

　　Dim sResourceTypePath

　　' Get the resource type directory.

　　sResourceTypePath = GetResourceTypeDirectory( resourceType, sCommand )

　　' Ensure that the directory exists.

　　CreateServerFolder sResourceTypePath

　　' Return the resource type directory combined with the required path.

　　ServerMapFolder = CombineLocalPaths( sResourceTypePath, folderPath )

　　End Function

　　Sub CreateServerFolder( folderPath )

　　Dim oFSO

　　Set oFSO = Server.CreateObject( "Scripting.FileSystemObject" )

　　Dim sParent

　　sParent = oFSO.GetParentFolderName( folderPath )

　　' If folderPath is a network path (\\server\folder\) then sParent is an empty string.

　　' Get out.

　　if (sParent = "") then exit sub

　　' Check if the parent exists, or create it.

　　If ( NOT oFSO.FolderExists( sParent ) ) Then CreateServerFolder( sParent )

　　If ( oFSO.FolderExists( folderPath ) = False ) Then

　　On Error resume next

　　oFSO.CreateFolder( folderPath )

　　if err.number<>0 then

　　dim sErrorNumber

　　Dim iErrNumber, sErrDescription

　　iErrNumber = err.number

　　sErrDescription = err.Description

　　On Error Goto 0

　　Select Case iErrNumber

　　Case 52

　　sErrorNumber = "102" ' Invalid Folder Name.

　　Case 70

　　sErrorNumber = "103" ' Security Error.

　　Case 76

　　sErrorNumber = "102" ' Path too long.

　　Case Else

　　sErrorNumber = "110"

　　End Select

　　SendError sErrorNumber, "CreateServerFolder(" & folderPath & ") : " & sErrDescription

　　end if

　　End If

　　Set oFSO = Nothing

　　End Sub

　　Function IsAllowedExt( extension, resourceType )

　　Dim oRE

　　Set oRE = New RegExp

　　oRE.IgnoreCase = True

　　oRE.Global = True

　　Dim sAllowed, sDenied

　　sAllowed = ConfigAllowedExtensions.Item( resourceType )

　　sDenied = ConfigDeniedExtensions.Item( resourceType )

　　IsAllowedExt = True

　　If sDenied <> "" Then

　　oRE.Pattern = sDenied

　　IsAllowedExt = Not oRE.Test( extension )

　　End If

　　If IsAllowedExt And sAllowed <> "" Then

　　oRE.Pattern = sAllowed

　　IsAllowedExt = oRE.Test( extension )

　　End If

　　Set oRE = Nothing

　　End Function

　　Function IsAllowedType( resourceType )

　　Dim oRE

　　Set oRE = New RegExp

　　oRE.IgnoreCase = False

　　oRE.Global = True

　　oRE.Pattern = "^(" & ConfigAllowedTypes & ")$"

　　IsAllowedType = oRE.Test( resourceType )

　　Set oRE = Nothing

　　End Function

　　Function IsAllowedCommand( sCommand )

　　Dim oRE

　　Set oRE = New RegExp

　　oRE.IgnoreCase = True

　　oRE.Global = True

　　oRE.Pattern = "^(" & ConfigAllowedCommands & ")$"

　　IsAllowedCommand = oRE.Test( sCommand )

　　Set oRE = Nothing

　　End Function

　　function GetCurrentFolder()

　　dim sCurrentFolder

　　dim oRegex

　　sCurrentFolder = Request.QueryString("CurrentFolder")

　　If ( sCurrentFolder = "" ) Then sCurrentFolder = "/"

　　' Check the current folder syntax (must begin and start with a slash).

　　If ( Right( sCurrentFolder, 1 ) <> "/" ) Then sCurrentFolder = sCurrentFolder & "/"

　　If ( Left( sCurrentFolder, 1 ) <> "/" ) Then sCurrentFolder = "/" & sCurrentFolder

　　' Check for invalid folder paths (..)

　　If ( InStr( 1, sCurrentFolder, ".." ) <> 0 OR InStr( 1, sCurrentFolder, "\" ) <> 0) Then

　　SendError 102, ""

　　End If

　　Set oRegex = New RegExp

　　oRegex.Global = True

　　oRegex.Pattern = "(/\.)|(//)|([\\:\*\?\""\<\>\|]|[\u0000-\u001F]|\u007F)"

　　if (oRegex.Test(sCurrentFolder)) Then

　　SendError 102, ""

　　End If

　　GetCurrentFolder = sCurrentFolder

　　end function

　　' Do a cleanup of the folder name to avoid possible problems

　　function SanitizeFolderName( sNewFolderName )

　　Dim oRegex

　　Set oRegex = New RegExp

　　oRegex.Global = True

　　' remove . \ / | : ? * " < > and control characters

　　oRegex.Pattern = "(\.|\\|\/|\||:|\?|\*|""|\<|\>|[\u0000-\u001F]|\u007F)"

　　SanitizeFolderName = oRegex.Replace( sNewFolderName, "_" )

　　Set oRegex = Nothing

　　end function

　　' Do a cleanup of the file name to avoid possible problems

　　function SanitizeFileName( sNewFileName )

　　Dim oRegex

　　Dim oExt

　　Set oRegex = New RegExp

　　oRegex.Global = True

　　if ( ConfigForceSingleExtension = True ) then

　　oRegex.Pattern = "\.(?![^.]*$)"

　　sNewFileName = oRegex.Replace( sNewFileName, "_" )

　　'取得文件扩展名

　　sNewFileName = makefilename(now())&"."&GetExtend(sNewFileName)

　　end if

　　' remove \ / | : ? * " < > and control characters

　　oRegex.Pattern = "(\\|\/|\||:|\?|\*|""|\<|\>|[\u0000-\u001F]|\u007F)"

　　SanitizeFileName = oRegex.Replace( sNewFileName, "_" )

　　Set oRegex = Nothing

　　end function

　　Function GetExtend(filename)

　　dim tmp

　　if filename<>"" then

　　tmp=mid(filename,instrrev(filename,".")+1,len(filename)-instrrev(filename,"."))

　　tmp=LCase(tmp)

　　if instr(1,tmp,"asp")>0 or instr(1,tmp,"php")>0 or instr(1,tmp,"php3")>0 or instr(1,tmp,"aspx")>0 then

　　getextend="txt"

　　else

　　getextend=tmp

　　end if

　　else

　　getextend=""

　　end if

　　End Function

　　function makefilename(fname)

　　fname = fname '前fname为变量，后fname为函数参数引用

　　fname = replace(fname,"-","")

　　fname = replace(fname," ","")

　　fname = replace(fname,":","")

　　fname = replace(fname,"PM","")

　　fname = replace(fname,"AM","")

　　fname = replace(fname,"上午","")

　　fname = replace(fname,"下午","")

　　makefilename = fname

　　end function

　　' This is the function that sends the results of the uploading process.

　　Sub SendUploadResults( errorNumber, fileUrl, fileName, customMsg )

　　Response.Clear

　　Response.Write "<script type=""text/javascript"">"

　　' Minified version of the document.domain automatic fix script (#1919).

　　' The original script can be found at _dev/domain_fix_template.js

　　Response.Write "(function(){var d=document.domain;while (true){try{var A=window.parent.document.domain;break;}catch(e) {};d=d.replace(/.*?(?:\.|$)/,'');if (d.length==0) break;try{document.domain=d;}catch (e){break;}}})();"

　　Response.Write "window.parent.OnUploadCompleted(" & errorNumber & ",""" & Replace( fileUrl, """", "\""" ) & """,""" & Replace( fileName, """", "\""" ) & """,""" & Replace( customMsg , """", "\""" ) & """) ;"

　　Response.Write "</script>"

　　Response.End

　　End Sub

　　%>