asp目錄讀寫權(quán)限檢測(cè)腳本 TestFolder

更新時(shí)間：2011年11月11日 14:20:25 作者：

T00LS 檢測(cè)星外可執(zhí)行目錄的一個(gè)工具，今天剛好用到，記錄下。檢測(cè)了下運(yùn)氣差得很，全盤只能讀不能寫，檢測(cè)讀寫權(quán)限的時(shí)候?qū)⒁韵麓a保存為x.asp上傳到網(wǎng)站修改檢測(cè)目錄，點(diǎn)提交即可

效果圖:

復(fù)制代碼代碼如下:

 
<% 
'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 "&nbsp;" 
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 
%> 