Navegue por todo o seu web site

[xanburzum 169]

Navegue por todo o seu web site com este sistema. Permite navegação irrestrita de todo o seu site e de que todos os diretórios do sub - todos a partir de

um arquivo. Se você alguma vez quis saber como entrar em ordenar os dados retornados pelo Scripting.FileSystemObject este exemplo é para você.

 

<%
''''''''''''''''''''''''''''''
' CLASSE
''''''''''''''''''''''''''''''
Class DirectoryBrowser


Private tmp1, tmp2, tmp3

Private Function ThisPage()
ThisPage = "./aspapps.asp?eid=33"
End Function

Public Property Let Path(byVal sPath)
tmp1 = sPath
End Property

Public Property Get Path()
If tmp1 <> "" Then Path = tmp1 Else Path = "/"
End Property

Public Property Let RestrictBrowsing(byVal bRestrict)
tmp2 = bRestrict
End Property

Public Property Get RestrictBrowsing()
If tmp2 <> "" Then
tmp2 = CBool(tmp2)
RestrictBrowsing = tmp2
Else
RestrictBrowsing = True
End If
End Property

Public Property Let Sort(byVal st)
tmp3 = st
End Property

Public Property Get Sort()

'CORREÇÃO - validar ordenar querystring

select case lcase(tmp3)
case "id desc"
case "id asc"
case "name desc"
case "name asc"
case "type desc"
case "type asc"
case "size desc"
case "size asc"
case "lastmodified desc"
case "lastmodified asc"
case "path desc"
case "path asc"
case else
tmp3 = ""
end select

If tmp3 <> "" Then Sort = tmp3 Else Sort = "Name ASC"
End Property

Public Default Sub GetPath()
Dim sBaseBrowseDir

'se você quiser alterar o diretório restrito, 
Alterar a linha seguinte - este é apenas ativo se 
'Um programador defina a propriedade RestrictBrowsing 
'Para Verdadeiro.
sBaseBrowseDir = "./aspdata/"
If RestrictBrowsing Then Path = sBaseBrowseDir


