Snitz Forums 2000 - Sort order of ScanFolders function

Author

Topic

bobby131313
Senior Member

USA
1163 Posts

Posted - 27 February 2016 : 11:46:21

Below is the function that displays all of a members previously uploaded files. It displays them in general folder older. Is there any way to make it reverse the sort?


Function ScanFolders(PathSpec)
Dim fs, f, Folder, fc, s, File, FileList, FolderInfo, FileName, Name
Set FolderInfo = Fso.GetFolder(PathSpec)
Set FileList = FolderInfo.Files
For Each File in FileList
	Name = Cstr(File.Name)
	FileName = UCase(Mid(Name,InStrRev(Name,".")))
	if AdminAllowed then 
	  Name =  SubFolderName & "/" & Name
    end if
    
    If UseFile = "select" then
       
       Response.Write "<hr><div class=""left"" style=""width:130px""><img class=""right"" style=""max-width:125px;height:125px"" src=""" & UploadFolder & "/" & strDBNTUserName & "/" & Name & """ alt=""http://" & MyDomainName & UploadFolder & "/" & strDBNTUserName & "/" & Name & """></div>" & vbNewline & _
                      "<INPUT style=""margin:50px 0 15px 0"" TYPE=""submit"" NAME=""enter"" value=""Insert"" onclick=""JavaScript:window.location=('myfiles.asp?InsertFile=true&FileToInsert=" & Name & "');"">" & "<br />" & Name & vbNewline & _
	                  "<br clear=""all"" />"
	end if   
    
Next

Set f = Fso.GetFolder(PathSpec)
if AdminAllowed then 
  Set fc = f.SubFolders
  For Each Folder in fc
  SubFolderName = "/" & Folder.Name
'##  if  LCase(Mid(SubFolderName,1,5)) <> "/_vti" then
'## Uncomment Above Line if you use Front Page and you don't want "_vti" directories to show
    Call ScanFolders(PathSpec & "/" & Folder.Name)
'##  end if
'## Uncomment Above Line if you use Front Page and you don't want "_vti" directories to show
  Next
end if

End Function

if UseFile = "select" then  
   %><!--#INCLUDE FILE="inc_footer_short.asp" --><%
   else
   %><!--#INCLUDE FILE="inc_footer.asp" --><%
end if

Switch the order of your title tags

Edited by - bobby131313 on 27 February 2016 11:47:08

Carefree
Advanced Member

Philippines
4207 Posts

Posted - 27 February 2016 : 13:26:47

This is untested, but I think it will work.


Function ScanFolders(PathSpec)
	Dim fs, f, Folder, fc, r, s File, FileList, FolderInfo, FileName, Name
	Set FolderInfo = FSO.GetFolder(PathSpec)
	Set FileList = FolderInfo.Files
	s = FolderInfo.Count - 1
	ReDim r(s)
	For Each File In FileList
		Set r(s) = File
		s = s - 1
	Next
	For Each File in r(s)
		Name = CStr(File.Name)
		FileName = UCase(Mid(Name,InStrRev(Name,".")))
		If AdminAllowed Then Name = SubFolderName & "/" & Name
		If UseFile = "select" then
			Response.Write "<hr><div class=""left"" style=""width:130px""><img class=""right"" style=""max-width:125px;height:125px"" src=""" & UploadFolder & "/" & strDBNTUserName & "/" & Name & """ alt=""http://" & MyDomainName & UploadFolder & "/" & strDBNTUserName & "/" & Name & """></div>" & vbNewline & _
				"<INPUT style=""margin:50px 0 15px 0"" TYPE=""submit"" NAME=""enter"" value=""Insert"" onclick=""JavaScript:window.location=('myfiles.asp?InsertFile=true&FileToInsert=" & Name & "');"">" & "<br />" & Name & vbNewline & _
				"<br clear=""all"" />"
		End If
	Next
	Set f = Fso.GetFolder(PathSpec)
	If AdminAllowed Then
		Set fc = f.SubFolders
		For Each Folder in fc
			SubFolderName = "/" & Folder.Name
		Next
	End If
End Function
If UseFile = "select" Then WriteFooterShort Else WriteFooter

bobby131313
Senior Member

USA
1163 Posts

Posted - 27 February 2016 : 13:45:37

I'm getting this...

Microsoft VBScript runtime error '800a01b6'
Object doesn't support this property or method: 'FolderInfo.Count'
/forum/myfiles1.asp, line 115

Switch the order of your title tags

Carefree
Advanced Member

Philippines
4207 Posts

Posted - 28 February 2016 : 23:01:19

Here, this works. Adapt to your code.


<!--#INCLUDE FILE="config.asp"-->
<%
Response.Buffer = True
%>
<!--#INCLUDE FILE="includes/inc_sha256.asp"-->
<!--#INCLUDE FILE="includes/inc_header.asp" -->
<!--#INCLUDE FILE="includes/inc_func_secure.asp" -->
<!--#INCLUDE FILE="includes/inc_func_admin.asp" -->
<!--#INCLUDE FILE="includes/inc_func_member.asp" -->
<!--#INCLUDE FILE="includes/inc_func_posting.asp" -->
<%
If Session(strCookieURL & "Approval") <> "15916941253" Then
	scriptname = split(Request.ServerVariables("SCRIPT_NAME"),"/")
	 	Response.Redirect "admin_login.asp?target=" & scriptname(ubound(scriptname)) & "?" & Request.ServerVariables("Query_String")
