www.gusucode.com > CC校友录贴吧 CCBar源码程序asp编程 > inc/inc_file_func.asp

    <%
''===================================================================
'= ASP FILENAME	: /inc/inc_file_func.asp
'= CREATED TIME : 2006-5-7
'= LAST MODIFIED: 2006-5-7
'= VERSION INFO : CCASP Framework Ver 2.0.1 ALL RIGHTS RESERVED BY www.cclinux.com
'= DESCRIPTION  : 与FSO及其存取操作有关函数库
'= Change Log:
'==================================================================='

''===================================================================
'= Function     : fsoWriteToFile(strInStr,strFileName,intMode)
'= Time		    : Created At SEP,19,2003
'= Input        : Contents(strInStr),Destination File(strFileName)
'= Description  : Write Something To Destination File
'==================================================================='
Function fsoWriteToFile(strInStr,strFileName,intMode)
	'== intMode : 10,重写服务器文本; 11,追加服务器文本
	'==           20,重写本地文本; 21,追加本地文本

	On Error Resume Next

	Const ForReading = 1, ForWriting = 2, ForAppending = 8
    Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
	Dim objFSO,strFile,f,strWriteClew

	'== check the server is or not support fso
	If Not CheckObjInstalled("Scripting.FileSystemObject",strWriteClew) Then
		Exit Function
	End If

	Set objFSO = Server.CreateObject("Scripting.FileSystemObject") 
	If intMode = 10 Then
		Set strFile = objFSO.CreateTextFile(Server.Mappath(strFileName), true,false) 
	ElseIf intMode = 11 Then
		Set strFile = objFSO.CreateTextFile(Server.Mappath(strFileName), true,false)
	ElseIf intMode = 20 Then
		Set f = objFSO.GetFile(strFileName)
		Set strFile = f.OpenAsTextStream(ForWriting, TristateUseDefault)
	ElseIf intMode = 21 Then
		Set f = objFSO.GetFile(strFileName)
		Set strFile = f.OpenAsTextStream(ForAppending, TristateUseDefault)
	End If
	strFile.WriteLine(strInStr) 
	strFile.Close

	Set f = Nothing
	Set strFile = Nothing
	Set objFSO = Nothing

End Function

''===================================================================
'= Function     : fsoReadFile(strFileName)
'= Time		    : Created At SEP,19,2003
'= Input        : Contents(strInStr),Destination File(strFileName)
'= Output       : Some File
'= Description  : Read Something From Destination File
'==================================================================='
Function fsoReadFile(strFileName)

	Dim objFSO,strFile

	Set objFSO = Server.CreateObject("Scripting.FileSystemObject") 
	Set strFile = objFSO.OpenTextfile(Server.Mappath(strFileName), 1) 
	Do Until strFile.AtEndOfStream
		Response.write("Name: " & strFile.ReadLine & " ")
	Loop
	strFile.Close
	Set strFile = Nothing
	Set objFSO = Nothing

End Function

''====================================================================
'= Function     : fsoDeleteFile(strFileName)
'= Time		    : Created At DEC,22,2003
'= Input        : strFileName: Destination File
'= Description  : delete file
'===================================================================='
Function fsoDeleteFile(strFileName)

	'On Error Resume Next

	Dim objFSO
	Dim strDelClew

	'== check the server is or not support fso
	If Not CheckObjInstalled("Scripting.FileSystemObject",strDelClew) Then
		Exit Function
	End If

	Set objFSO = CreateObject("Scripting.FileSystemObject") 
	'== get file
	If objFSO.FileExists(Server.Mappath(strFileName)) then
		objFSO.DeleteFile Server.Mappath(strFileName),True
		fsoDeleteFile = True
	Else
		fsoDeleteFile = False
	End If

	Set objFSO = Nothing

End Function


''====================================================================
'= Function     : fsoMoveFile(strFileName)
'= Time		    : Created At DEC,22,2003
'= Input        : strFileName: Source File
'=				  strDesPathName : destination file path and name
'= Description  : move file
'===================================================================='
Function fsoMoveFile(strFileName,strDesPathName)

	Dim objFSO
	Dim f
	
	Set objFSO = CreateObject("Scripting.FileSystemObject") 
	'== get file
	Set f = objFSO.GetFile(Server.Mappath(strFileName)) 
	f.Move(Server.Mappath(strDesPathName)) 

	Set f = Nothing
	Set objFSO = Nothing

End Function


''====================================================================
'= Function     : fsoCopyFile(strFileName,strDesPathName)
'= Time		    : Created At DEC,22,2003
'= Input        : strFileName: Source File
'=				  strDesPathName : destination file path and name
'= Description  : copy file
'===================================================================='
Function fsoCopyFile(strFileName)

	Dim objFSO
	Dim f
	
	Set objFSO = CreateObject("Scripting.FileSystemObject") 
	'== get file
	Set f = objFSO.GetFile(Server.Mappath(strFileName)) 
	f.Copy(Server.Mappath(strDesPathName)) 

	Set f = Nothing
	Set objFSO = Nothing

End Function


