Tayfun
| | Tarih: 13.12.2006, 03:31 Mesaj konusu: Klasör Listeleme (ASP) | |
| oldukça başarılı bir klasör listeleme kodu...
Kod: <%
'|==================================|'
'| psychaos - directory list v1.0b |'
'| coded by psychaos |'
'| a.k.a semih turna |'
'| 04.04.2004 14:52 |'
'|==================================|'
class dl
private objfso, objfolder
private rsdirectory
private msg
public strlocation
private sub class_ınitialize()
const adınteger = 3
const advarchar = 200
const adboolean = 11
const addbtimestamp = 135
set objfso = server.createobject("scripting.filesystemobject")
set rsdirectory = server.createobject("adodb.recordset")
with rsdirectory
.fields.append "name", advarchar, 50
.fields.append "type", adboolean
.fields.append "location", advarchar, 100
.fields.append "size", adınteger
.fields.append "datelastmodified", addbtimestamp
.open
end with
end sub
private sub class_terminate()
ıf ısobject(objfso) then set objfso = nothing
ıf ısobject(rsdirectory) then rsdirectory.close : set rsdirectory = nothing
end sub
public sub addıtem
ıf objfso.folderexists(strlocation) = false then
errmsg "girmiş olduğunuz ""<b>"& strlocation &"</b>"" adlı yol bulunamadı!"
else
set objfolder = objfso.getfolder(strlocation)
for each strfolder ın objfolder.subfolders
with rsdirectory
.addnew
.fields("name") = strfolder.name
.fields("type") = 0
.fields("location") = editurl(session("path") &"\"& strfolder.name)
.fields("size") = strfolder.size
.fields("datelastmodified") = strfolder.datelastmodified
.update
end with
next
for each strfile ın objfolder.files
with rsdirectory
.addnew
.fields("name") = strfile.name
.fields("type") = 1
.fields("location") = editurl(session("path") &"\"& strfile.name)
.fields("size") = strfile.size
.fields("datelastmodified") = strfile.datelastmodified
.update
end with
next
end ıf
end sub
public sub directorylist
ıf objfso.folderexists(strlocation) = true then
ıf objfolder.subfolders.count > 0 then strtotalfolder = objfolder.subfolders.count
strtotalfile = objfolder.files.count
strpath = objfolder.shortpath
strfoldersize = filesize(objfolder.size)
end ıf
ıf rsdirectory.eof then
errmsg "kayıt bulunmamaktadır!"
else
with response
.write "<div align='center'>"& vbcrlf
.write " <table border='0' width='50%' id='table1' cellspacing='1' cellpadding='2'>"& vbcrlf
.write " <tr>"& vbcrlf
.write " <td width='5%' bgcolor='#000066'>"& vbcrlf
.write " <p align='center'><b><font size='2' face='verdana' color='#ffffff'>#</font></b></td>"& vbcrlf
.write " <td width='60%' bgcolor='#000066'><b>"& vbcrlf
.write " <font size='2' face='verdana' color='#ffffff'>ad</font></b></td>"& vbcrlf
.write " <td width='15%' bgcolor='#000066'>"& vbcrlf
.write " <p align='center'><b><font size='2' face='verdana' color='#ffffff'>boyut</font></b></td>"& vbcrlf
.write " <td width='20%' bgcolor='#000066'>"& vbcrlf
.write " <p align='center'><b><font size='2' face='verdana' color='#ffffff'>değiştirilme tarihi</font></b></td>"& vbcrlf
.write " </tr>"& vbcrlf
.write " <tr><td colspan='5'><font face='verdana' size='1'><a href='dlist.asp?path="& left(session("path"),instrrev(session("path"),"\")-1) &"'>üst klasör</a></font></td></tr>"
rsdirectory.movefirst
do while not rsdirectory.eof
ıf rsdirectory.fields("type").value = 0 then
strımage = "<img border='0' src='img/folder.gif' width='16' height='16'>"
strname = "<a href='dlist.asp?path="& rsdirectory.fields("location").value &"'><b>"& rsdirectory.fields("name").value &"</b></a>"
else
strımage = "<img border='0' src='img/file.gif' width='16' height='16'>"
strname = "<a target='_blank' href='"& rsdirectory.fields("location").value &"'>"& rsdirectory.fields("name").value &"</a>"
end ıf
.write " <tr>"& vbcrlf
.write " <td width='5%'><p align='center'>"& strımage &"</td>"& vbcrlf
.write " <td width='60%' bgcolor='#f1f1f1'><font size='1' face='verdana'>"& strname &"</font></td>"& vbcrlf
.write " <td width='15%'>"& vbcrlf
.write " <p align='center'><font size='1' face='verdana'>"& filesize(rsdirectory.fields("size").value) &"</font></td>"& vbcrlf
.write " <td width='20%' bgcolor='#f1f1f1'>"& vbcrlf
.write " <p align='center'><font size='1' face='verdana'>"& rsdirectory.fields("datelastmodified").value &"</font></td>"& vbcrlf
.write " </tr>"& vbcrlf
rsdirectory.movenext
loop
.write " <tr>"& vbcrlf
.write " <td colspan='4' bgcolor='#000066'>"& vbcrlf
.write " <p align='center'><font color='#ffffff' face='verdana' size='1'>bunulunduğunuz klasör <b>"& strpath &"</b> - bu klasörde <b>"& strtotalfile &" dosya</b>, <b>"& strtotalfolder &" alt klasör</b> bulunmaktadır.<br>bulunduğunuz klasörün boyutu <b>"& strfoldersize &"</b></font></td>"& vbcrlf
.write " </tr>"& vbcrlf
.write " </table>"& vbcrlf
.write "</div>"& vbcrlf
end with
end ıf
end sub
private function filesize(ıtemsize)
ıf ıtemsize >= 1073741824 then
ıtemsize = formatnumber((ıtemsize/1073741824),2) &" gb"
elseıf ıtemsize >= 1048576 then
ıtemsize = formatnumber((ıtemsize/1048576),2) &" mb"
elseıf ıtemsize >= 1024 then
ıtemsize = formatnumber((ıtemsize/1024),2) &" kb"
elseıf ıtemsize >= 0 then
ıtemsize = ıtemsize &" byte"
else
ıtemsize = "0 byte"
end ıf
filesize = ıtemsize
end function
private function editurl(url)
ıf ınstr(1,url, "\\",1) <> 0 then url = replace(url,"\\","\")
editurl = url
end function
public sub errmsg(msg)
response.write "<font face='verdana' size='2'><font color='#ff0000'><b>hata :</b></font> "& msg &"</font><br>"& vbcrlf
end sub
end class
%>
kullanimi
code:
<%
session("path") = replace(request.querystring("path"),"/","\")
ıf session("path") = "" then response.redirect "?path=.\"
ıf session("path") = "." then response.redirect "?path=..\"
ıf session("path") = ".." then session("path") = session("path") &"\"
set dlist = new dl
dlist.strlocation = server.mappath(session("path"))
dlist.addıtem
dlist.directorylist
set dlist = nothing
with response
.write "<br>"& vbcrlf
.write "<div align='center'>"
.write "<font face='verdana' size='1'><b>psychaos - directory list v1.0b</b><br>coded by <a href='mailto:semih@maxiasp.com'>psychaos</a>"
.write "</div>"
end with
%>
|
|