End If
On Error Resume Next
Response.Write	"		<table border=""0"" width=""100%"">" & vbNewLine & _
	"			<tr>" & vbNewLine & _
	"				<td width=""33%"" align=""left"" nowrap><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """>" & vbNewLine & _
	"				" & getCurrentIcon(strIconFolderOpen,"","") & " <a href=""default.asp"">All Forums</a><br />" & vbNewLine & _
	"				" & getCurrentIcon(strIconBar,"","") & getCurrentIcon(strIconFolderOpen,"","") & " <a href=""admin_home.asp"">Admin Section</a><br />" & vbNewLine & _
	"				" & getCurrentIcon(strIconBlank,"","") & getCurrentIcon(strIconBar,"","") & getCurrentIcon(strIconFolderOpenTopic,"","") & " Folder Fetcher Configuration<br /></font></td>" & vbNewLine & _
	"			</tr>" & vbNewLine & _
	"		</table><br />" & vbNewLine & _
	"		<table style=""border-radius: 25px; padding-top:20px; padding-left:10px; padding-right:10px; padding-bottom:10px; box-shadow:10px 5px 5px rgba(96,96,96, 0.8);"" bgcolor=""" & strPopupTableColor & """ align=""center"" border=""0"" cellPadding=""0"" cellSpacing=""0"" width=""95%"" max-width=""95%"">" & vbNewLine & _
	"			<tr>" & vbNewLine & _
	"				<td width=""100%"" colspan=""3"" bgColor=""" & strHeadCellColor & """ align=""center"">" & vbNewLine & _
	"					<font size=""" & strDefaultFontSize & """ color=""" & strHeadFontColor & """ face=""" & strDefaultFontFace & """><b>Fetcher</b></font>" & vbNewLine & _
	"				</td>" & vbNewLine & _
	"			</tr>" & vbNewLine & _
	"			<tr>" & vbNewLine
If Request("PathSpec") = "" Then
	Response.Write	"					<form action=""fetcher.asp"" method=""post"">" & vbNewLine & _
		"				<td bgColor=""" & strForumCellColor & """ width=""30%"" align=""right"">" & vbNewLine & _
		"					<font size=""" & strDefaultFontSize & """ face=""" & strDefaultFontFace & """ color=""" & strDefaultFontColor & """><b>Folder:</b></font>" & vbNewLine & _
		"				</td>" & vbNewLine & _
		"				<td bgColor=""" & strForumCellColor & """ width=""60%"" align=""center"">" & vbNewLine & _
		"					<input type=""text"" name=""PathSpec""  style=""text-align:center; color:maroon; font-weight:bold; background-color:lightpink; width:98%"" value=""" & Request("PathSpec") & """ />" & vbNewLine & _
		"				</td>" & vbNewLine & _
		"				<td bgColor=""" & strForumCellColor & """ width=""10%"" align=""center"">" & vbNewLine & _
		"					<input type=""Submit"" class=""btn"" name=""submit"" value=""Submit"" />" & vbNewLine & _
		"				</td>" & vbNewLine & _
		"			</form>" & vbNewLine
Else
	Response.Write	"				<td bgColor=""" & strForumCellColor & """ width=""100%"" align=""center"" colspan=""3"">" & vbNewLine
	If IsAdminAllowed Then
		ScanFolders()
	Else
		Response.Write	"<br />Not allowed.<br />"
	End If
	Response.Write	"				</td>" & vbNewLine
End If
Response.Write	"			</tr>" & vbNewLine & _
	"	</table>" & vbNewLine
WriteFooter
Response.End

Function ScanFolders
	On Error Resume Next
	Dim fs, f, Folder, fc, i, r, s, File, FileList, FolderInfo, FileName, PathSpec, strFPath
	strFPath = Request("PathSpec")
	Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
	PathSpec = Left(Request.ServerVariables("Path_Translated"),Len(Request.ServerVariables("Path_Translated")) - 11) & "\" & strFPath
	If objFSO.FolderExists(PathSpec) Then
		Set FolderInfo = objFSO.GetFolder(PathSpec)
		Set FileList = FolderInfo.Files
		s = 0
		For Each File In FileList
			s = s + 1
		Next
		ReDim r(s)
		s = 0
		For Each File In FileList
			s = s + 1
			Set r(s) = File
		Next
		For i = s To 1 Step -1
			FileName = r(i).Name
			Response.Write "<br />" & strForumURL & strFPath & "/" & FileName & vbNewline
		Next
		Set FileList = Nothing
		Set FolderInfo = Nothing
		Set objFSO = Nothing
	Else
		Response.Write	"<br />Folder does not exist.<br />"
	End If
End Function
%>

Edited by - Carefree on 29 February 2016 08:58:16

bobby131313
Senior Member

USA
1163 Posts

Posted - 29 February 2016 : 10:47:03

Thank you! I'll check it out later today.

Switch the order of your title tags

Topic