<%@LANGUAGE="VBSCRIPT"%>
Document Archive. The Palestinian Human Rights Monitoring Group (PHRMG)
<%
'Option Explicit
On Error Resume Next
Response.Buffer = true
' declare variables
Dim objFSO, objFolder
Dim objCollection, objItem
Dim strPhysicalPath, strTitle, strServerName
Dim strPath, strTemp
Dim strName, strFile, strExt, strAttr
Dim intSizeB, intSizeK, intAttr, dtmDate
' declare constants
Const vbReadOnly = 1
Const vbHidden = 2
Const vbSystem = 4
Const vbVolume = 8
Const vbDirectory = 16
Const vbArchive = 32
Const vbAlias = 64
Const vbCompressed = 128
dim slashCounter
' don't cache the page
Response.AddHeader "Pragma", "No-Cache"
Response.CacheControl = "Private"
' get the current folder URL path
strTemp = Mid(Request.ServerVariables("URL"),2)
' At start strTemp is phrmg documents/Assasination/Testimonies/Arabic/default.asp
'Response.Write strTemp & " at beginning"
strPath = ""
dim counter
counter = 0
dim arr(20)
'As long as there is a / in strTemp which is the url string without the www.phrmg.org/
Do While Instr(strTemp,"/")
'Response.Write " " & Counter & " = counter for next" & " "
'strPath is strPath (which starts off at "") plus strPath and left
'and the characters to the left of the first /
strPath = strPath & Left(strTemp,Instr(strTemp,"/"))
'Response.Write "strPath =" & strPath & " "
'put the existing strPath string at this point of the loop into
' one subset of an array. So it would start off as arr(0) = phrmg documents/
arr(counter) = strPath
'Response.Write " arr(counter)=" & arr(counter) & " "
'strTemp is strTemp after the first slash so at the first loop it would be
'Assasination/Testimonies/Arabic/default.asp
'strTemp essentially holds the remainder of the original url string (without www.phrmg.org)
strTemp = Mid(strTemp,Instr(strTemp,"/")+1)
'Response.Write " strTemp in the loop=" & strTemp & " "
counter = counter + 1
Loop
'add a / to beginning of strPath
strPath = "/" & strPath
' build the page title
'www.phrmg.org
strServerName = UCase(Request.ServerVariables("SERVER_NAME"))
'Response.Write " " & "strServerName is: " & strServerName
'Now we need to build a string which contains hrefs before each directory
'and a friendly description of the directory as well
'we have all the information we need in the arr(Counter) array
'We need a loop which runs from 0 to counter
'All we need to do is build a huge string containing both anchor tags and friendly descriptions
'from the arr(counter) array
'Response.Write " " & "value of counter before building string is: " & Counter
Dim num
num = 0
dim strFinal
strFinal = ""
dim slashPos
dim tmpStr
'need to go to counter - 1 because in previous loop 1 is added to counter at the end
'so you overshoot by 1 more than you need
For num = 0 to Counter - 1
'build the name of the directory which will appear in the string
'Response.Write "num at start = " & num & " "
'Response.Write "arr(num) at start = " & arr(num) & " "
tmpStr = mid(arr(num),1,(Len(arr(num))-1)) 'drop the last / from the arr(num)
'Response.Write "tmpstr after dropping last / =" & tmpstr & " "
'extract the final folder only
if num > 0 then slashPos = (Len(arr(num-1)) )'find position of first slash from right
'Response.Write " " & "slashPos = " & slashPos & " "
'if past first directory extract all the text to slashpos from right
if num > 0 then tmpStr= mid(tmpStr,slashPos +1)
'Response.Write "tmpStr = " & tmpStr & " "
'make sure current directory is not an a href link, but only previous directories in
'the hierarchy
if num < (counter - 1) then
strFinal = strFinal & "" & tmpStr & ""
else
strFinal = strFinal & tmpStr
end if
if num < (counter - 1) then strFinal = strFinal & ">"
'Response.Write " " & "num = " & num & " "
'Response.Write "strFinal = " & strFinal & " "
next
strTitle = strFinal
' create the file system objects
strPhysicalPath = Server.MapPath(strPath)
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strPhysicalPath)
%>
<%
''''''''''''''''''''''''''''''''''''''''
' output the folder list
''''''''''''''''''''''''''''''''''''''''
Set objCollection = objFolder.SubFolders
For Each objItem in objCollection
strName = objItem.Name
if right(strName,6)<> "_files" then
'strAttr = MakeAttr(objItem.Attributes)
'dtmDate = CDate(objItem.DateLastModified)
%>
<%
Set objFSO = Nothing
Set objFolder = Nothing
' this adds the IIf() function to VBScript
Function IIf(i,j,k)
If i Then IIf = j Else IIf = k
End Function
' this function creates a string from the file atttributes
Function MakeAttr(intAttr)
MakeAttr = MakeAttr & IIf(intAttr And vbArchive,"A","-")
MakeAttr = MakeAttr & IIf(intAttr And vbSystem,"S","-")
MakeAttr = MakeAttr & IIf(intAttr And vbHidden,"H","-")
MakeAttr = MakeAttr & IIf(intAttr And vbReadOnly,"R","-")
End Function
%>
