网页编辑器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 
%>