<%

'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 Function



if 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

%>