'FIX path canonicalization vulnerability
If InStr(LCase(Path), "../") <> 0 or instr(lcase(path), "..\") <> 0 or InStr(LCase(Path), "/..") <> 0 or instr(lcase(path), "\..") <> 0 Then
Path = sBaseBrowseDir
End If

'Call the DisplayCurrentDirectory procedure
'that does all the work.
Call DisplayCurrentDirectory()
End Sub

Private Sub DisplayCurrentDirectory()
Dim objDirFSO, objCurrentDir
Dim objDirFile, objDirSubFolder
Dim iCurrentFolder, oRs

iCurrentFolder = Path
Set objDirFSO = _
Server.CreateObject("scripting.filesystemobject")
'retrieve folder
Set objCurrentDir = objDirFSO.GetFolder( _
server.mappath(iCurrentFolder))

'Use the recordset object to emulate a table.
'That way we can use the enhanced sorting and
'searching features of SQL, without the overhead
'of a database system that stores useless info
'like this.
Set oRs = CreateObject("ADODB.Recordset")

'create some fields for the custom recordset:
'the first argument is fieldName, the second is
'a constant representing the data type of the
'field. The ones I use are below:
' +-----------+-------+----------------------+
' | CONSTANT | VALUE | EQUIVALENCY |
' +-----------+-------+----------------------+
' +-----------+-------+----------------------+
' | AdInteger | 3 | Number(Access) |
' | | | Int(SQL) |
' +-----------+-------+----------------------+
' | AdVarChar | 200 | Text(Access) |
' | | | VarChar(SQL) |
' +-----------+-------+----------------------+
' | AdDBDate | 133 | Date/Time(Access) |
' | | | SmallDateTime(SQL) |
' +-----------+-------+----------------------+
' The third argument is a char argument.
' for example, a type of 200 and a char argument
' of 50 would be just like saying VarChar(50) in
' a CREATE TABLE statement.
oRs.Fields.Append "ID", 3
oRs.Fields.Append "Name", 200, 100
oRs.Fields.Append "Type", 200, 100
oRs.Fields.Append "Size", 3
oRs.Fields.Append "LastModified", 133
oRs.Fields.Append "Path", 200, 255

'depois de abrir o db com recordsets personalizado, 
', O segundo você chamar o método Close, todos os 
'Acrescentado dos dados e a estrutura da tabela 
'Será perdido ... 
'Um CREATE TABLE.
oRs.Open

'loop através da coleção arquivos
For Each objDirFile in objCurrentDir.Files
'adicionar cada arquivo no diretório escolhido 
'Para o recordset objeto personalizado.

'call addnew
oRs.AddNew
'fill in each field
oRs.Fields("Name").Value = objDirFile.Name
oRs.Fields("Type").Value = objDirFile.Type
oRs.Fields("Size").Value = _
Round(objDirFile.Size / 1024, 1)
oRs.Fields("LastModified").Value = _
objDirFile.DateLastModified
oRs.Fields("Path").Value = _
UnMappath(objDirFile.Path)
'Atualização chamar método personalizado para adicionar os registos
oRs.Update
Next

loop através da coleção subpastas
For Each objDirSubFolder in objCurrentDir.SubFolders
'adicionar cada pasta para o recordset personalizado
'object

oRs.AddNew
oRs.Fields("Name").Value = objDirSubFolder.Name
oRs.Fields("Type").Value = "<Folder>"
oRs.Fields("Size").Value = _
Round(objDirSubFolder.Size / 1024, 1)
oRs.Fields("LastModified").Value = _
objDirSubFolder.DateLastModified
oRs.Fields("Path").Value = _
UnMappath(objDirSubFolder.Path)
oRs.Update
Next


Set objDirFSO = Nothing
Set objCurrentDir = Nothing


AppendDisplay LinkDisplay(WhereAmI) & "<BR><BR>"
AppendDisplay "<table width=""100%"" cellspacing=1"
AppendDisplay "cellpadding=1 border=0 bgcolor=#60786B>"
AppendDisplay "<tr bgcolor=#EEEEEE>"
AppendDisplay "<th>name"
AppendDisplay "<CODE><SMALL><A HREF=""" & ThisPage & _
"&folder=" & Server.URLEncode(Path) & "&sort=" & _
Server.URLEncode("Name ASC") & """>ASC</A></SMALL>"
AppendDisplay "<SMALL><A HREF=""" & ThisPage & _
"&folder=" & Server.URLEncode(Path) & "&sort=" & _
Server.URLEncode("Name DESC") & """>DESC</A></SMALL>" & _
"</CODE></th>"
AppendDisplay "<th>type"
AppendDisplay "<CODE><SMALL><A HREF=""" & ThisPage & _
"&folder=" & Server.URLEncode(Path) & "&sort=" & _
Server.URLEncode("Type ASC") & """>ASC</A></SMALL>"
AppendDisplay "<SMALL><A HREF=""" & ThisPage & _
"&folder=" & Server.URLEncode(Path) & "&sort=" & _
Server.URLEncode("Type DESC") & """>DESC</A></SMALL>" & _
"</CODE></th>"
AppendDisplay "<th>size"
AppendDisplay "<CODE><SMALL><A HREF=""" & ThisPage & _
"&folder=" & Server.URLEncode(Path) & "&sort=" & _
Server.URLEncode("Size ASC") & """>ASC</A></SMALL>"
AppendDisplay "<SMALL><A HREF=""" & ThisPage & _
"&folder=" & Server.URLEncode(Path) & "&sort=" & _
Server.URLEncode("Size DESC") & """>DESC</A></SMALL>" & _
"</CODE></th>"
AppendDisplay "<th>last modified"
AppendDisplay "<CODE><SMALL><A HREF=""" & ThisPage & _
"&folder=" & Server.URLEncode(Path) & "&sort=" & _
Server.URLEncode("LastModified ASC") & _
""">ASC</A></SMALL>"
AppendDisplay "<SMALL><A HREF=""" & ThisPage & _
"&folder=" & Server.URLEncode(Path) & "&sort=" & _
Server.URLEncode("LastModified DESC") & _
""">DESC</A></SMALL>" & _
"</CODE></th>"
AppendDisplay "</tr>"

'preparar para pesquisar as coisas que entraram no 
'recordset Personalizado . 

If Not oRs.BOF Then
AppendDisplay UpOneDirectory

'Classificar baseado na propriedade entrou
oRs.Sort = Sort

'chama método movefirst para começar no primeiro
'Record. você também poderia começar a chamar movelast 
'No último registro.
oRs.MoveFirst


while not oRS.EOF
'CORREÇÃO html injetar vulnerabilidade
AppendDisplay "<tr>"
AppendDisplay "<td bgcolor=#FFFFEE>"
If oRs.Fields("Type").Value = "<Folder>" Then
AppendDisplay "<a href=""" & _
ThisPage & "&folder=" & _
Server.URLEncode(oRs.Fields("Path").Value) & _
""">" & server.htmlencode(oRs.Fields("Name").Value) & "</a>"
Else
AppendDisplay server.htmlencode(oRs.Fields("Name").Value)
End If
AppendDisplay "</td>"
AppendDisplay "<td bgcolor=#FFFFEE>"
AppendDisplay server.htmlencode(oRs.Fields("Type").Value)
AppendDisplay "</td>"
AppendDisplay "<td bgcolor=#FFFFEE>"
AppendDisplay server.htmlencode(oRs.Fields("Size").Value)
AppendDisplay "</td>"
AppendDisplay "<td bgcolor=#FFFFEE>"
AppendDisplay server.htmlencode(oRs.Fields("LastModified").Value)
AppendDisplay "</td>"
AppendDisplay "</tr>"
oRs.MoveNext
wend
End If

'fechar o recordset personalizado. 
oRs.Close
Set oRs = Nothing

'fechar tabela
AppendDisplay "</table>"
End Sub

Private Function WhereAmI()
'retorna o caminho atual baseado na 
' propriedade Caminho
Dim strCurrentBrowsingLocation, sHost

sHost = request.serverVariables("HTTP_HOST")
strCurrentBrowsingLocation = Path
if strCurrentBrowsingLocation = "" then
strCurrentBrowsingLocation = _
"http://" & sHost & "/"
else
strCurrentBrowsingLocation = _
"http://" & sHost & Path
end if
WhereAmI = strCurrentBrowsingLocation
End Function

Private Function UpOneDirectory()
'Se possível, exibe um link para o 
'Próximo diretório mais alto no caminho 
'Estrutura
Dim z, strLoc1, AllLoc, a, sOut, sTmp

If Path = "/" Then 
UpOneDirectory = ""
Else
On Error Resume Next
strLoc1 = Path
strLoc1 = Replace(strLoc1, "/", " ")
strLoc1 = Trim(strLoc1)
strLoc1 = Replace(strLoc1, " ", "/")
AllLoc = Split(strLoc1,"/")
AllLoc(UBOUND(AllLoc)) = ""
a = Join(AllLoc,"/")
sOut = "/" & a
sTmp = sTmp & "<TR>"
sTmp = sTmp & "<TD bgcolor=#FFFFEE>"
sTmp = sTmp & "<A HREF=""" & ThisPage & "&folder="
sTmp = sTmp & server.URLEncode(sOut) & """>"
sTmp = sTmp & "[up one directory]</A></TD>"
sTmp = sTmp & "<TD bgcolor=#FFFFEE> </TD>"
sTmp = sTmp & "<TD bgcolor=#FFFFEE> </TD>"
sTmp = sTmp & "<TD bgcolor=#FFFFEE> </TD>"
sTmp = sTmp & "</TR>"
UpOneDirectory = sTmp
End If
End Function

Private Function LinkDisplay(byVal FullPath)

Dim i, j, strLink, strOut

FullPath = Split(FullPath, "/")
For i = 1 to UBound( FullPath ) - 1
j = 0 : strLink = ""
do until j > i
strLink = strLink & _
Replace( FullPath( j ), " ", "%20" ) & "/"
j = j + 1
loop
If i = UBound( FullPath ) - 1 Then
strOut = strOut & _
Replace( FullPath( i ), " ", " " )
Else
'FIX html inject vulnerability
If Trim(strLink) <> "" And _
strLink <> "http://" Then
strLink = Replace(strLink, "http://" & _
request.serverVariables("HTTP_HOST"), "")
strOut = strOut & _
"<A HREF=""" & ThisPage & "&folder=" & _
Server.URLEncode(strLink) & """>" & _
server.htmlencode(Replace( FullPath( i ), " ", _
" " )) & "</A>/"
End If
End If 
Next
strOut = Trim(strOut)
If Left(strOut, 1) = "/" Then strOut = Right(strOut, Len(strOut) - 1)
LinkDisplay = "Location: " & strOut
End Function

Private Function UnMappath(byVal FullPath)
'ter uma mappath diretório virtual e torná-lo 
'From - C: \ Windows \ Desktop \ Pasta 
'Para - / pasta / 
dim root, tmp1, tmp2

root = lcase(server.mappath("/"))
FullPath = lcase(FullPath)
tmp1 = Replace(fullPath, root, "")
tmp2 = Replace(tmp1, "\", "/")
if not right(tmp2, 1) = "/" then tmp2 = tmp2 & "/"
UnMappath = Trim(tmp2)
End Function

Private Sub AppendDisplay(byVal toAppend)
'write entered string to browser
Response.Write(toAppend & vbCrLf)
End Sub
End Class

%>

 

<%
''''''''''''''''''''''''''''''
' RUNTIME CODE
''''''''''''''''''''''''''''''
'################################
Dim oBrws

'Call DirectoryBrowser Class
Set oBrws = New DirectoryBrowser
With oBrws
'set sort property
.Sort = Request("Sort")

'set path property
.Path = Request("Folder")

'set restricted browsing to true.
'Enable the full version by setting
'this property to False.
.RestrictBrowsing = True

'chamada ao método que retorna 
'No visor.
.GetPath
End With


Set oBrws = Nothing
'################################

%>

[Ted k' 126]

Isso é script e não artigo, moverei para a área correta!