WB 2.08.x

<%

 ' 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

	Set oRegex = New RegExp

	oRegex.Global		= True

	if ( ConfigForceSingleExtension = True ) then

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

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

	end if

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

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

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

	Set oRegex = Nothing

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

%>