ASP file and folder common processing functions (file suffix, create files, etc.) _ Application techniques

Source: Internet
Author: User
Copy Code code as follows:

'=====================================
' Get file suffix
'=====================================
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

'=====================================
' Read pure code for any file
'=====================================
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 ' read in this mode
. 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

'=====================================
' Check if the file exists
'=====================================
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

'=====================================
' Check if the folder exists
'=====================================
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

'=====================================
' Create folder (infinite level)
'=====================================
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&AMP;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")
The IF t0= "Then Echo" directory cannot be empty! ":D IED
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 ' read in this mode
. 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

'=====================================
' Rename folder
'=====================================
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

'=====================================
' Rename file
'=====================================
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

'=====================================
' Delete folder
'=====================================
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

'=====================================
' Delete file
'=====================================
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 ()
' Process a custom filename

' IF Instr (t0, "{") >0 and Instr (t0, "}") >0 Then
' IF Instr (t0, ' {ID} ') =0 Then
' t0=t0& ' {ID} ' try to prevent duplication
' 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
Related Article

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.