本文共 6004 字，大约阅读时间需要 20 分钟。
<%
'FSO组件名称 dim FSObject FSObject="Scripting.FileSystemObject"'=========================================================
'◆是否支持组件 '========================================================= Function IsObjInstalled(strClassString) On Error Resume Next IsObjInstalled = False Err = 0 Dim xTestObj Set xTestObj = Server.CreateObject(strClassString) If 0 = Err Then IsObjInstalled = True Set xTestObj = Nothing Err = 0 End Functionif IsObjInstalled(FSObject) then
response.write "√" else response.write "×" end if%> ------------------------------------------------------- <% '========================================================= '◆是否支持组件 '========================================================= Function IsObjInstalled(strClassString) On Error Resume Next IsObjInstalled = False Err = 0 Dim xTestObj Set xTestObj = Server.CreateObject(strClassString) If 0 = Err Then IsObjInstalled = True Set xTestObj = Nothing Err = 0 End Function '========================================================= 'fso 操作 '========================================================= '◆检查某一目录是否存在 '========================================================= Function CheckDir(FolderPath) folderpath=Server.MapPath(".")&"\"&folderpath Set fso= CreateObject(FSObject) If fso.FolderExists(FolderPath) then CheckDir = True Else CheckDir = False End if Set fso= nothing End Function '========================================================= '◆ 根据指定名称生成目录 '========================================================= Function MakeNewsDir(foldername) dim fs0 Set fso= CreateObject(FSObject) Set fs0= fso.CreateFolder(foldername) Set fso = nothing End Function '========================================================= '◆ 如果文件夹不存在则建立新文件夹 ◆ '========================================================= Function checkFolder(folderpath) If CheckDir(folderpath) = false Then'如果文件夹不存在 MakeNewsDir(folderpath)'就建一个文件夹 end if end Function '========================================================= '◆ 删除文件夹 ◆ '========================================================= Function DeleteFoldera(folderpath) dim path Set fso = CreateObject(FSObject) path=request.ServerVariables("APPL_PHYSICAL_PATH")&folderpath fso.DeleteFolder(path) Set fso = nothing end Function '========================================================= '◆ 更改文件夹名称 ◆ '========================================================= Function moveFolder(foldername,newfoldername) isfso Set fso = CreateObject(FSObject) fso.moveFolder ""&request.ServerVariables("APPL_PHYSICAL_PATH")&"\"&foldername&"" ,""&request.ServerVariables("APPL_PHYSICAL_PATH")&"\"&newfoldername&"" Set fso =nothing End Function '========================================================= '◆ 删除指定文件 ◆ '========================================================= Function DeleteFile(file) Set fso = CreateObject(FSObject) fso.DeleteFile request.ServerVariables("APPL_PHYSICAL_PATH")&file Set fso = nothing End Function '========================================================= '◆ 备份指定文件 ◆ '========================================================= Function CopyFile(oldfile,newfile) Set fso = CreateObject(FSObject) On Error Resume Next Set fso=Server.CreateObject(FSObject) oldfile=Server.MapPath(oldfile) if Err.Number>0 Then call alert("原路径错误!","") newfile=Server.MapPath(newfile) if Err.Number>0 Then call alert("新路径错误!","") fso.CopyFile oldfile,newfile'覆盖原来的文件 if Err.Number>0 Then call alert(Err.Description,"") Set fso=nothing End Function '========================================================= '◆ 转移指定文件 ◆ '========================================================= Function MoveFile(oldfile,newfile) Set fso = CreateObject(FSObject) On Error Resume Next Set fso=Server.CreateObject(FSObject) oldfile=Server.MapPath(oldfile) if Err.Number>0 Then call alert("原路径错误!","") newfile=Server.MapPath(newfile) if Err.Number>0 Then call alert("新路径错误!","") 'fso.MoveFile oldfile,newfile'不能覆盖原来的文件 fso.MoveFile "d:\o\data\test.txt","d:\o\databackup\test3.txt" if Err.Number>0 Then call alert(Err.Description,"") Set fso=nothing End Function '========================================================= '◆ 读取文件代码 ◆ '========================================================= Function loadfile(file)'读取文件 dim ftemp Set fso = CreateObject(FSObject) Set ftemp=fso.OpenTextFile(Server.MapPath(""&file&""), 1) loadfile=ftemp.ReadAll ftemp.Close fso.close set fso=nothing End Function '========================================================= '◆ 根据代码生成文件 ◆ '========================================================= '======================================== '■file生成文件名 '■code文件的代码 '======================================== Function savefile(file,code)'保存文件 dim MyFile Set fso = CreateObject(FSObject) Set MyFile = fso.CreateTextFile(Server.mapPath(file), True) MyFile.WriteLine(code) MyFile.Close set MyFile=nothing End Function '========================================================= '◆ 压缩数据库 ◆ '========================================================= '======================================== '■dbPath数据文件路径 '■boolIs97 access97压缩 '======================================== Function CompactDB(dbPath,boolIs97) dim strDBPath,fso,Engine dbPath=server.mappath(dbpath) strDBPath = left(dbPath,instrrev(DBPath,"\")) Set fso = CreateObject(FSObject) If fso.FileExists(dbPath) Then Set Engine = CreateObject("JRO.JetEngine") If boolIs97 = "True" Then dim JET_3X Engine.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbpath, _ "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDBPath & "temp.mdb;" _ &"Jet OLEDB:Engine Type=" & JET_3X Else Engine.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbpath, _ "Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Database password="&dbpw&";Data Source="&strDBPath&"temp.mdb" End If fso.CopyFile strDBPath & "temp.mdb",dbpath fso.DeleteFile(strDBPath&"temp.mdb") Set fso = nothing Set Engine = nothing CompactDB="当前数据库,已经压缩成功!" Else CompactDB="数据库名称或路径不正确. 请重试!" End If End Function %>转载地址：http://gkkzl.baihongyu.com/