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 Inter - http://.fckeditor.
' 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://.gnu./licenses/gpl.html
'
' - GNU Lesser General Public License Version 2.1 or later (the "LGPL")
' http://.gnu./licenses/lgpl.html
'
' - Mozilla Public License Version 1.1 or later (the "MPL")
' http://.mozilla./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 bined 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 work 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
%>