functions_upload.asp

简单的asp论坛源码系统,很适用于初学者!界面简洁,功能齐全

<%
'****************************************************************************************
'**  Copyright Notice    
'**
'**  Web Wiz Forums(TM)
'**  http://www.webwizforums.com
'**                            
'**  Copyright (C)2001-2008 Web Wiz(TM). All Rights Reserved.
'**  
'**  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS UNDER LICENSE FROM 'WEB WIZ'.
'**  
'**  IF YOU DO NOT AGREE TO THE LICENSE AGREEMENT THEN 'WEB WIZ' IS UNWILLING TO LICENSE 
'**  THE SOFTWARE TO YOU, AND YOU SHOULD DESTROY ALL COPIES YOU HOLD OF 'WEB WIZ' SOFTWARE
'**  AND DERIVATIVE WORKS IMMEDIATELY.
'**  
'**  If you have not received a copy of the license with this work then a copy of the latest
'**  license contract can be found at:-
'**
'**  http://www.webwizguide.com/license
'**
'**  For more information about this software and for licensing information please contact
'**  'Web Wiz' at the address and website below:-
'**
'**  Web Wiz, Unit 10E, Dawkins Road Industrial Estate, Poole, Dorset, BH15 4JD, England
'**  http://www.webwizguide.com
'**
'**  Removal or modification of this copyright notice will violate the license contract.
'**
'****************************************************************************************



'*************************** SOFTWARE AND CODE MODIFICATIONS **************************** 
'**
'** MODIFICATION OF THE FREE EDITIONS OF THIS SOFTWARE IS A VIOLATION OF THE LICENSE  
'** AGREEMENT AND IS STRICTLY PROHIBITED
'**
'** If you wish to modify any part of this software a license must be purchased
'**
'****************************************************************************************




'Upload global variables

Dim strImageName		'Holds the file name
Dim blnExtensionOK		'Set to false if the extension of the file is not allowed
Dim lngErrorFileSize		'Holds the file size if the file is not saved because it is to large
Dim dblErrorAllotedFileSpace	'Holds the alloted space size error
Dim blnFileExists		'Set to true if the file already exists
Dim blnFileSpaceExceeded	'Set to true if the alloted file space is exceeded


'Intiliase global variables
blnExtensionOK = True
blnFileExists = False
blnFileSpaceExceeded = False
lngErrorFileSize = 0
dblErrorAllotedFileSpace = 0







'******************************************
'***	   File Upload Function        ****
'******************************************

