asp中文件与文件夹常用处理函数(文件后缀、创建文件等)
来源:asp之家 发布时间:2011-02-20 11:00:00
代码如下:
'=====================================
'获得文件后缀
'=====================================
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
猜你喜欢
- 在access中进行时间的比较sql语句很简单,如select * from table where thetime>#\"
- 多级联动下拉选择框,动态获取下一级,每一级数据为XML,可支持无限级(浏览器端需要Microsoft.XMLDOM支持)项目需要,一个材料类
- 使用ASP做网站虽然有点落伍,但在中国还是有很大市场的,因为大部分国内用户使用Windows Server服务器,在Windows Serv
- 我们经常使用动态创建 JavaScript 的方式来实现 JavaScript 文件的无阻塞(Non-blocking)、并行下载(Para
- 1、查找表结构,判断要加入的列是否已存在2、如果不存在,则执行添加 CREATE PROCEDURE `mysql_sp_add_
- 当一张的数据达到几百万时,你查询一次所花的时间会变多,如果有联合查询的话,我想有可能会死在那儿了。分表的目的就在于此,减小数据库的负担,缩短
- 函数可以参考:<% '注册论坛用户,参数说明 'username 用户登录名称 
- 从XML中读取数据到内存的实例: public clsSi
- 我的测试环境是2000sever ie6.0+sp4 MYIE1.31 (成功通过测试)关闭窗口的途径常用4种:1.双击左上角图标2.直接双
- 在实用美术中,常有"远看色彩近看花,先看颜色后看花,七分颜色三分花"的说法。这也就说明,在任何设计中,色彩对视觉的刺激起
- 看看下面:<%Set objQuery = Server.CreateObject("ixss
- 以前看过有人转换过的,当时仅仅惊叹了一下,就过去了,没有记下来,直至于用到的时候呢,开始到处找,找来找去都没有找不到痕迹了,心里也就郁郁寡欢
- IE8正式版已经发布了。本篇文章不会非常扯蛋地去进行什么评测,然后给出什么“Chrome运行JavaScript能力是IE8的15倍”、什么
- 现在有一个xml,格式如下: <date> <item> <id> 1 </id> <
- 基于web的技术中,分页是一个老的不能再老的,但大家津津乐道的问题,随着xml技术的日渐应用,把xml应用到分页当中,也是一种可能,当然网上
- asp取得字段属性代码:set AdoX = server.createobject("adox.c
- 昨天给公司服务器重做了一下系统,遇到Asp附件无法上传,之前服务器上使用好好的,怎么重做了就不正常了,于是一番google,baidu,下面
- asp过滤留言中脏话的代码例子<!--#include file="../conn/dbconn1.asp"--&
- 本文介绍了一种将英文字符首个字母串转换为大写的asp代码,当然这个功能可能英文网站比较有用。转换大写功能英文介绍:Code Title: P
- AdobeAdobe公司的标识1982年,40多岁的程序员约翰·沃诺克(John Warnock)和查尔斯·杰斯克(Charles Gesc