Skip to content

Instantly share code, notes, and snippets.

@evagoras

evagoras/.wsh

Last active September 28, 2023 15:33
Show Gist options
  • Save evagoras/21debe96ead8043047ca833c3c0f2e05 to your computer and use it in GitHub Desktop.
Save evagoras/21debe96ead8043047ca833c3c0f2e05 to your computer and use it in GitHub Desktop.
Download ZIP
The Windows 2000 Indexing Service
Raw
.wsh
[ScriptFile]
Path=C:\ServerScripts\SendEmailOnServiceFail.vbs
[Options]
Timeout=20
DisplayLogo=1
Raw
form-1-5
<form action="runsearch.asp" method="post" name="form1">
<table cellpadding="2" cellspacing="0" border="0" align="left">
<tr>
<td width="50">&nbsp;</td>
<td colspan="2">
<b>Enter your query below:</b><br>
<input type="text" name="Query" size="45" maxlength="100" value=""></td>
</tr>
...
Raw
form-2-5
...
<tr>
<td>&nbsp;</td>
<td align="right">
<select name="Scope">
<option value="/" selected>Entire Site</option>
<option value="/products/">Products</option>
<option value="/services/">Services</option>
<option value="/news_events/">News & Events</option>
<option value="/about_us/">About us</option>
</select></td>
<td>Search where?</td>
</tr>
...
Raw
form-3-5
...
<tr>
<td>&nbsp;</td>
<td align="right">
<select name="RecordsPerPage">
<option value="10" selected>10</option>
<option value="25">25</option>
<option value="50">50</option>
<option value="100">100</option>
</select></td>
<td>Number of results per page</td>
</tr>
...
Raw
form-4-5
...
<tr>
<td>&nbsp;</td>
<td align="right">
<select name="Order">
<option value="Rank" selected>Ranking Result</option>
<option value="Size">Size</option>
<option value="Write">Last Date updated</option>
</select></td>
<td>Arrange in order</td>
</tr>
...
Raw
form-5-5
...
<tr>
<td>&nbsp;</td>
<td align="right"><input type="SUBMIT" value="Search" name="SUBMIT"></td>
<td>&nbsp;</td>
</tr>
<tr>
<td>&nbsp;</td>
<td>&nbsp;</td>
<td>&nbsp;</td>
</tr>
</table>
</form>
Raw
search-1-5
<%@Language="VBScript"%>
<%Option Explicit%>
<%Response.Buffer = True%>
<html>
<head>
<title>Search Results</title>
</head>
<body>
<%
On Error Goto 0
Dim strQuery 'user entered text for search
Dim intPage 'page number we are on
Dim intStartingRecord 'point to start selecting from the recordset
Dim intRecordsPerPage 'developer defined
Dim strOrder 'developer defined: what to order against
Dim strScope 'Scope to search against
Dim QUOT 'character 32 for ease of coding
Dim strNavigation 'HTML string for navigation links/info
Dim starslocation 'folder path for search images
Dim strCatalog 'developer defined catalog name: query against this
Dim strCustomTitle 'starting string to remove from the title of html pages
'***** EDIT THESE **********************
starslocation = "images/"
strCatalog = "english"
strCustomTitle = "Xefteri - "
'***** END EDIT ************************
...
Raw
search-2-5
<html>
<head>
<title>XYZ - Welcome to our site!</title>
</head>
Raw
search-3-5
...
'-- collect values from request
' leave request object open to account for both post and get
strQuery = Request("Query")
strQuery = Server.HTMLEncode(strQuery)
intPage = Request("PAGE")
intRecordsPerPage = Request("RecordsPerPage")
strOrder = Request("Order")
strScope = Request("Scope")
'-- define values
QUOT = Chr(34)
strNavigation = ""
'-- account for people trying to hack
'-- set max and min values for URL values
Select Case intPage
Case ""
intPage = 1
Case intPage > 32767
Response.Write("Page number out of limit!")
Response.End
Case intPage < 0
Response.Write("Page number out of limit!")
Response.End
Case Else
intPage = CInt(intPage)
End Select
If intRecordsPerPage > 1000 OR intRecordsPerPage < 0 Then
Response.Write("Records Per Page out of limit!")
Response.End
Else
intRecordsPerPage = CInt(intRecordsPerPage)
End If
strOrder = Server.HTMLEncode(strOrder)
strScope = Server.HTMLEncode(strScope)
If InStr(strScope, "..") Then
Response.Write("Invalid Scope!")
Response.End
End If
'-- if bad query string supplied (less than 2 characters), show message
If Len(strQuery) < 2 Then
Response.Write("<p><b>Sorry, but the search text must be at least two characters long.</b></p>")
Response.End
'-- if the user is trying to cause an overflow in the query string catch it
Elseif Len(strQuery) > 100 Then
Response.Write("<p><b>Sorry, but the search text must be less than 100 characters long.</b></p>")
Response.End
End If
'-- evaluate starting record in the recordset
intStartingRecord = ((intPage - 1) * intRecordsPerPage) + 1
'-- main sub that calls everything else
Call RunSearch()
...
Raw
search-4-5
...
Sub RunSearch()
Dim strSearch 'function-returned SQL query
Dim objConn 'Connection object
Dim objRS 'Recordset object
Dim intTotalRecords 'Recordset.RecordCount
Dim intTotalPages 'objRS.PageCount
Dim arrAllData 'Recordset.GetRows()
Dim numrows 'UBound of arrAllData to get the total rows in objRS
Dim rowcounter 'simple counter used in the loop
Dim strDocTitle 'objRS("DocTitle")
Dim lengthstrDocTitle 'Len(objRS("DocTitle"))
Dim strFilename 'objRS("Filename")
Dim strVPath 'objRS("VPath")
Dim intSize 'objRS("Size")
Dim datWrite 'objRS("Write")
Dim strCharacterization 'objRS("Characterization")
Dim numRank 'objRS("Rank")
Dim NormRank 'Rank/10 = change to a percentage
Dim stars 'image to display for Ranking
'-- build up the query string by calling the BuildQuery function
strSearch = BuildQuery(strScope, strQuery)
'-- create a connection object to execute the query
Set objConn = Server.CreateObject("ADODB.Connection")
objConn.ConnectionString = "provider=msidxs; Data Source=" & strCatalog
objConn.Open
'-- create a recordset to hold the data
Set objRS = Server.CreateObject("ADODB.RecordSet")
objRS.CursorLocation = 3 'adUseClient
objRS.Open strSearch, objConn, 0, 1 'adOpenForwardOnly, adLockReadOnly
'-- if errors occured
If Err.Number <> 0 Then
Response.Clear
Response.Write("<p><b>There was an error processing your request.<br>Please go back and try again.</b></p>")
'-- close all objects to free up resources
objRS.Close
Set objRS = Nothing
objConn.Close
Set objConn = Nothing
Response.End
Else
'-- no errors but no records returned
If objRS.EOF and objRS.BOF Then
Response.Clear
Response.Write("<p><b>No pages that matched your query </b>[<b>" & strQuery & "</b>]<b> were found.</b></p>")
'-- close all objects to free up resources
objRS.Close
Set objRS = Nothing
objConn.Close
Set objConn = Nothing
Response.End
'-- or if there was no error and some records were successfully returned then
Else
'-- set the recordset starting position so that we can get the number
' of records we want from this point on using the GetRows() function
objRS.AbsolutePosition = intStartingRecord
'-- set the pagesize through the object so we can count # of pages returned
objRS.PageSize = intRecordsPerPage
'-- # of total records found
intTotalRecords = objRS.RecordCount
'-- # of total pages found
intTotalPages = objRS.PageCount
'-- create a 2 simensional array of the records using GetRows()
' and only select how many records we want to see per page
arrAllData = objRS.GetRows(intRecordsPerPage)
'-- close all objects to free up resources
objRS.Close
Set objRS = Nothing
objConn.Close
Set objConn = Nothing
'-- write table to wrap contents with a margin equal to the cellpadding
Response.Write("<div align=""left""><table border=""0"" cellspacing=""0"" cellpadding=""10"" align=""left""><tr><td>")
'-- write top/bottom navigation links/info
' by calling the WriteNavigation() sub
Call WriteNavigation(strNavigation, intTotalRecords, intTotalPages)
'-- table with contents of search inside
Response.Write("<br><table border=""0"" cellspacing=""0"" cellpadding=""0"" width=""100%"">")
'-- find out how many rows we have
' this should be the same as the intRecordsPerPage but not always
' an exception would be when the last page does not have enough left
numrows = UBound(arrAllData,2)
'-- now loop through the records
For rowcounter= 0 To numrows
'-- row values held in variables for ease of use
strDocTitle = arrAllData(0, rowcounter)
strFilename = arrAllData(1, rowcounter)
strVPath = arrAllData(2, rowcounter)
intSize = FormatNumber(arrAllData(3, rowcounter))
datWrite = arrAllData(4, rowcounter)
strCharacterization = arrAllData(5, rowcounter)
numRank = arrAllData(6, rowcounter)
'-- create an empty space if the field is empty
' for proper display of the table <td></td>
If IsNull(strCharacterization) Or Trim(strCharacterization) = "" Then
strCharacterization = "&nbsp;"
End If
Response.Write("<tr><td bgcolor=""#AACCEE"" align=""right"">" _
& intStartingRecord & ")</td>" _
& "<td bgcolor=""#AACCEE"" width=""5"">&nbsp</td>" _
& "<td bgcolor=""#AACCEE""><a href=""" & strVPath & """>")
'-- if title found in header is bigger than 2 characters
' it probably means that there is a <title> for this document
If Len(strDocTitle) > 2 Then
'-- look for and get rid of custom title words used for search engines
' only if your strCustomTitle string is not empty
' and those words are in the beginning of the title
If strCustomTitle <> "" Then
If LCase(Left(strDocTitle, Len(strCustomTitle))) = LCase(strCustomTitle) Then
lengthstrDocTitle = Len(strDocTitle)
strDocTitle = Mid(strDocTitle,Len(strCustomTitle), lengthstrDocTitle)
End If
End If
Response.Write(Server.HTMLEncode(strDocTitle))
'-- no title found in header or could not pick it up
' write filename instead so users have something to click on
Else
Response.Write(Server.HTMLEncode(strFilename))
End If
Response.Write("</a></td></tr>" _
& "<tr><td align=""left"" valign=""top"">")
'-- show proper image for ranking
NormRank = numRank/10
If NormRank > 80 Then
stars = "rankbtn5.gif"
ElseIf NormRank > 60 Then
stars = "rankbtn4.gif"
ElseIf NormRank > 40 Then
stars = "rankbtn3.gif"
ElseIf NormRank > 20 Then
stars = "rankbtn2.gif"
Else
stars = "rankbtn1.gif"
End If
'-- Chr(37) = %
'-- write correct image and percentage ranking
Response.Write("<img src=""" & starslocation & stars & """><br>" _
& NormRank & Chr(37) & "</td><td>&nbsp;</td>" _
& "<td align=""left"" valign=""top"">")
'-- write summary of the page
Response.Write(strCharacterization & "<br><br><i>")
'-- write file size or show error in case
' we have a NULL value returned
If Trim(intSize) = "" Or IsNull(intSize) Then
Response.Write("(size unknown) - ")
Else
Response.Write("size " & FileSize(intSize) & " - ")
End If
'-- write date last modified or show error in case
' we have a NULL value returned for DateLastModified
If Trim(datWrite) = "" Or IsNull(datWrite) Then
Response.Write("(time unknown)")
Else
Response.Write(myFixDate(datWrite) & " GMT")
End If
Response.Write("</i></td></tr>" _
& "<tr><td colspan=""3"">&nbsp;</td></tr>")
'-- increment the number listing showing on the left by one
intStartingRecord = intStartingRecord + 1
Next 'rowcounter= 0 To numrows
'-- end of table with search contents
Response.Write("</table><hr width=""100%"" size=""2"" noshade>")
'-- now write again the top navigation menu we generated
' we don't need to call the sub again because
' it's now in a local variable
Response.Write(strNavigation)
'-- close wrapping table
Response.Write("<br></td></tr></table></div>")
End If 'objRS.EOF and objRS.BOF
End If 'Err.Number <> 0
End Sub
...
Raw
search-5-5
...
'-- build SQL query string for Index Server ADO query
Function BuildQuery(strScope, strQuery)
Dim strPropertyName
Dim SQL 'SQL string to search against
Dim strQText
Dim blnAddedQ
Dim intQPos
SQL = "SELECT DocTitle, Filename, Vpath, Size, Write, Characterization, Rank FROM "
If strScope = "" Then
SQL = SQL & "SCOPE() "
Else
SQL = SQL & "SCOPE('DEEP TRAVERSAL OF " & QUOT & strScope & QUOT & "')"
End if
strQText = strQuery
If InStr(strQText, " ") > 0 Or InStr(strQText, "'") > 0 Then
blnAddedQ = False
If Left(strQText, 1) <> QUOT Then
strQText = QUOT & strQText
blnAddedQ = True
End If
If Right(strQText, 1) <> QUOT Then
strQText = strQText & QUOT
blnAddedQ = True
End If
If blnAddedQ Then
intQPos = Instr(2, strQText, QUOT)
Do While intQPos > 0 And intQPos < Len(strQText)
strQText = Left(strQText, intQPos - 1) & " " & Mid(strQText, intQPos + 1)
intQPos = Instr(2, strQText, QUOT)
Loop
End If
End If
SQL = SQL & "WHERE CONTAINS ('" & strQText & "') > 0"
'-- If you want to add your files here, like asp for example
' then add another line like this:
' SQL = SQL & " OR Filename LIKE '%.asp'"
SQL = SQL & " AND (Filename LIKE '%.html'"
'-- comment any of next lines to exclude certain files
SQL = SQL & " OR Filename LIKE '%.asp'"
SQL = SQL & " OR Filename LIKE '%.pdf'"
SQL = SQL & " OR Filename LIKE '%.doc'"
SQL = SQL & " OR Filename LIKE '%.xls'"
SQL = SQL & " OR Filename LIKE '%.ppt'"
SQL = SQL & " OR Filename LIKE '%.txt'"
SQL = SQL & " OR Filename LIKE '%.htm')"
SQL = SQL & " ORDER BY " & strOrder & " DESC"
BuildQuery = SQL
End Function
'-- make HTML string for navigation links
' on the top and bottom of the page
' this sub first creates the navigation,
' then stores it in a local variable (strNavigation)
' so we can use it again without needing to call the sub,
' and then writes it to the response
Sub WriteNavigation(strNavigation, intTotalRecords, intTotalPages)
Dim strScriptName
strScriptName = Request.ServerVariables("SCRIPT_NAME")
'-- controls to scroll to next or previous pages
strNavigation = "<center>" _
& "<a href=""index.html"">New Query</a><br>" _
& intTotalRecords & " total documents matching the query """ _
& strQuery & """<br>" _
& "Page " & intPage & " of " & intTotalPages & "<br>"
'-- if we are on the first page then the First and Previous Page
' do not need to be active
If intPage = 1 Then
strNavigation = strNavigation & "First Page&nbsp;&nbsp;Previous Page&nbsp;"
'-- else if we are not on the first page make those links active
Else
strNavigation = strNavigation & "<a href=""" & strScriptName _
& "?Query=" & strQuery & "&PAGE=1" _
& "&RecordsPerPage=" & intRecordsPerPage _
& "&Order=" & strOrder & "&Scope=" & strScope & """>First Page</a>&nbsp;" _
& "&nbsp;<a href=""" & strScriptName _
& "?Query=" & strQuery & "&PAGE=" & intPage - 1 _
& "&RecordsPerPage=" & intRecordsPerPage _
& "&Order=" & strOrder & "&Scope=" & strScope & """>Previous Page</a>&nbsp;"
End If
'-- if we are on the last page then there is no need
' to make the Next and Last Page active
If intPage = intTotalPages Then
strNavigation = strNavigation & "&nbsp;Next Page&nbsp;&nbsp;Last Page"
'-- else if we are not on the last page, then make them active
Else
strNavigation = strNavigation & "&nbsp;<a href=" & QUOT & strScriptName _
& "?Query=" & strQuery & "&PAGE=" & intPage + 1 _
& "&RecordsPerPage=" & intRecordsPerPage _
& "&Order=" & strOrder & "&Scope=" & strScope & """>Next Page</a>&nbsp;" _
& "&nbsp;<a href=" & QUOT & strScriptName _
& "?Query=" & strQuery & "&PAGE=" & intTotalPages _
& "&RecordsPerPage=" & intRecordsPerPage _
& "&Order=" & strOrder & "&Scope=" & strScope & """>Last Page</a>"
End If
strNavigation = strNavigation & "</center>"
Response.Write(strNavigation)
End Sub
'-- format filesize
Function FileSize(intFileSize)
const DecimalPlaces = 1
const FileSizeBytes = 1
const FileSizeKiloByte = 1024
const FileSizeMegaByte = 1048576
const FileSizeGigaByte = 1073741824
const FileSizeTeraByte = 1099511627776
Dim strFileSize, newFilesize
If (Int(intFileSize / FileSizeTeraByte) <> 0) Then
newFilesize = Round(intFileSize / FileSizeTeraByte, DecimalPlaces)
strFileSize = newFilesize & " TB"
ElseIf (Int(intFileSize / FileSizeGigaByte) <> 0) Then
newFilesize = Round(intFileSize / FileSizeGigaByte, DecimalPlaces)
strFileSize = newFilesize & " GB"
ElseIf (Int(intFileSize / FileSizeMegaByte) <> 0) Then
newFilesize = Round(intFileSize / FileSizeMegaByte, DecimalPlaces)
strFileSize = newFilesize & " MB"
ElseIf (Int(intFileSize / FileSizeKiloByte) <> 0) Then
newFilesize = Round(intFileSize / FileSizeKiloByte, DecimalPlaces)
strFileSize = newFilesize & " KB"
ElseIf (Int(intFileSize / FileSizeBytes) <> 0) Then
newFilesize = intFilesize
strFileSize = newFilesize & " Bytes"
ElseIf Int(intFileSize) = 0 Then
strFilesize = 0 & " Bytes"
End If
FileSize = strFileSize
End Function
'-- format date properly for international viewing
Function myFixDate(datWrite)
Dim strHTMLout
strHTMLout = FormatDateTime((datWrite), 1) & " at " & FormatDateTime((datWrite), 3)
myFixDate = strHTMLout
End Function
%>
</body>
</html>
Raw
send-mail
'-- Declare variables
Dim objSendMail
Dim objAdminISS
'-- The following stops and restarts Indexing Service
' comment the following 4 lines not to use this feature.
' To use this object you need administrative access
Set objAdminIS = CreateObject("Microsoft.ISAdm")
objAdminIS.Stop() 'Make sure it's off first
objAdminIS.Start() 'And then restart it
Set objAdminIS = Nothing
'-- Send email when service fails
Set objSendMail = CreateObject("CDONTS.NewMail")
'change the FROM and TO below
objSendMail.From = "someone@somewhere.com"
objSendMail.To = "youremail@yourdomain.com"
objSendMail.Subject = "Indexing Service has failed!"
objSendMail.Body = "<H2><FONT COLOR=Red>" & Date() & " - " & Time() & "</FONT></H2>" & "The Indexing Service has failed. Please check your server!"
objSendMail.BodyFormat = 0 'Body property is HTML
objSendMail.MailFormat = 0 'MIME format
objSendMail.Importance = 2 'High Importance
objSendMail.Send
Set objSendMail = Nothing
@evagoras
Copy link
Author

https://evagoras.com/2011/02/01/the-windows-2000-indexing-service/

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment