<%@ Language=VBScript %>
<% Response.Buffer=true%>
<%
'response.write connectstr & "
"
'response.end
Set rst_filesread=nothing
Set rst_filesread=Server.CreateObject("ADODB.recordset")
strquery="truncate allfiles;"
'rst_filesread.Open strQuery, connectstr
on error resume next
'Make each a link to run the list_pdf.asp which accepts the location then displays the photos of that folder.
response.write "Search
"
'Change the following to the correct start location:
ListFolder "uploads\"
' -- Main Functions ----------------------------------------------------
Sub ListFolder(path)
Dim fs, rootPath
Set fs = CreateObject("Scripting.FileSystemObject")
rootPath = path
ListFolderContents fs.GetFolder(Server.MapPath("/coslintranet/agreements/uploads")), PathEncode(rootPath)
End Sub
' ----------------------------------------------------------------------
Sub ListFolderContents(folder, relativePath)
Dim child
Say ""
'Say relativePath
'response.write "" & relativepath & "
"
Set rst_foldersread=nothing
Set rst_foldersread=Server.CreateObject("ADODB.recordset")
strquery="select foldername from allfolders where foldername='" & relativepath & "'"
rst_foldersread.Open strQuery, connectstr
if Err.number<>0 then
response.write "
" & "
1 Error Number: " & Err.number & "
"
response.write "
" & "
Error: " & Err.description & "
"
end if
if rst_foldersread.eof then
Set rst_folders=nothing
Set rst_folders=Server.CreateObject("ADODB.recordset")
strquery="insert into allfolders ( foldername) values ('" & relativepath & "')"
rst_folders.Open strQuery, connectstr
if Err.number<>0 then
response.write "
" & "
2 Error Number: " & Err.number & "
"
response.write "
" & "
Error: " & Err.description & "
"
end if
end if
relativepath="./"
Set MyDirectory=Server.CreateObject("Scripting.FileSystemObject")
Set MyFiles=MyDirectory.GetFolder(Server.MapPath(relativepath))
'response.write "
" & MyFiles & "
"
'response.end
'==========
'==========
For each filefound in MyFiles.files
thisfile=filefound.Name
Filenameheader = thisfile
thisfile=Replace(thisfile, "'", "'")
if instr(thisfile, ".pdf")>1 then
thisfiletext=left(thisfile, instr(thisfile,".pdf")-1)
'Comment out the next line so as to not print the file name here
Response.Write "" & thisfiletext & "
"
Set rst_filesread=nothing
Set rst_filesread=Server.CreateObject("ADODB.recordset")
strquery="select filename from allfiles where filename='" & thisfile & "' and foldername='" & relativepath & "'"
rst_filesread.Open strQuery, connectstr
if Err.number<>0 then
response.write "
" & "
1 Error Number: " & Err.number & "
"
response.write "
" & "
Error: " & Err.description & "
"
end if
if rst_filesread.eof and instr(thisfile,"insur")=0 and instr(thisfile,"Insur")=0 and left(thisfile, 4)<>"COI " then
Set rst_files=nothing
Set rst_files=Server.CreateObject("ADODB.recordset")
strquery="insert into allfiles (foldername, filename) values ('" & relativepath & "','" & thisfile & "')"
rst_files.Open strQuery, connectstr
if Err.number<>0 then
response.write "
" & "
2 Error Number: " & Err.number & "
"
response.write "
" & "
Error: " & Err.description & "
"
end if
end if
end if
Next
For Each child In folder.SubFolders
If Not IsHidden(child) Then
ListFolderContents child, relativePath & PathEncode(child.Name) & "/"
End If
Next
relativePath = h(relativePath)
For Each child In folder.Files
on error resume next
If Not IsHidden(child) Then
relativePath1=relativePath
End If
Next
Say "
"
End Sub
' -- Helper Functions / Shorthands ---------------------------------------
Sub Say(s)
Response.Write s & vbNewLine
End Sub
Function h(s)
h = Server.HTMLEncode(s)
End Function
Function PathEncode(s)
' this creates a more correct variant of what Server.URLEncode would do
PathEncode = Replace(s, "\", "/")
PathEncode = Server.URLEncode(PathEncode)
PathEncode = Replace(PathEncode, "+", "%20")
PathEncode = Replace(PathEncode, "%2F", "/")
PathEncode = Replace(PathEncode, "%2E", ".")
PathEncode = Replace(PathEncode, "%5F", "_")
End Function
Function IsHidden(File)
IsHidden = File.Attributes And 2 = 2
End Function
%>