源码网,源码论坛,源码之家,商业源码,游戏源码下载,discuz插件,棋牌源码下载,精品源码论坛

 找回密码
 立即注册
查看: 673|回复: 18

[网页编辑器] fckeditor asp版本的文件重命名

[复制链接]

7万

主题

861

回帖

32万

积分

论坛元老

Rank: 8Rank: 8

积分
329525
发表于 2009-8-20 01:16:12 | 显示全部楼层 |阅读模式
最近不得不研究FCKEDITOR,而且是ASP版本。对其文件上传后的重命名,很郁闷。下面记录我修改的过程,部分函数来自网络。
        
        
            定位到:editor\filemanager\connectors\asp\io.asp
主要是修改:SanitizeFileName这个函数,并添加取得扩展名和文件重命名的方法,详细代码如下:
[U]复制代码[/U] 代码如下:
' 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
懒得改的话就直接拷贝下面的代码:
[U]复制代码[/U] 代码如下:

"" ) 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.number0 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 ""
Response.End
End Sub
%>
回复

使用道具 举报

4

主题

2万

回帖

58

积分

注册会员

Rank: 2

积分
58
发表于 2022-8-22 14:01:35 | 显示全部楼层
你们谁看了弄洒了可能
回复 支持 反对

使用道具 举报

4

主题

2万

回帖

262

积分

中级会员

Rank: 3Rank: 3

积分
262
发表于 2023-6-13 16:03:14 | 显示全部楼层
很不错的玩意
回复 支持 反对

使用道具 举报

0

主题

2万

回帖

0

积分

中级会员

Rank: 3Rank: 3

积分
0
发表于 2023-8-29 21:56:49 | 显示全部楼层
建军节建军节建军节建军节
回复 支持 反对

使用道具 举报

0

主题

2万

回帖

0

积分

中级会员

Rank: 3Rank: 3

积分
0
发表于 2023-10-17 11:37:34 | 显示全部楼层
儿飞飞微风DVD谁vdsvd
回复 支持 反对

使用道具 举报

16

主题

2万

回帖

174

积分

注册会员

Rank: 2

积分
174
发表于 2023-12-7 19:48:33 | 显示全部楼层
2222222222222222
回复 支持 反对

使用道具 举报

0

主题

1万

回帖

0

积分

中级会员

Rank: 3Rank: 3

积分
0
发表于 2024-5-14 19:22:51 | 显示全部楼层
怕怕怕怕怕怕怕怕怕怕怕怕怕怕
回复 支持 反对

使用道具 举报

13

主题

2万

回帖

85

积分

注册会员

Rank: 2

积分
85
发表于 2024-6-21 05:45:30 | 显示全部楼层
啊啊啊啊啊啊啊啊啊啊啊啊啊啊
回复 支持 反对

使用道具 举报

3

主题

1万

回帖

50

积分

注册会员

Rank: 2

积分
50
发表于 2024-6-23 16:35:37 | 显示全部楼层
终于找到了,我擦
回复 支持 反对

使用道具 举报

2

主题

2万

回帖

499

积分

中级会员

Rank: 3Rank: 3

积分
499
发表于 2024-6-25 01:59:33 | 显示全部楼层
管灌灌灌灌灌灌灌灌灌灌
回复 支持 反对

使用道具 举报

高级模式
B Color Image Link Quote Code Smilies

本版积分规则

手机版|小黑屋|网站地图|源码论坛 ( 海外版 )

GMT+8, 2024-11-22 03:35 , Processed in 0.078348 second(s), 26 queries .

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表