''====================================================================
'= Function     : ReadDisplayFile(strIncludeFile) 
'= Time		    : Created At 9,14,2003
'= Input        : The including file
'= Description  : Return some file content
'===================================================================='
Function ReadDisplayFile(strIncludeFile)

	Dim objFSO 
	Dim objText 
	Dim strGetFileContents

	'== 初始化FileSystemObject对象 
	Set objFSO = Server.CreateObject("Scripting.FileSystemObject") 

	'== 打开文件并把它传递给TextStream对象(objText)。Server对象的 
	'== MapPath函数用于获得文件的物理路径 
	Set objText = objFSO.OpenTextFile(Server.MapPath(strIncludeFile)) 

	'== 读取并以字符串形式返回文件内容 
	strGetFileContents = objText.ReadAll 

	objText.Close 
	Set objText = Nothing 
	Set objFSO = Nothing 

	'== 输出包含文件内容
	ReadDisplayFile = strGetFileContents

End Function


''===================================================================
'= Function     : WriteLog(strFileName)
'= Time		    : Created At 10,15,2003
'= Input        : The including file
'= Description  : Return some file content
'===================================================================='
Function WriteLog(strFileName)

	Dim strGetPost,strDivider,strTmp
	
	strDivider = "=========================================" & Chr(10)
	strGetPost = "Now action = " & Trim(Request("action"))
	Call fsoWriteToFile(strDivider,strFileName,21)
	Call fsoWriteToFile(strGetPost,strFileName,21)
	Call fsoWriteToFile(strDivider,strFileName,21)

End Function


''===================================================================
'= Function          : readAllFolderFiles(strFolder)
'= Time		    : Created At 10,15,2003
'= Input        : The including file
'= Description  : 读取目录下所有文件
'===================================================================='
Function readAllFolderFiles(strFolder)

	strFolderPath= Server.MapPath(strFolder)
	Set objFileSystem = Server.CreateObject("Scripting.FileSystemObject")
	Set sFolder = objFileSystem.GetFolder(strFolderPath)
	Set objFiles = sFolder.Files
	For Each FileItem In objFiles
		response.write FileItem.name & "<br>"
	Next

    Set objFiles = Nothing 
	Set objFileSystem = Nothing 

End Function


''===================================================================
'= Function          : readFileInfo(strFileName)
'= Time		    : Created At 10,15,2003
'= Input        : The including file
'= Description  : 读取文件信息
'===================================================================='
Function readFileInfo(strFileName,flag)

	'== flag  0  显示文件所有信息
	'==		  1  返回文件类型	

	file = Server.MapPath(strFileName) 
	Set fsoFile = CreateObject("Scripting.FileSystemObject") 
	Set file = fsoFile.GetFile(file) 

	s = "文件名称：" & file.name & "<br>" 
	s = s & "文件短路径名：" & file.shortPath & "<br>" 
	s = s & "文件物理地址：" & file.Path & "<br>" 
	s = s & "文件属性：" & file.Attributes & "<br>" 
	s = s & "文件大小： " & file.size & "<br>" 
	s = s & "文件类型： " & file.type & "<br>" 
	s = s & "文件创建时间： " & file.DateCreated & "<br>" 
	s = s & "最近访问时间: " & file.DateLastAccessed & "<br>" 
	s = s & "最近修改时间: " & file.DateLastModified 

	Select Case flag
		Case 0 : 
			Response.Write(s) 
		Case 1 :
			readFileInfo = file.type
	End Select

	Set fsoFile = Nothing
	Set file = Nothing

End Function

''===================================================================
'= Function     : LoadFile)
'= Time		    : Created At 2006-5-7
'= Input        : File : 文件名
'= Description  : 读取文件信息
'===================================================================='
Function LoadFile(ByVal File)
    Dim objStream
    On Error Resume Next
    Set objStream = Server.CreateObject("ADODB.Stream")
    If Err.Number=-2147221005 Then 
        Response.Write "<div align='center'>非常遗憾,您的主机不支持ADODB.Stream,不能使用本程序</div>"
        Err.Clear
        Response.End
    End If
    With objStream
        .Type = 2
        .Mode = 3
        .Open
        .LoadFromFile Server.MapPath(File)
        If Err.Number<>0 Then
			Response.Write "<div align='center'>文件<font color='#ff0000'>"&File&"</font>无法被打开，请检查是否存在!</font></div>"
			Err.Clear
			Response.End
        End If
        .Charset = "GB2312"
        .Position = 2
        LoadFile = .ReadText
        .Close
    End With
    Set objStream = Nothing
End Function

''===================================================================
'= Function     : SaveToFile)
'= Time		    : Created At 2006-5-7
'= Input        : File : 文件名
'= Input        : strBody : 文件内容
'= Description  : 保存文件信息
'===================================================================='
Function SaveToFile(ByVal strBody,ByVal File)
    Dim objStream
    On Error Resume Next
    Set objStream = Server.CreateObject("ADODB.Stream")
		If Err.Number=-2147221005 Then 
			Msg = "提示信息:非常遗憾,您的主机不支持ADODB.Stream,不能使用本程序"
			Url = "javascript:history.go(-1)"
			CALL Msg_Box(Msg,Url)
			Err.Clear
			Response.End
		End If
		With objStream
			.Type = 2
			.Open
			.Charset = "GB2312"
			.Position = objStream.Size
			.WriteText = strBody
			.SaveToFile Server.MapPath(File),2
			.Close
		End With
    Set objStream = Nothing
	Response.Write """"&File&""" save successfully!"&"<BR>"
End Function

%>