• 企业400电话
  • 微网小程序
  • AI电话机器人
  • 电商代运营
  • 全 部 栏 目

    企业400电话 网络优化推广 AI电话机器人 呼叫中心 网站建设 商标✡知产 微网小程序 电商运营 彩铃•短信 增值拓展业务
    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=t2t1(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
    上一篇:asp中格式化HTML函数代码 SDCMS加强版
    下一篇:asp中获取当前页面的地址与参数的函数代码
  • 相关文章
  • 

    © 2016-2020 巨人网络通讯 版权所有

    《增值电信业务经营许可证》 苏ICP备15040257号-8

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