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


            复制代码 代码如下:'===================================== '获得文件后缀 '===================================== 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