'Function to upload a file
Private Function fileUpload(ByVal strUploadType)

	'Dimension variables
	Dim objUpload		
	Dim strNewFileName	
	Dim strOriginalFileName	
	Dim objFSO
	Dim objTextStream
	Dim strTempFile
	Dim strExtension
	Dim saryFileUploadTypes
	Dim lngMaxFileSize
	Dim lngLoopCounter	
	
	
	
	'Make sure the user has a folder to upload to
	createUserFolder(strUploadFilePath)
	
	
	
	'First check the user has not gone over their alloted space
	'Get used space
	dblErrorAllotedFileSpace = folderSize(strUploadFilePath)
	
	'Check to see if the user has gone over the alloted space
	If CDbl(dblErrorAllotedFileSpace) > CDbl(intUploadAllocatedSpace) OR blnDemoMode Then
		blnFileSpaceExceeded = True
		Exit Function
	End If
	
	'If we get here which we shouldn't kick user if in demo mode
	If blnDemoMode Then Exit Function
	
	
	
	
	'Get the file types we are uploading
	If strUploadType = "file" Then
		lngMaxFileSize = intUploadMaxFileSize
		saryFileUploadTypes = Split(Trim(strUploadFileTypes), ";")
	ElseIf strUploadType = "image" Then
		lngMaxFileSize = intUploadMaxImageSize
		saryFileUploadTypes = Split(Trim(strImageTypes), ";")
	End If
	
	'If no file type of extensions set then leave now
	If isArray(saryFileUploadTypes) = False Then 
		blnExtensionOK = False
		Exit Function
	End If





	'******************************************
	'***	     Upload components         ****
	'******************************************

	'Select which upload component to use
	Select Case strUploadComponent


		'******************************************
		'***     Persits AspUpload component   ****
		'******************************************

		'Persits AspUpload upload component - tested with version 3.0
		Case "AspUpload"
		
			'Set error trapping
			On Error Resume Next

			'Create upload object
			Set objUpload = Server.CreateObject("Persits.Upload.1")
			
			'Check to see if an error has occurred
			'If an error has occurred write an error to the page
			If Err.Number <> 0 Then	Call errorMsg("An error has occurred while uploading file/image.<br />Please check the Persits AspUpload Component is installed on the server.", "create_AspUpload_object", "functions_upload.asp")
		
			'Disable error trapping
			On Error goto 0
		
			With objUpload


				'make sure files arn't over written
				.OverwriteFiles = False

				'We need to save the file before we can find out anything about it
				'** Save the file to the hard drive as saving to memory is often disabled by the web host **
				'Save to temp position to prevent errors at a later stage
				.SaveVirtual strUploadOriginalFilePath

				'Get the file name
				strNewFileName = .Files(1).ExtractFileName

				'Filter file name to remove anything that isn't allowed by the filters
				strNewFileName = formatFileName(strNewFileName)

				'Check the file size is not above the max allowed size, this is done using a function not the compoent to stop an exception error
				lngErrorFileSize = fileSize(.Files(1).Size, lngMaxFileSize)

				'Loop through all the allowed extensions and see if the file has one
				blnExtensionOK = fileExtension(strNewFileName, saryFileUploadTypes)
				
				'Check if file exsists
				blnFileExists = .FileExists(Server.MapPath(strUploadFilePath) & "\" & strNewFileName)

				'If the file is OK save it to disk
				If lngErrorFileSize = 0 AND blnExtensionOK AND blnFileExists = False Then

					'Save the file to disk with new file name
					'** Copy is used as we have already saved the file, just need to move it to it's correct location **
					.Files(1).CopyVirtual strUploadFilePath & "/" & strNewFileName
					
					'As a new copy of the file is saved we need to get rid of the old copy
					.Files(1).Delete

					'Pass the filename back
					fileUpload = strNewFileName


				'Else if it is not OK delete the uploaded file
				Else
					.Files(1).Delete

				End If

			End With

			'Clean up
			Set objUpload = Nothing




		'******************************************
		'***         Dundas Upload component   ****
		'******************************************

		'Dundas upload component free from http://www.dundas.com - tested with version 2.0
		Case "Dundas"
		
			'Set error trapping
			On Error Resume Next

			'Create upload object
			Set objUpload = Server.CreateObject("Dundas.Upload")
			
			'Check to see if an error has occurred
			'If an error has occurred write an error to the page
			If Err.Number <> 0 Then	Call errorMsg("An error has occurred while uploading file/image.<br />Please check the Dundas Upload Component is installed on the server.", "create_Dundas_Upload_object", "functions_upload.asp")
		
			'Disable error trapping
			On Error goto 0
			
		
			With objUpload

				'Make sure we are using a virtual directory for script
				.UseVirtualDir = True

				'Make sure the file names are not unique at this time
				.UseUniqueNames = False

				'Save the file first to memory
				.SaveToMemory()

				'Get the file name, the path mehod will be empty as we are saving to memory so use the original file path of the users system to get the name
				strNewFileName = .GetFileName(.Files(0).OriginalPath)

				
				'Filter file name to remove anything that isn't allowed by the filters
				strNewFileName = formatFileName(strNewFileName)

				'Check the file size is not above the max allowed size, this is done using a function not the compoent to stop an exception error
				lngErrorFileSize = fileSize(.Files(0).Size, lngMaxFileSize)

				'Loop through all the allowed extensions and see if the file has one
				blnExtensionOK = fileExtension(strNewFileName, saryFileUploadTypes)
				
				'Check if file exists
				blnFileExists = .FileExists(strUploadFilePath & "\" & strNewFileName)

				'If the file is OK save it to disk
				If lngErrorFileSize = 0 AND blnExtensionOK AND blnFileExists = False Then

					
					'Save the file to disk
					.Files(0).SaveAs strUploadFilePath & "/" & strNewFileName

					'Pass the filename back
					fileUpload = strNewFileName
				End If
			End With

			'Clean up
			Set objUpload = Nothing




		'******************************************
		'***  SoftArtisans FileUp component    ****
		'******************************************

		'SA FileUp upload component - tested with version 4
		Case "fileUp"
		
			'Set error trapping
			On Error Resume Next

			'Create upload object
			Set objUpload = Server.CreateObject("SoftArtisans.FileUp")
			
			'Check to see if an error has occurred
			'If an error has occurred write an error to the page
			If Err.Number <> 0 Then	Call errorMsg("An error has occurred while uploading file/image.<br />Please check the SoftArtisans FileUp Component is installed on the server.", "create_SoftArtisans_FileUp_object", "functions_upload.asp")
			
			'Disable error trapping
			On Error goto 0
			
			
			With objUpload

				'Over write files or an exception will occur if it already exists
				.OverWriteFiles = True

				'Set the upload path
				.Path = Server.MapPath(strUploadFilePath)

				'Get the file name, the path mehod will be empty as we are saving to memory so use the original file path of the users system to get the name
				strNewFileName = Mid(.UserFilename, InstrRev(.UserFilename, "\") + 1)

				
				'Filter file name to remove anything that isn't allowed by the filters
				strNewFileName = formatFileName(strNewFileName)

				'Check the file size is not above the max allowed size, this is done using a function not the compoent to stop an exception error
				lngErrorFileSize = fileSize(.TotalBytes, lngMaxFileSize)

				'Loop through all the allowed extensions and see if the file has one
				blnExtensionOK = fileExtension(strNewFileName, saryFileUploadTypes)
				
				'Create the file system object
				Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
				
				'Check if file exsists
				blnFileExists = objFSO.FileExists(Server.MapPath(strUploadFilePath) & "\" & strNewFileName)
				
				'Drop FSO as no longer needed
				Set objFSO = Nothing
				

				'If the file is OK save it to disk
				If lngErrorFileSize = 0 AND blnExtensionOK AND blnFileExists = False Then

					'Save the file to disk
					.SaveAs strNewFileName

					'Pass the filename back
					fileUpload = strNewFileName
				End If

			End With

			'Clean up
			Set objUpload = Nothing




		'******************************************
		'***  	AspSmartUpload component       ****
		'******************************************

		'AspSmartUpload upload component free from http://www.aspsmart.com
		Case "aspSmart"
		
			'Set error trapping
			On Error Resume Next

			'Create upload object
			Set objUpload = Server.CreateObject("aspSmartUpload.SmartUpload")
			
			'Check to see if an error has occurred
			'If an error has occurred write an error to the page
			If Err.Number <> 0 Then	Call errorMsg("An error has occurred while uploading file/image.<br />Please check the Asp Smart Upload Component is installed on the server.", "create_AspSmartUpload_object", "functions_upload.asp")
			
			'Disable error trapping
			On Error goto 0
			

			With objUpload

				'Make sure we are using a virtual directory
				.DenyPhysicalPath = True

				'Save the file first to memory
				.Upload

				'Get the file name, the path mehod will be empty as we are saving to memory so use the original file path of the users system to get the name
				strNewFileName = .Files(1).Filename

				'Filter file name to remove anything that isn't allowed by the filters
				strNewFileName = formatFileName(strNewFileName)

				'Check the file size is not above the max allowed size
				lngErrorFileSize = fileSize(.Files(1).Size, lngMaxFileSize)

				'Loop through all the allowed extensions and see if the file has one
				blnExtensionOK = fileExtension(strNewFileName, saryFileUploadTypes)
				
				'Create the file system object
				Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
				
				'Check if file exsists
				blnFileExists = objFSO.FileExists(Server.MapPath(strUploadFilePath) & "\" & strNewFileName)
				
				'Drop FSO as no longer needed
				Set objFSO = Nothing

				'If the file is OK save it to disk
				If lngErrorFileSize = 0 AND blnExtensionOK AND blnFileExists = False Then
					
					'Save the file to disk
					.Files(1).SaveAs strUploadFilePath & "/" & strNewFileName

					'Pass the filename back
					fileUpload = strNewFileName
				End If

			End With

			'Clean up
			Set objUpload = Nothing



		'******************************************