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

"=====================================
"获得文件后缀
"=====================================
FunctionGet_Filetxt(ByValt0)
Dimt1
IFLen(t0)<2OrInstr(t0,".")=0ThenGet_Filetxt=False:ExitFunction
t1=Split(t0,".")
Get_Filetxt=Lcase(t1(Ubound(t1)))
EndFunction

"=====================================
"读取任何文件的纯代码
"=====================================
FunctionLoadFile(ByValt0)
IFLen(t0)=0ThenExitFunction
IFSdcms_CacheThen
IFCheck_Cache("LoadFile_"&t0)Then
Create_Cache"LoadFile_"&t0,LoadFile_Cache(t0)
EndIF
LoadFile=Load_Cache("LoadFile_"&t0)
Else
LoadFile=LoadFile_Cache(t0)
EndIF
EndFunction

FunctionLoadFile_Cache(ByValt0)
Dimt1,stm
OnErrorResumeNext
IFLen(t0)=0ThenExitFunction
t1=Empty
SetStm=Server.CreateObject("Adodb.Stream")
WithStm
.Type=2"以本模式读取
.mode=3
.charset=CharSet
.Open
.loadfromfileServer.MapPath(t0)
t1=.readtext
.Close
EndWith
SetStm=Nothing
IFErrThen
LoadFile_Cache="“"&t0&"”"&Err.Description:Err.Clear
Else
LoadFile_Cache=t1
EndIF
EndFunction

"=====================================
"检查文件是否存在
"=====================================
FunctionCheck_File(ByValt0)
DimFso
t0=Server.MapPath(t0)
SetFso=CreateObject("Scripting.FileSystemObject")
Check_File=Fso.FileExists(t0)
SetFso=Nothing
EndFunction

"=====================================
"检查文件夹是否存在
"=====================================
FunctionCheck_Folder(ByValt0)
DimFso
t0=Server.MapPath(t0)
SetFso=CreateObject("Scripting.FileSystemObject")
Check_Folder=Fso.FolderExists(t0)
SetFso=Nothing
EndFunction

"=====================================
"创建文件夹（无限级）
"=====================================
FunctionCreate_UpFile(ByValt0)
Dimt1,t2,objFSO,i
OnErrorResumeNext
t0=Server.MapPath(t0)
IFInStr(t0,"\")<=0OrInStr(t0,":")<=0Then:Create_upfile=False:ExitFunction
SetobjFSO=CreateObject("Scripting.FileSystemObject")
IFobjFSO.FolderExists(t0)Then:Create_upfile=True:ExitFunction
t1=Split(t0,"\"):t2=""
Fori=0ToUBound(t1)
t2=t2&t1(i)&"\"
IFNotobjFSO.FolderExists(t2)ThenobjFSO.CreateFolder(t2)
Next
SetobjFSO=Nothing
IFErr=0ThenCreate_upfile=True:ElseCreate_upfile=False:Echo"Create_upfile："&Err.Description&"<br>":Err.Clear
EndFunction

SubSaveFile(ByValt0,ByValt1,ByValt2)
DimobjFSO,t3
SetobjFSO=CreateObject("Scripting.FileSystemObject")
IFt0=""ThenEcho"目录不能为空！":Died
t3=Server.MapPath(t0)
IFt2=""OrIsNull(t2)Thent2=""
IFobjFSO.FolderExists(t3)=FalseThenCreate_upfile(t0)
BuildFilet3&"\"&Trim(t1),t2
SetobjFSO=Nothing
EndSub

FunctionBuildFile(ByValt0,ByValt1)
DimStm
OnErrorResumeNext
SetStm=Server.CreateObject("Adodb.Stream")
WithStm
.Type=2"以本模式读取
.Mode=3
.Charset=CharSet
.Open
.WriteTextt1
.SaveToFilet0,2
.Close
EndWith
SetStm=Nothing
IFErrThenEcho"BuildFile："&Err.Description&"<br>":Err.Clear
EndFunction

"=====================================
"重命名文件夹
"=====================================
SubRenameFile(ByValt0,ByValt1)
DimFso
OnErrorResumeNext
SetFso=Server.CreateObject("Scripting.FileSystemObject")
IFFso.FolderExists(Server.MapPath(t0))Then
Fso.MoveFolderServer.MapPath(t0),Server.MapPath(t1)
EndIF
SetFso=Nothing
IFErrThenEcho"Renamefile："&Err.Description&"<br>":Err.Clear
EndSub

"=====================================
"重命名文件
"=====================================
SubRenameHtml(ByValt0,ByValt1)
DimFso
OnErrorResumeNext
SetFso=Server.CreateObject("Scripting.FileSystemObject")
IFFso.FileExists(Server.MapPath(t0))Then
Fso.MoveFileServer.MapPath(t0),Server.MapPath(t1)
EndIF
SetFso=Nothing
IFErrThenEcho"Renamehtml："&Err.Description&"<br>":Err.Clear
EndSub

"=====================================
"删除文件夹
"=====================================
SubDelFile(ByValt0)
DimFso,F
OnErrorResumeNext
SetFso=Server.CreateObject("Scripting.FileSystemObject")
SetF=fso.GetFolder(Server.MapPath(t0))
IFNotIsNull(t0)ThenF.DeleteTrue
IFErrThenEcho"Delfile："&Err.Description&"<br>":Err.Clear
EndSub

"=====================================
"删除文件
"=====================================
SubDelHtml(ByValt0)
DimFso
OnErrorResumeNext
SetFso=Server.CreateObject("Scripting.FileSystemObject")
IFFso.FileExists(Server.MapPath(t0))ThenFso.DeleteFileServer.MapPath(t0)
IFErrThenEcho"DelHtml："&Err.Description&"<br>":Err.Clear
EndSub

FunctionRe_FileName(ByValt0)
Dimt1
t0=Lcase(t0)
IFLen(t0)=0ThenRe_FileName="{id}":ExitFunction
t1=Now()
"处理自定义文件名

"IFInstr(t0,"{")>0AndInstr(t0,"}")>0Then
"IFInstr(t0,"{id}")=0Then
"t0=t0&"{id}""尽量防止重复
"EndIF
"EndIF
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
EndFunction