asp中文件与文件夹常用处理函数(文件后缀、创建

本文主要是介绍asp中文件与文件夹常用处理函数(文件后缀、创建，希望对大家解决编程问题提供一定的参考价值，需要的开发者们随着小编来一起学习吧！

asp中尤其是需要生产静态的cms系统中，经常需要对一些文件进行判断与创建，删除的操作，这里整理了一些，基本上满足了基本需要。

复制代码代码如下:

 
 '=====================================  
 '获得文件后缀  
 '=====================================  
 Function Get_Filetxt(ByVal t0)  
 Dim t1  
 IF Len(t0)<2 Or Instr(t0,".")=0 Then Get_Filetxt=False:Exit Function  
 t1=Split(t0,".")  
 Get_Filetxt=Lcase(t1(Ubound(t1)))  
 End Function  
 
 '=====================================  
 '读取任何文件的纯代码  
 '=====================================  
 Function LoadFile(ByVal t0)  
 IF Len(t0)=0 Then Exit Function  
 IF Sdcms_Cache Then  
 IF Check_Cache("LoadFile_"&t0) Then  
 Create_Cache "LoadFile_"&t0,LoadFile_Cache(t0)  
 End IF  
 LoadFile=Load_Cache("LoadFile_"&t0)  
 Else  
 LoadFile=LoadFile_Cache(t0)  
 End IF  
 End Function  
 
 Function LoadFile_Cache(ByVal t0)  
 Dim t1,stm  
 On Error Resume Next  
 IF Len(t0)=0 Then Exit Function  
 t1=Empty  
 Set Stm=Server.CreateObject("Adodb.Stream")  
 With Stm  
 .Type=2'以本模式读取  
 .mode=3  
 .charset=CharSet  
 .Open  
 .loadfromfile Server.MapPath(t0)  
 t1=.readtext  
 .Close  
 End With  
 Set Stm=Nothing  
 IF Err Then  
 LoadFile_Cache="“"&t0&"”"&Err.Description:Err.Clear  
 Else  
 LoadFile_Cache=t1  
 End IF  
 End Function  
 
 '=====================================  
 '检查文件是否存在  
 '=====================================  
 Function Check_File(ByVal t0)  
 Dim Fso  
 t0=Server.MapPath(t0)  
 Set Fso=CreateObject("Scripting.FileSystemObject")  
 Check_File=Fso.FileExists(t0)  
 Set Fso=Nothing  
 End Function  
 
 '=====================================  
 '检查文件夹是否存在  
 '=====================================  
 Function Check_Folder(ByVal t0)  
 Dim Fso  
 t0=Server.MapPath(t0)  
 Set Fso=CreateObject("Scripting.FileSystemObject")  
 Check_Folder=Fso.FolderExists(t0)  
 Set Fso=Nothing  
 End Function  
 
 '=====================================  
 '创建文件夹（无限级）  
 '=====================================  
 Function Create_UpFile(ByVal t0)  
 Dim t1,t2,objFSO,i  
 On Error Resume Next  
 t0=Server.MapPath(t0)  
 IF InStr(t0,"\")<=0 Or InStr(t0,":")<=0 Then:Create_upfile=False:Exit Function  
 Set objFSO=CreateObject("Scripting.FileSystemObject")  
 IF objFSO.FolderExists(t0) Then:Create_upfile=True:Exit Function  
 t1=Split(t0,"\"):t2=""  
 For i=0 To UBound(t1)  
 t2=t2&t1(i)&"\"  
 IF Not objFSO.FolderExists(t2) Then objFSO.CreateFolder(t2)  
 Next  
 Set objFSO=Nothing  
 IF Err=0 Then Create_upfile=True:Else Create_upfile=False:Echo "Create_upfile："&Err.Description&"<br>":Err.Clear  
 End Function  
 
 Sub SaveFile(ByVal t0,ByVal t1,ByVal t2)  
 Dim objFSO,t3  
 Set objFSO=CreateObject("Scripting.FileSystemObject")  
 IF t0="" Then Echo "目录不能为空！":Died  
 t3=Server.MapPath(t0)  
 IF t2="" Or IsNull(t2) Then t2=""  
 IF objFSO.FolderExists(t3)=False Then Create_upfile(t0)  
 BuildFile t3&"\"&Trim(t1),t2  
 Set objFSO=Nothing  
 End Sub  
 
 Function BuildFile(ByVal t0,ByVal t1)  
 Dim Stm  
 On Error Resume Next  
 Set Stm=Server.CreateObject("Adodb.Stream")  
 With Stm  
 .Type=2 '以本模式读取  
 .Mode=3  
 .Charset=CharSet  
 .Open  
 .WriteText t1  
 .SaveToFile t0,2  
 .Close  
 End With  
 Set Stm=Nothing  
 IF Err Then Echo "BuildFile："&Err.Description&"<br>":Err.Clear  
 End Function  
 
 '=====================================  
 '重命名文件夹  
 '=====================================  
 Sub RenameFile(ByVal t0,ByVal t1)  
 Dim Fso  
 On Error Resume Next  
 Set Fso=Server.CreateObject("Scripting.FileSystemObject")  
 IF Fso.FolderExists(Server.MapPath(t0)) Then  
 Fso.MoveFolder Server.MapPath(t0),Server.MapPath(t1)  
 End IF  
 Set Fso=Nothing  
 IF Err Then Echo "Renamefile："&Err.Description&"<br>":Err.Clear  
 End Sub  
 
 '=====================================  
 '重命名文件  
 '=====================================  
 Sub RenameHtml(ByVal t0,ByVal t1)  
 Dim Fso  
 On Error Resume Next  
 Set Fso=Server.CreateObject("Scripting.FileSystemObject")  
 IF Fso.FileExists(Server.MapPath(t0)) Then  
 Fso.MoveFile Server.MapPath(t0),Server.MapPath(t1)  
 End IF  
 Set Fso=Nothing  
 IF Err Then Echo "Renamehtml："&Err.Description&"<br>":Err.Clear  
 End Sub  
 
 '=====================================  
 '删除文件夹  
 '=====================================  
 Sub DelFile(ByVal t0)  
 Dim Fso,F  
 On Error Resume Next  
 Set Fso=Server.CreateObject("Scripting.FileSystemObject")  
 Set F=fso.GetFolder(Server.MapPath(t0))  
 IF Not IsNull(t0) Then F.Delete True  
 IF Err Then Echo "Delfile："&Err.Description&"<br>":Err.Clear  
 End Sub  
 
 '=====================================  
 '删除文件  
 '=====================================  
 Sub DelHtml(ByVal t0)  
 Dim Fso  
 On Error Resume Next  
 Set Fso=Server.CreateObject("Scripting.FileSystemObject")  
 IF Fso.FileExists(Server.MapPath(t0)) Then Fso.DeleteFile Server.MapPath(t0)  
 IF Err Then Echo "DelHtml："&Err.Description&"<br>":Err.Clear  
 End Sub  
 
 Function Re_FileName(ByVal t0)  
 Dim t1  
 t0=Lcase(t0)  
 IF Len(t0)=0 Then Re_FileName="{id}":Exit Function  
 t1=Now()  
 '处理自定义文件名  
 
 'IF Instr(t0,"{")>0 And Instr(t0,"}")>0 Then  
 'IF Instr(t0,"{id}")=0 Then  
 't0=t0&"{id}"'尽量防止重复  
 'End IF  
 'End IF  
 t0=Replace(t0,"{y}",Year(t1))  
 t0=Replace(t0,"{m}",Right("0"&Month(t1),2))  
 t0=Replace(t0,"{d}",Right("0"&Day(t1),2))  
 t0=Replace(t0,"{h}",Right("0"&Hour(t1),2))  
 t0=Replace(t0,"{mm}",Right("0"&Minute(t1),2))  
 t0=Replace(t0,"{s}",Right("0"&Second(t1),2))  
 Re_FileName=t0  
 End Function 