<%	
'***********************************************************************
' Comments   : Calls stored proc to write event log
' Parameters : strLogText = General comments to log
'				strLogType = a way of grouping messages
'				strLogData = might be used for SQL?, etc
' Returns    : nothing (just writes HTML)
' Created    : Enterprise Software Solutions [08/01/2002]
' Modified   : 
'***********************************************************************
Sub SetApplication(strApplication)
	Session("Application") = strApplication
End Sub
%>

<%
'***********************************************************************
' Comments   : Gets the current path
' Parameters : none
' Returns    : The current path
' Created    : Enterprise Software Solutions [01/03/2003]
' Modified   :
'***********************************************************************
Public Function CurrentPath()
Dim strThisFileName
Dim strPath
Dim aPathArray

	'***** the server variable will include the file name, so remove it
	strPath = Request.ServerVariables("PATH_TRANSLATED")
	
	'the filename is the last piece following the last "\"
	aPathArray = Split(strPath,"\")
	strThisFileName = aPathArray(uBound(aPathArray))
	strPath = Replace(strPath, strThisFileName, "")
	
	'return the path
	CurrentPath = strPath
End Function
%>

<%
'***********************************************************************
' Comments   : Keeps an event log
' Parameters : text to log, a description of log enent type, misc data
' Returns    : nothing
' Created    : Enterprise Software Solutions [05/26/1999]
' Modified   :
'***********************************************************************
Public Sub LogEvent(strLogText, strLogType, strLogData)
On Error Resume Next

If Not(Application("EnableLog")) = True Then
	'the log is disabled
	Exit Sub	
End If

Dim objFileSystem
Dim objFileHandle
Const ForReading = 1
Const ForAppending = 8
'this const Opens the file as ASCII
Const TristateFalse = 0
Dim strLogFilePath

    
    'get path of log file
    strLogFilePath = CurrentPath() & "TempFiles\" & Session("Application") & ".log"

	'create the file object
	Set objFileSystem = server.CreateObject("Scripting.FileSystemObject")

    'initialize event log file
    If objFileSystem.FileExists(strLogFilePath) = True Then
        Set objFileHandle = objFileSystem.OpenTextFile(strLogFilePath, _
                ForAppending, TristateFalse)
      Else
        'create new log file
        Set objFileHandle = objFileSystem.CreateTextFile(strLogFilePath)
        objFileHandle.WriteLine ("This is the Event Log file for " & Session("Application") _
                & ".  The format is : [TimeStamp]" _
				& " ==> [ClientUserName (NULL=Anonymous)]" _
				& " ==> [ClientMachineName]" _
				& " ==> [Session]" _
                & " ==> [Log Text] ==> [Log Type] ==> [Log Data]")
        'use applicating logging also
    End If
     
    'log the event
    Call objFileHandle.WriteLine(Now() _
			& " ==> " & Request.ServerVariables("LOGON_USER") _
			& " ==> " & Request.ServerVariables("REMOTE_ADDR") _
			& " ==> " & Session.SessionID _
			& " ==> " & strLogText & " ==> " & strLogType & " ==> " & strLogData)
    
    On Error Resume Next
    'close the event log and clean up
    objFileHandle.Close
    Set objFileHandle = Nothing
    Set objFileSystem = Nothing
    Err.Clear 
End Sub
%>

<%
'***********************************************************************
' Comments   : Build the HTML table (Naviage method)
' Parameters : "^" row, Pipe delimted colums table data
'				TableProperties and CellTextProperties
'				bHasHeader = send "True" to make the first row a header
' Returns    : "OK" if all information is ready to submit
'				or "^" row, Pipe delimted colums set of allocations
'				or Pipe delimited error message
' Created    : Enterprise Software Solutions [08/01/2002]
' Modified   : 
'***********************************************************************
Sub MakeTable(strTableData, strTableProperties, strCellTextProperties, bHasHeader)
	'write call to the log
	Call LogEvent("MakeTable","Call", _
			"strTableData=" & strTableData _ 
			& "|   strTableProperties=" & strTableProperties _
			& "|   strCellTextProperties=" & strCellTextProperties)
	'initialize
	Response.Write vbcrlf & "<TABLE " & strTableProperties & ">"

	'loop though each recording building table rows
	Dim iRecord
	Dim i
	Dim aRecordArray
	Dim aFieldArray
	
	'records are "^" delimited
	aRecordArray = split(strtableData,"^")
	For iRecord=lbound(aRecordArray) to ubound(aRecordArray)
		Response.Write vbcrlf & vbTab & "<TR>"
		'fileds are pipe "|" delimited
		aFieldArray = split(aRecordArray(iRecord),"|")
		For i=lbound(aFieldArray) to ubound(aFieldArray)
			If iRecord=0 And cBool(bHasHeader) = True Then
				'make the first row a header row
				Response.Write "<TH><P style=" & chr(34) & strCellTextProperties & chr(34) & ">"
				Response.Write Trim(aFieldArray(i))
				Response.Write "</P></TH>"
			  else
				Response.Write "<TD><P style=" & chr(34) & strCellTextProperties & chr(34) & ">"
				Response.Write Trim(aFieldArray(i))
				Response.Write "</P></TD>"
			End If	
		Next
		Response.Write vbcrlf & vbTab & "</TR>"
	Next
	
	'finish up
	Response.Write vbcrlf & "</TABLE>" & vbcrlf
End Sub
%>

<%
'***********************************************************************
' Comments   : Checks whether arguement is
'                Null, Empty, empty string, or Nothing
' Parameters : varArg ==> the control or variable being checked
' Returns    : true if it is Null, Empty, empty string, or Nothing
' Created    : Enterprise Software Solutions [05/26/1999]
' Modified   : Enterprise Software Solutions [09/24/2001] check array for 0 elements
'***********************************************************************
Public Function IsNothing(varArg)
'	On Error resume next
	IsNothing = True

	Select Case VarType(varArg)
		Case vbEmpty
			IsNothing = True
		Case vbNull
			IsNothing = True
		Case vbString
			If Len(varArg) = 0 Then
				IsNothing = True
			End If
		Case vbObject
			If varArg Is Nothing Then
				IsNothing = True
			End If
		Case Else
			If Err.Number = 0 Then
				IsNothing = False
			End IF	
	End Select
End Function
%>

<%
'***************************************************************************
' Comments   : Get text in the middle of 2 strings
' Parameters : LeadingText, TrailingText
' Returns    : text in the middle
' Created    : Enterprise Software Solutions (05-26-1999)
' Modified   :
'***************************************************************************
Public Function MidStr(StringToSearch, LeadingText, TrailingText)
    MidStr = StringToSearch
    'strip off beginning of string
    If InStr(1, UCase(MidStr), UCase(LeadingText)) <> 0 And LeadingText <> "" Then
        MidStr = Mid(MidStr, _
                InStr(1, UCase(MidStr), UCase(LeadingText)) _
                + Len(LeadingText))
    End If
    'strip off ending of string
    If InStr(1, UCase(MidStr), UCase(TrailingText)) <> 0 And TrailingText <> "" Then
        MidStr = Mid(MidStr, 1, InStr(1, UCase(MidStr), UCase(TrailingText)) - 1)
    End If
End Function
%>

<%
'***********************************************************************
' Comments   : Write the error message box to client and navigates back
' Parameters : Message Text and page to navigate after user clicks OK
' Returns    : nothing (just writes HTML)
' Created    : Enterprise Software Solutions [12/16/2002]
' Modified   : 
'***********************************************************************
Sub WriteClientMessage(strMessageText, strNavigateTo)
	Call LogEvent("WriteClientMessage", "Call", strMessageText)
	Response.Write vbcrlf & "<HTML>"
	Response.Write vbcrlf & "<BODY>"
	Response.Write vbcrlf & "<SCRIPT LANGUAGE=vbscript>"
	Response.Write vbcrlf & "<!--"
	Response.Write vbcrlf & "Sub window_onload"
	Response.Write vbcrlf & "	msgbox " &chr(34) & strMessageText &chr(34)
	Response.Write vbcrlf & "	window.navigate " &chr(34) & strNavigateTo &chr(34)
	Response.Write vbcrlf & "End Sub"
	Response.Write vbcrlf & "-->"
	Response.Write vbcrlf & "</SCRIPT>"
	Response.Write vbcrlf & "</HTML>"
	Response.Write vbcrlf & "</BODY>"
	Response.End  
End Sub
%>

<%
'***********************************************************************
' Comments   : Write the error message to the screen in a readable way
' Parameters : error info stuff
' Returns    : nothing (just writes HTML)
' Created    : Enterprise Software Solutions [08/01/2002]
' Modified   : 
'***********************************************************************
Sub GotError(errNum, errDesc, errSrc, strErrorText)
	On Error Resume Next
	'log the error
	Call LogEvent("Error: " & errNum & "'" & errDesc & "' (" & errSrc & ")", _
			"Error", _
			strErrorText)
	
	Response.Clear 		
%>
	<FORM name=frm method=Post Action=Default.htm>
	<center><p><br>
	<h3 style="color:red;font-family:Verdana">An Error has occurred in the web Application</h3>
	<br>
	<table width=90% border=0 cellpadding=5 style="border-width:thin;border-color:red;border-style:solid">
	<tr bgcolor=#eeeeee><td align=center>
		<table width=90% border=0>
		<tr>
		<th align=left style="color:red">Error Description:
		<tr><td width=30% align=left><br>
		<td><%=errDesc%>
		<tr>
		<td colspan=2><hr>
		<tr>
		<th align=left style="color:red">Error Source:
		<tr>
		<td width=30%><br>
		<td><%=errSrc%>
		<tr>
		<td colspan=2><hr>
		<tr>
		<th align=left style="color:red">Error Number:
		<tr>
		<td width=30%><br>
		<td><%=errNum%>
		<tr>
		<td colspan=2><hr>
		<tr>
		<th align=left style="color:red">Info:
		<tr>
		<td width=30%><br>
		<td><%=strErrorText%>
		<tr>
		<td colspan=2><hr>
		<tr>
		</table>
	</table>
	</center>
	<P align=center><INPUT type=submit name=cmdSubmit value=Exit></P>
	</FORM>
	<%err.Clear%>
	<%Response.End%>
<%end sub

%>