Snitz Forums 2000
Snitz Forums 2000
Home | Profile | Register | Active Topics | Members | Search | FAQ
Username:
Password:
Save Password
Forgot your Password?

 All Forums
 Help Groups for Snitz Forums 2000 Users
 Help: MOD Implementation
 Sort order of ScanFolders function
 New Topic
 Printer Friendly
Author Previous Topic Topic Next Topic  

bobby131313
Senior Member

USA
1163 Posts

Posted - 27 February 2016 :  11:46:21  Show Profile  Visit bobby131313's Homepage  Reply with Quote
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
4206 Posts

Posted - 27 February 2016 :  13:26:47  Show Profile
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
Go to Top of Page

bobby131313
Senior Member

USA
1163 Posts

Posted - 27 February 2016 :  13:45:37  Show Profile  Visit bobby131313's Homepage
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
Go to Top of Page

Carefree
Advanced Member

Philippines
4206 Posts

Posted - 28 February 2016 :  23:01:19  Show Profile
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
Go to Top of Page

bobby131313
Senior Member

USA
1163 Posts

Posted - 29 February 2016 :  10:47:03  Show Profile  Visit bobby131313's Homepage
Thank you! I'll check it out later today.

Switch the order of your title tags
Go to Top of Page
  Previous Topic Topic Next Topic  
 New Topic
 Printer Friendly
Jump To:
Snitz Forums 2000 © 2000-2021 Snitz™ Communications Go To Top Of Page
This page was generated in 0.21 seconds. Powered By: Snitz Forums 2000 Version 3.4.07