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

http://www.aspku.com/kaifa/asp/4293.html