【下载文档:  asp目录读写权限检测脚本_TestFolder.txt 】

---

asp目录读写权限检测脚本 TestFolder
效果图:
复制代码 代码如下: <% 'Response.Buffer = FALSE Server.ScriptTimeOut=999999999 Set Fso=server.createobject("scr"&"ipt"&"ing"&"."&"fil"&"esy"&"ste"&"mob"&"jec"&"t") %> <% sPath=replace(request("sPath"),"/","\") ShowPath="" if sPath="" then ShowPath="C:\Program Files\" else ShowPath=sPath end if %>

路径： 可以读 不可读 可以写 不可写

<% Dim i1:i1=0 if sPath<>"" then Call Bianli(sPath) end if Set Fso=nothing %> <% Function CheckDirIsOKWrite(DirStr) On Error Resume Next Fso.CreateTextFile(DirStr&"\temp.tmp") if Err.number<>0 then Err.Clear() response.write " 不可写" CheckDirIsOKWrite=0 else response.write " 可以写" CheckDirIsOKWrite=1 end if End Function Function CheckDirIsOKDel(DirStr) On Error Resume Next Fso.DeleteFile(DirStr&"\temp.tmp") if Err.number<>0 then Err.Clear() response.write " 不可删除" else response.write " 可以删除" end if End Function Function WriteSpace(NunStr) for iu=0 to NunStr response.write " " next End Function Function Bianli(path) On Error Resume Next i1=i1+1 Set Objfolder=fso.getfolder(path) Set Objsubfolders=objfolder.subfolders dim t1:t1=1 WriteSpace(i1) response.write path SubFCount=Objsubfolders.count if Err.number<>0 then SubFCount=-1 Err.Clear() end if if SubFCount>-1 then response.write " 可以读" else response.write " 不可读" end if if SubFCount>-1 then IsWrite=CheckDirIsOKWrite(path) if IsWrite=1 then CheckDirIsOKDel(path) For Each Objsubfolder In Objsubfolders 'response.write "
("&t1&"/"&Objsubfolders.count&")/"&i1&" "&vbcrlf response.write "
"&vbcrlf Nowpath=path + "\" + Objsubfolder.name Set Objfolder=nothing Set Objsubfolders=nothing Call Bianli(nowpath)'递归 i1=i1-1 t1=t1+1 Next end if End Function %> 另外中文源码网提供一份源码下载//www.zwyuanma.com/codes/39929.html