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
%>
<form name="form1" method="post" action="">
<label><br>
</label>
<label> </label>
<table width="80%" border="0">
<tr>
<td><strong>路径：</strong>
<input name="spath" type="text" id="spath" value="<%=showpath%>" style="width:500px;height:25px">
<input style="width:160px;height:28px" type="submit" name="button" id="button" value="提交" /> 可以读 不可读 可以写 不可写</td>
</tr>
</table>
</form>
<%
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 " <font color=red>不可写</font>"
checkdirisokwrite=0
else
response.write " <font color=green><b>可以写</b></font>"
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 " <font color=red>不可删除</font>"
else
response.write " <font color=green><b>可以删除</b></font>"
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 " <font color=green>可以读</font>"
else
response.write " <font color=red>不可读</font>"
end if
if subfcount>-1 then
iswrite=checkdirisokwrite(path)
if iswrite=1 then checkdirisokdel(path)
for each objsubfolder in objsubfolders
'response.write "<br>("&t1&"/"&objsubfolders.count&")/<b>"&i1&"</b> "&vbcrlf
response.write "<br> "&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
%>