In ASP, insbesondere in CMS-Systemen, die statische Dateien erstellen müssen, ist es häufig erforderlich, einige Dateien zu beurteilen, zu erstellen und zu löschen. Hier sind einige davon, die im Wesentlichen die Grundanforderungen erfüllen.
Kopieren Sie den Codecode wie folgt:
'=====================================
'Dateisuffix abrufen
'=====================================
Funktion Get_Filetxt(ByVal t0)
Dimmen Sie t1
IF Len(t0)<2 Or Instr(t0,".")=0 Then Get_Filetxt=False:Exit Function
t1=Split(t0,".")
Get_Filetxt=Lcase(t1(Ubound(t1)))
Funktion beenden
'=====================================
„Reiner Code zum Lesen jeder Datei.“
'=====================================
Funktion LoadFile(ByVal t0)
WENN Len(t0)=0, dann Funktion beenden
IF Sdcms_Cache Dann
IF Check_Cache("LoadFile_"&t0) Dann
Create_Cache „LoadFile_“&t0,LoadFile_Cache(t0)
Beenden Sie IF
LoadFile=Load_Cache("LoadFile_"&t0)
Anders
LoadFile=LoadFile_Cache(t0)
Beenden Sie IF
Funktion beenden
Funktion LoadFile_Cache(ByVal t0)
Dim t1,stm
Bei Fehler Weiter fortsetzen
WENN Len(t0)=0, dann Funktion beenden
t1=Leer
Setze Stm=Server.CreateObject("Adodb.Stream")
Mit Stm
.Type=2'In diesem Modus lesen
.mode=3
.charset=CharSet
.Offen
.loadfromfile Server.MapPath(t0)
t1=.readtext
.Schließen
Ende mit
Setze Stm=Nichts
WENN Irrtum dann
LoadFile_Cache=""&t0&""&Err.Description:Err.Clear
Anders
LoadFile_Cache=t1
Beenden Sie IF
Funktion beenden
'=====================================
'Überprüfen Sie, ob die Datei existiert
'=====================================
Funktion Check_File(ByVal t0)
Dim F
t0=Server.MapPath(t0)
Setze Fso=CreateObject("Scripting.FileSystemObject")
Check_File=Fso.FileExists(t0)
Setze Fso=Nothing
Funktion beenden
'=====================================
'Überprüfen Sie, ob der Ordner existiert
'=====================================
Funktion Check_Folder(ByVal t0)
Dim F
t0=Server.MapPath(t0)
Setze Fso=CreateObject("Scripting.FileSystemObject")
Check_Folder=Fso.FolderExists(t0)
Setze Fso=Nothing
Funktion beenden
'=====================================
'Ordner erstellen (unbegrenzte Ebene)
'=====================================
Funktion Create_UpFile(ByVal t0)
Dim t1,t2,objFSO,i
Bei Fehler Weiter fortsetzen
t0=Server.MapPath(t0)
IF InStr(t0,"/")<=0 Oder InStr(t0,::)<=0 Then:Create_upfile=False:Exit Function
Setze objFSO=CreateObject("Scripting.FileSystemObject")
IF objFSO.FolderExists(t0) Then:Create_upfile=True:Exit Function
t1=Split(t0,"/"):t2=""
Für i=0 bis UBound(t1)
t2=t2&t1(i)&"/"
WENN nicht objFSO.FolderExists(t2) Dann objFSO.CreateFolder(t2)
Nächste
Setze objFSO=Nothing
IF Err=0 Then Create_upfile=True:Else Create_upfile=False:Echo "Create_upfile:"&Err.Description&"<br>":Err.Clear
Funktion beenden
Sub SaveFile(ByVal t0,ByVal t1,ByVal t2)
Dim objFSO,t3
Setze objFSO=CreateObject("Scripting.FileSystemObject")
IF t0="" Then Echo „Das Verzeichnis darf nicht leer sein!“:Gestorben
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
Setze objFSO=Nothing
Sub beenden
Funktion BuildFile(ByVal t0,ByVal t1)
DimStm
Bei Fehler Weiter fortsetzen
Setze Stm=Server.CreateObject("Adodb.Stream")
Mit Stm
.Type=2 'In diesem Modus lesen
.Modus=3
.Charset=CharSet
.Offen
.WriteText t1
.SaveToFile t0,2
.Schließen
Ende mit
Setze Stm=Nichts
IF Err Then Echo „BuildFile:“&Err.Description&“<br>“:Err.Clear
Funktion beenden
'=====================================
„Ordner umbenennen.“
'=====================================
Sub RenameFile(ByVal t0,ByVal t1)
Dim F
Bei Fehler Weiter fortsetzen
Setze Fso=Server.CreateObject("Scripting.FileSystemObject")
IF Fso.FolderExists(Server.MapPath(t0)) Dann
Fso.MoveFolder Server.MapPath(t0),Server.MapPath(t1)
Beenden Sie IF
Setze Fso=Nothing
IF Err Then Echo „Renamefile:“&Err.Description&“<br>“:Err.Clear
Sub beenden
'=====================================
'Datei umbenennen
'=====================================
Sub RenameHtml(ByVal t0,ByVal t1)
Dim F
Bei Fehler Weiter fortsetzen
Setze Fso=Server.CreateObject("Scripting.FileSystemObject")
IF Fso.FileExists(Server.MapPath(t0)) Dann
Fso.MoveFile Server.MapPath(t0),Server.MapPath(t1)
Beenden Sie IF
Setze Fso=Nothing
IF Err Then Echo „Renamehtml:“&Err.Description&“<br>“:Err.Clear
Sub beenden
'=====================================
'Ordner löschen
'=====================================
Sub DelFile(ByVal t0)
Dim Fso,F
Bei Fehler Weiter fortsetzen
Setze Fso=Server.CreateObject("Scripting.FileSystemObject")
Setze F=fso.GetFolder(Server.MapPath(t0))
IF Not IsNull(t0) Then F.Delete True
IF Err Then Echo „Delfile:“&Err.Description&“<br>“:Err.Clear
Sub beenden
'=====================================
'Dateien löschen
'=====================================
Sub DelHtml(ByVal t0)
Dim F
Bei Fehler Weiter fortsetzen
Setze 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
Sub beenden
Funktion Re_FileName(ByVal t0)
Dimmen Sie t1
t0=Lcase(t0)
IF Len(t0)=0 Then Re_FileName="{id}":Exit Function
t1=Jetzt()
'Benutzerdefinierte Dateinamen verarbeiten
'IF Instr(t0,"{")>0 And Instr(t0,"}")>0 Then
'IF Instr(t0,"{id}")=0 Then
't0=t0&"{id}"' Versuchen Sie, Duplikate zu verhindern
'Ende WENN
'Ende WENN
t0=Ersetzen(t0,"{y}",Jahr(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
Funktion beenden