fso.asp

1

<%
Dim fso

'读取模板
Function MB_FSOFileRead(MB_Template_Name,MB_FG_Name) 
If IsFolder(""&InstallDir&"template/"&MB_FG_Name)=false Then
MB_FG_Name=FY_Config(16)
End if
Dim MB_objFSO,MB_objCountFile,FiletempData 
Set MB_objFSO = Server.CreateObject("Scripting.FileSystemObject") 
Set MB_objCountFile = MB_objFSO.OpenTextFile(Server.MapPath(""&InstallDir&"template/"&MB_FG_Name&"/"&MB_Template_Name&".Html"),1,True) 
If MB_objCountFile.AtEndOfStream = false Then MB_FSOFileRead = MB_objCountFile.ReadAll 
MB_objCountFile.Close 
Set MB_objCountFile=Nothing 
Set MB_objFSO = Nothing 
End Function

'----------------FSO操作------------------------------
'读取文件
Function FSOFileRead(Template_Name) 
Dim objFSO,objCountFile,FiletempData 
Set objFSO = Server.CreateObject("Scripting.FileSystemObject") 
Set objCountFile = objFSO.OpenTextFile(Server.MapPath(Template_Name),1,True) 
If objCountFile.AtEndOfStream = false Then FSOFileRead = objCountFile.ReadAll 
objCountFile.Close 
Set objCountFile=Nothing 
Set objFSO = Nothing 
End Function

'读取TXT保存信息
Function TXT_N(TXT_N_A,TXT_N_B,TXT_N_C,TXT_N_D) 
TXT_N=TXT_N_A
End Function

'创建文件夹
Function CreateFolder(fldr) 
'on error resume next
If IsFolder(fldr)=false Then
	Dim fso, f
	Set fso = CreateObject("Scripting.FileSystemObject")
	Set f = fso.CreateFolder(Server.MapPath(fldr))
	CreateFolder = f.Path
	Set f=nothing
	Set fso=nothing
Select Case Err       
     Case 424 Response.Write "路径未找到或者该目录没有写入权限."
End Select
End if
End Function




'../HtmlFolder/menu.html
'创建文件
'path 路径
'str 内容
Function createhtml(path,str)
Dim GetFold,e,fldr,fout
'On Error Resume Next
If InStr(UCase(path),UCase(".asp"))>0 Then
Response.Write "程序发生致命错误，请到论坛 http://bbs.kenqiao.net 进行信息反馈<br>必须将自己的操作步骤反馈上来，否则将可能影响解决问题的时间."
Response.End
End IF
GetFold=split(path,"/")
For e=0 to Ubound(GetFold)-1
    if fldr="" then
      if GetFold(e)="" Then
        fldr=".."
      Else
        fldr=GetFold(e)
      End if
    else
	    fldr=fldr&"/"&GetFold(e)
    end if
	If IsFolder(fldr)=false then
		CreateFolder fldr
	End if
Next

Set fso = Server.CreateObject("Scripting.FileSystemObject")
Set fout = fso.CreateTextFile(server.mappath(path))
fout.Write str
fout.close
set fso = nothing
Select Case Err       
     Case 424 Response.Write "路径未找到或者该目录没有写入权限."
End Select
End Function



'删除文件夹
Function delfolder(path)
If IsFolder(path)=True Then
	Set fso = CreateObject("Scripting.FileSystemObject")
	fso.DeleteFolder(server.mappath(path))
	set fso = Nothing
End If 
End Function 


'删除文件
Function delfile(path)
On Error Resume Next
If IsExists(path)=True Then 
	set fso = server.CreateObject("Scripting.FileSystemObject")
	fso.DeleteFile(server.mappath(path))
	set fso = nothing
End If
Select Case Err      
     Case 424 Response.Write "路径未找到或者该目录没有写入权限."
End Select
End Function 
 
 
'检测文件是否存在
Function IsExists(filespec) 
	Dim fso
	Set fso = CreateObject("Scripting.FileSystemObject")
	If (fso.FileExists(server.MapPath(filespec))) Then
	IsExists = True
	Else
	IsExists = False
	End If
	Set fso=nothing
End Function

'检测文件夹是否存在
Function IsFolder(Folder)
    Set fso = CreateObject("Scripting.FileSystemObject")
	If FSO.FolderExists(server.MapPath(Folder)) Then  
	IsFolder = True
	Else
	IsFolder = False
	End If
	Set fso=nothing
End Function

'nowfld 目前文件夹
'newfld 新的文件夹名字
Function fldrename(nowfld,newfld)
	on error resume next
	if UCase(nowfld)<>UCase(newfld) then
		nowfld=server.mappath(nowfld)
		newfld=server.mappath(newfld)
		Set fso = CreateObject("Scripting.FileSystemObject")
		if not fso.FolderExists(nowfld) then
			response.write("需要修改的文件夹路径不正确")
		else
			fso.CopyFolder nowfld,newfld
			fso.DeleteFolder(nowfld)
		end if
		set fso=nothing
		Select Case Err       
			Case 424 Response.Write "路径未找到或者该目录没有写入权限."
		End Select
	end if
End Function

'获取目录下的文件夹
function  getfolders(folderpath_template)
Dim objFS,objFolder,Folder,str,dirstr
set objFS = Server.CreateObject("Scripting.FileSystemObject")
set objFolder = objFS.GetFolder(server.MapPath(folderpath_template))
for each folder in objFolder.SubFolders
	str = folder.name
	dirstr = str & ","&dirstr
next
getfolders=dirstr
set objFolder = nothing
set objFS = nothing
end function
%>