NSW Government Workplace Guidelines

<%Option Explicit%> <% Dim arrFolderExcludes Dim arrFileExcludes arrFolderExcludes = Array("images") arrFileExcludes = Array("text.htm", "strategic_3.html")', "revision.htm") %> <% 'IF NOT Trim(Request("searchstring")) = "" THEN Const ForReading = 1 Dim searchstring searchstring = trim(request("searchstring")) Dim i dim searchArray searchstring = LCase(trim(Replace(searchstring, ",", " "))) searchArray = split(searchstring, " ") Dim fso1 set fso1 = Server.CreateObject("Scripting.FileSystemObject") Dim startfolder startfolder = fso1.GetFolder(Server.MapPath(".")) set fso1 = nothing If mid(startfolder,Len(startfolder)-1) <> "\" Then startfolder = startfolder & "\" End If Dim numResults numResults = 0 Sub LoopDirectory(path) Dim FSO Set FSO = Server.CreateObject("Scripting.FileSystemObject") Dim f, fc, f1, thisfile set f = FSO.GetFolder(path) Set fc = f.Files on error resume next For Each f1 in fc Dim File, line, extension thisfile = f1.name extension = trim(Mid(thisfile, InStrRev(thisfile, ".") + 1)) Dim exclude exclude = false for i = 0 to UBound(arrFileExcludes) if LCase(thisfile) = LCase(arrFileExcludes(i)) then exclude = true end if next If InStr(LCase(extension), "htm") > 0 and not exclude Then Dim size size = CInt(UBound(searchArray)) Dim arrResults(0) Redim arrResults(size) If FSO.FileExists(path&thisfile) Then Set File = FSO.OpenTextFile(path&thisfile, ForReading) Dim wholeFile, tempFile wholeFile = File.ReadAll wholeFile = replace(wholeFile, vbTab, " ") wholeFile = replace(wholeFile, chr(9), " ") wholeFile = replace(wholeFile, " ", " ") while InStr(wholeFile, " ") > 0 wholeFile = replace(wholeFile, " ", " ") wend Dim tStart tStart = LCase("""Heading1""") Dim titleS, titleE, title, start title = "" titleS = 1 titleE = 0 start = 1 while title = "" and titleS > 0 titleS = instr(start, LCase(wholeFile), tStart) if titleS > 0 then titleS = instr(instr(start, LCase(wholeFile), tStart), LCase(wholeFile), ">") titleE = instr(titleS+1, LCase(wholeFile), ".. x = 1 while x > 0 x = InStr(LCase(wholeFile), ""), wholeFile, ">")+1 if not (x = 0 or x1-1 = 0) then tag = Mid(wholeFile, x, x1-x) wholeFile = Replace(wholeFile, tag, "") end if wend ' remove x = 1 while x > 0 x = InStr(LCase(wholeFile), ""), wholeFile, ">")+1 if not (x = 0 or x1-1 = 0) then tag = Mid(wholeFile, x, x1-x) wholeFile = Replace(wholeFile, tag, "") end if wend ' remove x = 1 while x > 0 x = InStr(LCase(wholeFile), ""), wholeFile, ">")+1 if not (x = 0 or x1-1 = 0) then tag = Mid(wholeFile, x, x1-x) wholeFile = Replace(wholeFile, tag, "") end if wend ' remove all tags x = 1 while x > 0 x = InStr(wholeFile, "<") x1 = InStr(x, wholeFile, ">")+1 if not (x = 0 or x1-1 = 0) then tag = Mid(wholeFile, x, x1-x) wholeFile = Replace(wholeFile, tag, "") end if wend ' remove "back to top" x = InStr(LCase(wholeFile), "<back") x1 = InStr(x, LCase(wholeFile), ">")+4 if not (x = 0 or x1-4 = 0) then tag = Mid(wholeFile, x, x1-x) wholeFile = Replace(wholeFile, tag, "") end if wholeFile = trim(wholeFile) tempFile = LCase(wholeFile) Dim firstAt firstAt = -1 for i = 0 to UBound(searchArray) Dim foundAt foundAt = instr(tempFile, searchArray(i)) If (foundAt > 0) Then arrResults(i) = arrResults(i) + 1 if firstAt = -1 or foundAt < firstAt then firstAt = foundAt end if End If next Dim blob If firstAt > 0 then Dim blobS, blobE blobS = InStrRev(wholeFile, ". ", firstAt) + 2 blobE = InStr(firstAt, wholeFile, ".") if blobS-2 = 0 then blobS = 1 end if if blobE = 0 then blobE = firstAt + 80 if blobE > len(wholeFile) then blobE = len(wholeFile) end if end if if blobE - blobS > 220 then if firstAt - blobS > 100 then blobS = firstAt - 100 end if end if if blobE - blobS > 220 then if blobE - firstAt > 100 then blobE = firstAt + 100 end if end if blob = Trim(Mid(wholeFile, blobS, blobE-blobS)) blobS = InStr(1, blob, " ")+1 blobE = InStrRev(blob, " ", len(blob)) if InStrRev(blob, ",", len(blob)) = blobE or InStrRev(blob, ".", len(blob)) = blobE or InStrRev(blob, "!", len(blob)) = blobE or InStrRev(blob, "?", len(blob)) = blobE then blobE = blobE - 1 end if blob = "..." & Mid(blob, blobS, blobE-blobS) & "..." 'blob = Mid(blob, blobS, blobE-blobS) if trim(blob) <> "" then blob = trim(blob) for i = 0 to UBound(searchArray) x = Len(blob) dim word, tagS, tagE tagS = "" tagE = "" while x > 0 x = InStrRev(LCase(blob), searchArray(i), x) word = mid(blob, x, len(searchArray(i))) if x > 0 then blob = Left(blob, x-1) & Replace(blob, word, tagS&word&tagE, x, 1) end if wend next end if end if Dim tempPath tempPath = path&thisfile tempPath = trim(Mid(tempPath, InStr(tempPath, startfolder)+Len(startfolder))) tempPath = replace(tempPath, "\", "/") Dim flag flag = true for i = 0 to cint(UBound(arrResults)) if arrResults(i) < 1 then flag = false end if next if flag = true then numResults = numResults + 1 response.Write "

" & title & "" Dim d d = FSO.GetFile(path&thisfile).DateLastModified response.Write "
" &blob& "" response.Write " | " & Day(d) & " " & MonthName(Month(d)) & " " & Year(d) response.Write "

" end if ReDim arrResults(0) Erase arrResults File.Close End If End If Next Dim fsub Set fsub = f.SubFolders For Each f1 in fsub exclude = false for i = 0 to UBound(arrFolderExcludes) if LCase(f1.name) = LCase(arrFolderExcludes(i)) then exclude = true end if next if not exclude then LoopDirectory(path & f1.name & "\") end if Next End Sub 'END IF %> NSW Government Workplace Guidelines