ASP常用函数一之FSO文件操作类

ASP 文件操作提供了FileSystemObject对象,却没有提供相关的函数。研究了一段时间php发现许多一个函数就能解决的问题ASP实现起来就很麻烦,还得自己写函数。 FileSystemObject 对象用于访问服务器上的文件系统。此对象可对文件、文件夹以及目录路径进行操作。也可通过此对象获取文件系统的信息。
下面是我收集整理的一个FSO文件操作类,
类文件主要功能:
文件的创建、修改、删除、读取、重命名。
文件夹的创建、删除、读取、重命名。
读取文件或文件夹的相关属性。
文件或文件夹的移动复制。

Class FsoClass
	Public FSO,ErrCode

	Private ObjFile,ObjFolder

	Private Sub Class_Initialize()
		ErrCode=0
		Set FSO=Server.CreateObject("Scripting.FileSystemObject")
		If Err.Number<>0 Then
			Err.Clear
			Set FSO=Nothing
		 	ErrCode=1
		End If
	End Sub

	Private Sub Class_Terminate()
		Set FSO=Nothing
	End Sub

	Public Property Get ErrInfo()
		Select Case ErrCode
			Case 1 : ErrInfo="您的系统不支持FSO组件!"
			Case 20 : ErrInfo="创建错误:已经存在的文件!"
			Case 21 : ErrInfo="创建错误: 新建文件时发生错误!"
			Case 30 : ErrInfo="创建错误: 已经存在的文件夹!"
			Case 31 : ErrInfo="创建错误: 新建文件夹时发生错误!"
			Case 40 : ErrInfo="读取错误: 不存在的文件!"
			Case 41 : ErrInfo="读取错误: 读文件时发生错误!"
			Case 50 : ErrInfo="保存错误: 不存在的文件!"
			Case 51 : ErrInfo="保存错误: 保存文件时发生错误!"
			Case 60 : ErrInfo="命名错误: 不存在的旧文件!"
			Case 61 : ErrInfo="命名错误: 重命名文件时发生错误!"
            Case 62 : ErrInfo="命名错误:已存在的新文件名称!"
			Case 63 : ErrInfo="命名错误:新旧文件名称后缀不一致!"
			Case 70 : ErrInfo="命名错误: 不存在的旧文件夹名称!"
			Case 71 : ErrInfo="命名错误: 重命名文件夹时发生错误!"
			Case 72 : ErrInfo="命名错误:已存在的新文件名称!"
			Case 80 : ErrInfo="删除错误: 不存在的文件!"
			Case 81 : ErrInfo="删除错误: 删除文件时发生错误!"
			Case 90 : ErrInfo="删除错误: 不存在的文件夹!"
			Case 91 : ErrInfo="删除错误: 删除文件夹时发生错误!"
			Case 100 : ErrInfo="复制错误: 不存在的文件!"
			Case 101 : ErrInfo="复制错误: 复制文件时发生错误!"
			Case 110 : ErrInfo="复制错误: 不存在的文件夹!"
			Case 111 : ErrInfo="复制错误: 复制文件夹时发生错误!"
			Case 120 : ErrInfo="读取文件夹错误: 不存在的文件夹路径!"
			Case 121 : ErrInfo="读取文件夹错误: 此文件夹为空!"
			Case Else
				ErrInfo=Empty
		End Select
	End Property
	'创建文件
	'filePath:文件路径
	'fileContent:文件内容
	'fileCharset:字符编码
	Public Sub CreateFile(ByVal filePath,ByVal fileContent,ByVal fileCharset)
		On Error Resume Next
		Dim Obj
		filePath=FilterPath(filePath)
		If Not IsExists(filePath,1) Then
			Set Obj = CreateObject("Adodb.Stream")
			With Obj
				.Type=2
				.Mode=3
				.CharSet=fileCharset
				.Open
				.WriteText fileContent
				.SaveToFile filePath,2
				.Flush
			End With
			Obj.Close:Set Obj=Nothing
		Else
			ErrCode=20
		End If
		If Err.Number<>0 Then
			Err.Clear
			ErrCode=21
		End If
	End Sub
	'创建文件夹
	'filePath:文件夹路径
	Public Sub CreateFolder(ByVal filePath)
		On Error Resume Next
		filePath=FilterPath(filePath)
		If Not IsExists(filePath,2) Then
			FSO.CreateFolder(filePath)
		Else
			ErrCode=30
		End If
		If Err.Number<>0 Then 
			Err.Clear
			ErrCode=31
		End If
	End Sub
	'读取文件
	'filePath:文件路径
	'fileCharset:文件编码
	'************************
	Public Function ReadFile(ByVal filePath,ByVal fileCharset)
		On Error Resume Next
		Dim Obj,fileContent
		filePath=FilterPath(filePath)
		If IsExists(filePath,1) Then 
			Set Obj=CreateObject("Adodb.Stream")
			With Obj
				.Type=2
				.Mode=3
				.CharSet=fileCharset
				.Open
				.LoadFromFile filePath
			End With
			fileContent=Obj.ReadText
			Obj.Close:Set Obj=Nothing
		Else
			ErrCode=40
		End If
		If Err.Number<>0 Then
			Err.Clear
			ErrCode=41
		End If
		ReadFile=fileContent
	End Function
	'读取指定目录下文件的属性
	'参数:
	'	fIndex(-1:显示所有属性列表字符串 -2:返回获取的数组数据)
	'	fSpace (间隔字符)
	'	fileType (1为文件 2 为文件夹)
	'返回:文件夹属性列表串
	Public Function FileAttribute(ByVal filePath,ByVal fIndex,ByVal fSpace,ByVal fileType)
		Dim TempArr(7),TempStr
		filePath=FilterPath(filePath)
		If IsExists(filePath,fileType) Then
			Select Case fileType
				Case 1
					Set ObjFile=FSO.GetFile(filePath)
						TempArr(0)=ObjFile.Size '文件大小
						TempArr(1)=LCase(Right(filePath,4)) '获取文件名称后缀
						TempArr(2)=ObjFile.DateCreated '文件创建日期
						TempArr(3)=ObjFile.Type '文件信息
						TempArr(4)=ObjFile.DateLastModified '文件最后修改时间
						TempArr(5)=ObjFile.Path '文件路径
						TempArr(6)=ObjFile.Name '文件名称
					Set ObjFile=Nothing
				Case 2
					Set ObjFolder=FSO.GetFolder(filePath)
						TempArr(0)=ObjFolder.Size '文件大小
						TempArr(1)=ObjFolder.DateCreated '文件创建日期
						TempArr(2)=ObjFolder.Type '文件信息
						TempArr(3)=ObjFolder.DateLastModified '文件最后修改时间
						TempArr(4)=ObjFolder.Path '文件路径
						TempArr(5)=ObjFolder.Name '文件名称
						TempArr(6)=""
					Set ObjFolder=Nothing
			End Select
		Else
			ErrCode=40
		End If
		If fIndex=-1 Then
			TempStr=Join(TempArr,fSpace)
		ElseIf fIndex=-2 Then
			TempStr=TempArr
		ElseIf (fIndex>=0 Or fIndex0 Then 
			Err.Clear
			ErrCode=51
		End If
	End Sub
	'重命名文件
	'filePath:文件路径
	'fileName:文件名
	Public Sub RenameFile(ByVal filePath,ByVal fileName)
		On Error Resume Next
		Dim F_NewPath,F_OldPath,O_Suffix,N_Suffix
		If InstrRev(filePath,":")>0 Then 'Absolute Path
			F_OldPath=filePath
			F_NewPath=Left(filePath,InstrRev(filePath,"\"))&fileName
		Else
			F_OldPath=Server.MapPath(filePath)
			F_NewPath=Server.MapPath(Left(filePath,InstrRev(filePath,"/"))&fileName)
		End If
		If IsExists(F_OldPath,1) Then
			O_Suffix=Mid(F_OldPath,InstrRev(F_OldPath,".")+1)
			N_Suffix=Mid(F_NewPath,InstrRev(F_NewPath,".")+1)
			If Not IsExists(F_NewPath,1) And O_Suffix=N_Suffix Then
				Set ObjFile=FSO.GetFile(F_OldPath)
				ObjFile.Name=fileName
				Set ObjFile=Nothing
			Else
				ErrCode=62
			End If
			If O_Suffix<>N_Suffix Then ErrCode=63
		Else
			ErrCode=60
		End If
		If Err.Number<>0 Then
			Err.Clear
			ErrCode=61
		End If
	End Sub
	'重命名文件夹
	'filePath:文件路径
	'fileName:文件名
	Public Sub RenameFolder(ByVal filePath,ByVal fileName)
		On Error Resume Next
		Dim F_NewPath,F_OldPath
		If InstrRev(filePath,":")>0 Then 'Absolute Path
			F_OldPath=filePath
			F_NewPath=Left(filePath,InstrRev(filePath,"\"))&fileName
		Else
			F_OldPath=Server.MapPath(filePath)
			F_NewPath=Server.MapPath(Left(filePath,InstrRev(filePath,"/"))&fileName)
		End If
		If IsExists(F_OldPath,2) Then
			If Not IsExists(F_NewPath,2) Then
				Set ObjFolder=FSO.GetFolder(F_OldPath)
				ObjFolder.Name=fileName
				Set ObjFolder=Nothing
			Else
				ErrCode=72
			End If
		Else
			ErrCode=70
		End If
		If Err.Number<>0 Then
			Err.Clear
			ErrCode=71
		End If
	End Sub
	'删除文件
	'filePath:文件路径
	Public Sub DelFile(ByVal filePath)
		On Error Resume Next
		filePath=FilterPath(filePath)
		If IsExists(filePath,1) Then
			FSO.DeleteFile(filePath)
		Else
			ErrCode=80
		End If
		If Err.Number<>0 Then
			Err.Clear
			ErrCode=81
		End If
	End Sub
    '删除文件夹
	'filePath:文件路径
	Public Sub DelFolder(ByVal filePath)
		On Error Resume Next
		filePath=FilterPath(filePath)
		If IsExists(filePath,2) Then
			FSO.DeleteFolder(filePath)
		Else
			ErrCode=90
		End If
		If Err.Number<>0 Then
			Err.Clear
			ErrCode=91
		End If
	End Sub
	'复制文件
	'filePath:文件路径
	'newPath:复制路径
	Public Sub CopyToFile(ByVal filePath,ByVal newPath)
		On Error Resume Next
		filePath=ConvertPath(filePath)
		newPath=FilterPath(newPath)
		If IsExists(filePath,1) Then
			FSO.CopyFile filePath,newPath
		Else
			ErrCode=100
		End If
		If Err.Number<>0 Then
			Err.Clear
			ErrCode=101
		End If
	End Sub
    '复制文件夹
	'filePath:文件路径
	'newPath:复制路径
	Public Sub CopyToFolder(ByVal filePath,ByVal newPath)
		On Error Resume Next
		filePath=ConvertPath(filePath)
		newPath=FilterPath(newPath)
		If IsExists(filePath,2) Then
			FSO.CopyFolder filePath,newPath 
		Else
			ErrCode=110
		End If
		If Err.Number<>0 Then
			Err.Clear
			ErrCode=111
		End If
	End Sub

	'检测文件或文件夹是否存在
	'filePath:文件路径
	'fileType (1为文件 2 为文件夹)
	Public Function IsExists(ByVal filePath,ByVal fileType)
		Dim Flag:Flag=False
		filePath=FilterPath(filePath)
		Select Case fileType
			Case 1 
				If FSO.FileExists(filePath) Then:Flag=True
			Case 2 
				If FSO.FolderExists(filePath) Then:Flag=True
		End Select	
		IsExists=Flag	
	End Function
	'格式化路径
	Public Function FilterPath(ByVal filePath)
		Dim re,tPath
		tPath=Replace(filePath,"/","\")
		tPath=Replace(tPath,"//","\")
		If Trim(tPath)="" Then Exit Function
		Set re=New RegExp
		re.IgnoreCase=True
		re.Global=True
		re.Pattern="\**\?*\""*\*\|*"
		tPath=re.Replace(tPath,"")
		Set re=Nothing
		If Instr(tPath,":")=0 Then tPath=Server.MapPath(tPath) 'Convert Relative Path
		FilterPath=tPath
	End Function
	'转换路径
	Public Function ConvertPath(ByVal filePath)
		If Trim(filePath)="" Then Exit Function
		If Instr(filePath,":")=0 Then filePath=Server.MapPath(filePath)
		ConvertPath=filePath
	End Function
	'文件大小
	Public Function FormatSize(ByVal ByteSize)
		If ByteSize=>1024000000 Then
			ByteSize=formatnumber(ByteSize/1024000000)&" GB"
		ElseIf ByteSize=>1024000 Then
			ByteSize=formatnumber(ByteSize/1024000)&" MB"
		ElseIf ByteSize=>1024 Then
			ByteSize=formatnumber(ByteSize/1024)&" KB"
		Else
			ByteSize=ByteSize&" Byte"
		End If
		FormatSize=ByteSize
	End Function
End Class

用法:

set fso = new FsoClass
response.Write(fso.FileAttribute("index.asp",-2,",",1))

发表评论

电子邮件地址不会被公开。 必填项已用*标注