• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 442
  • Last Modified:

Open Loop Crashing application pool

Hi,
The website is www.h-b-m.com and lately the site has been going down alot. In going back and forth with the hosting company, they have told me there may be some sort of open loop in the programming which is causing it to pull too many resources and flatlines the site. Some script that keeps repeating until it crashes. They have placed my site in its own application pool and set it to recycle every 30 minutes. But if there are alot of queryies within that 30 minutes it crashes and we are no where to be found. We are on a limited budget and I am concerned the Hosting Company will charge way too much to take care of this. I can not find any information on how to close a loop, or even what to look for to see if it is open / closed. Any advise is GREATLY appreciated!
Thank you,
Kristin
0
kristinahbm
Asked:
kristinahbm
  • 5
  • 4
1 Solution
 
rdivilbissCommented:
Chances are that you have poor code, but not likely an open loop.  You would have noticed an open loop even under a light server load.

What is very likely is that your ASP code is opening objects, such as a database connection, then not disposing of them properly.  If you have a light server load, those objects will eventually be released, freeing the memory they consumed.  Under a heavy load, the creation of those objects occurs faster than their destruction, resulting in all available memory being consumed which hangs the web application.

You can look through your code for all commands that creat objects...the vast majority will start with "Set".

For each of those, ther needs to be a corresponding "Set object = nothing" towards the end of the code block.  That is what releases the memory consumend by the object.

Regards,
Rod
0
 
rdivilbissCommented:
I need a spell checker...

You can look through your code for all commands that *create* objects...the vast majority will start with "Set".

For each of those, *there* needs to be a corresponding "Set object = nothing" towards the end of the code block.  That is what releases the memory consumend by the object.
0
 
kristinahbmAuthor Commented:
Is this what you are talking about?

' This is our categories table.
            Set rsCategories = Server.CreateObject( "ADODB.RecordSet" )

            ' this is so that we can use the RecordSet.Sort method
            rsCategories.CursorLocation = adUseClient
            
            rsCategories.Open "category", connMyDb, adOpenStatic , adLockOptimistic, adCmdTable  
            ' this is supposed to make things quicker on the table.
            rsCategories("title").Properties("Optimize") = True
            rsCategories("id").Properties("Optimize") = True
            
            rsCategories.Sort = "display_order, title"

            Dim searchCategories()      ' THis will hold the dropdown selections
            Dim sideCategories()      ' Categories to show on the sidebar
      '--------------------------------------------------
0
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
kristinahbmAuthor Commented:

Dim strMisingInfoMessage

Dim p_f_name
Dim p_l_name
Dim p_email
Dim p_address1
Dim p_address2
Dim p_city
Dim p_state
Dim p_postal_code
Dim p_phone
Dim p_fax
Dim p_enhanced_email
Dim p_join_vip
Dim p_data

p_f_name = Request( "p_f_name" )
p_l_name = Request( "p_l_name" )
p_email = Request( "p_email" )
p_address1 = Request( "p_address1" )
p_address2 = Request( "p_address2" )
p_city = Request( "p_city" )
p_state = Request( "p_state" )
p_postal_code = Request( "p_postal_code" )
p_phone = Request( "p_phone" )
p_fax = Request( "p_fax" )
If Request( "p_enhanced_email" ) <> "" Then
      p_enhanced_email = Request( "p_enhanced_email" )
Else
      p_enhanced_email = blnDefaultHTMLemail
End if
If Request( "p_join_vip" ) <> "" Then
      p_join_vip = Request( "p_join_vip" )
Else
      p_join_vip = False
End if

Dim strEmailBody

strEmailBody =      Date() & "  " & Time() & vbCrLf & vbCrLf & _
                        "Someone has submited a request for information from the website." &_
                        "  The form contains the following fields:" & vbCrLf & vbCrLf _
                        & p_f_name & " " & p_l_name & vbCrLf _
                        & p_address1 & vbCrLf & p_address2  & vbCrLf _
                        & p_city & "  " & p_state & " " & p_postal_code & vbCrLf _
                        & "Phone: " & p_phone & vbCrLf _
                        & "Fax: " & p_fax & vbCrLf _      
                        & "Email: " & p_email & vbCrLf _
                        & "Use HTML email: " & p_enhanced_email & vbCrLf _
                        & "Join VIP Club: " & p_join_vip & vbCrLf & vbCrLf


Dim strFormData, item
for each item in Request.Form
      If InStr( item, "p_" ) Then
            'strEmailBody = strEmailBody & Request(item) & vbCrLf
      Else
            strFormData = strFormData & item & " = " & Request(item) & "<BR>"
            strEmailBody = strEmailBody & item & " = " & Request(item) & vbCrLf
      End if
Next






'on Error Resume Next
If Request( "p_f_name" ) <> "" And _
      Request( "p_l_name" ) <> "" And _
      Request( "p_email" ) <> "" _
      Or _
      Request( "p_f_name" ) <> "" And _
      Request( "p_l_name" ) <> "" And _
      Request( "p_phone" ) <> "" Then

      Dim rsRequests

      ' Open the table 'category'
      Set rsRequests = Server.CreateObject( "ADODB.RecordSet" )
      rsRequests.Open "request", connMyDb,adOpenDynamic,adLockPessimistic, adCmdTable  

      ' dont know how we want to handle multiple submits with the same email.
      ' we could either update the record, or supply a custom error message.

            rsRequests.AddNew
            rsRequests("f_name") = p_f_name
            rsRequests("l_name") = p_l_name
            rsRequests("email") = p_email
            rsRequests("address1") = p_address1
            rsRequests("address2") = p_address2
            rsRequests("city") = p_city
            rsRequests("state") = p_state
            rsRequests("postal_code") = p_postal_code
            rsRequests("phone") = p_phone
            rsRequests("fax") = p_fax
            rsRequests("enhanced_email") = p_enhanced_email
            rsRequests("join_vip") = CBool(p_join_vip)
            rsRequests("data") =  strFormData
            rsRequests.Update


      rsRequests.Close
      Set rsRequests = Nothing

      connMyDb.Close
      Set connMyDb = Nothing

      If Err.number = 0 Then
            ' its all good
            strEmailBody = strEmailBody & vbCrLf & vbCrLf & "This information has been entered into the database."
            If blnSendEmail And strRequestEmailTo <> "" Then
                  Dim blnResults
                  blnResults = sendEmail( "webmaster@h-b-m.com", strRequestEmailTo, "A Request for Information has been made.", strEmailBody )
            End If
            'Response.Write( "You request has been saved." )
            Response.Redirect( "./thankyou.asp" )
            
      Else
            ' bad stuff happened
            ' Debug
            Response.Write( "<p/>There has been an error processing your request."  )
            'Response.Redirect( "./" )

      End if

Else
      If Request.ServerVariables("REQUEST_METHOD") = "POST" Then
            strMisingInfoMessage = "Please supply a First and Last name and an email address <B><U>or</U></B> phone number.  Then confirm your information below and click submit.  Thank you."
      End If
End If ' End of check for response.form
on Error Goto 0

Sub printMessage( strMessage )
      If Not IsEmpty( strMessage ) Then
            Response.Write "&nbsp;<BR><FONT COLOR=RED>" & strMessage & "</FONT><BR>"
      End If


(sorry- did not get it all on the first try)
0
 
rdivilbissCommented:
Where is connMyDb created?

And you are missing an End Sub at the end of your post, I'll hope that is due to cut and paste.

0
 
kristinahbmAuthor Commented:
<%@ language=vbScript %>
<!-- #include file="include.asp" -->
<%

'----------------------------
' Database Setup Stuff
'----------------------------
      '--------------------------------------------------
            'This is our GLOBAL db Connection.

            On Error Resume Next
            ' Open the connection object to the DB
            Set connMyDb = Server.CreateObject( "ADODB.connection" )
            connMyDb.Open strDbCon

            If Not Err.number = 0 Then
                  Err.Clear
                  connMyDb.Open strDbConDefault
                  If Not Err.number = 0 Then
                        Dim strMessage
                        strMessage = "The database connection string that is Set for this " &_
                                          "site has failed to connect to the database."
                        Response.Redirect "/error.asp?msg=" & Server.URLEncode( strMessage )
                        Response.End
End If
                  End If

            On Error GoTo 0

      '--------------------------------------------------

      Dim strPageTop, strPageBottom



      '--------------------------------------------------
            ' This is our categories table.
            Set rsCategories = Server.CreateObject( "ADODB.RecordSet" )

            ' this is so that we can use the RecordSet.Sort method
            rsCategories.CursorLocation = adUseClient
            
            rsCategories.Open "category", connMyDb, adOpenStatic , adLockOptimistic, adCmdTable  
            ' this is supposed to make things quicker on the table.
            rsCategories("title").Properties("Optimize") = True
            rsCategories("id").Properties("Optimize") = True
            
            rsCategories.Sort = "display_order, title"

            Dim searchCategories()      ' THis will hold the dropdown selections
            Dim sideCategories()      ' Categories to show on the sidebar
      '--------------------------------------------------

'----------------------------
' Database Setup Stuff - End
'----------------------------

Sub printSearchOptionsSelect()
      Response.Write( "<select size=" & chr(34) & "1" & chr(34) & " NAME=" & chr(34) & "p_search_category" & chr(34) & ">" & vbCrLf )
      Response.Write( "<option>All Categories&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;</option>" & vbCrLf )
      rsCategories.Filter = "search = true "
      While Not rsCategories.EOF
            ' May want to put some code here that checks the length of the string
            ' that is being entered so that it dosent run off the end
            ' max size is 16
            Response.Write "<OPTION VALUE=" & Chr(34) & rsCategories.Fields("id") & Chr(34)
            If IsNumeric(Request( "p_search_category" ) ) Then
                  If CInt( rsCategories.Fields("id") ) = CInt( Request( "p_search_category" ) ) Then
                        Response.Write " SELECTED"
                  End If
            End If
            Response.Write ">" & fun_truncString( rsCategories.Fields("title"), 20 ) &_
                         "</OPTION>" & vbCrLf
            rsCategories.MoveNext
      WEnd
      Response.Write( "</select>" )
End Sub

Sub printSidebarCategories()
      rsCategories.Filter = "category_id = 1"
      Response.Write( "&nbsp;<BR>" )
      While Not rsCategories.EOF
            ' May want to put some code here that checks the length of the string
            ' that is being entered so that it dosent run off the end
            ' max size is 16
            %><A CLASS=navSideCategory HREF="products.asp?intCatId=<%= rsCategories.Fields("id")
                        %>"><%= fun_truncString( rsCategories.Fields("title"), 18 ) %></A><P>
            <%
            rsCategories.MoveNext
      WEnd
End Sub


Public Sub printTop()
      Call parseTemplate("TOP")
End Sub

Public Sub closeDb()
      ' Clean up
      rsCategories.Close
      Set rsCategories = Nothing

      connMyDb.Close
      Set connMyDb = Nothing
End Sub

Public Sub printBottom()
      Call closeDb
      Call parseTemplate("BOTTOM")
      Response.Write "<TABLE WIDTH=100% BORDER=0>" & vbCrLf
      Response.Write "      <TR>" & vbCrLf
      Response.Write "            <TD ALIGN=CENTER CLASS=copyright>" & strCopyright & "</TD>" & vbCrLf
      Response.Write "      </TR>" & vbCrLf
      Response.Write "      </TABLE>" & vbCrLf
End Sub


' This will parse either the TOP or BOTTOM sections of the template file
Public Sub parseTemplate( strSection )
      
      Dim objFSO, objInFile      'object variables for file access
      Dim strIn                        'string variables for reading and color processing
      Dim strASPFileName    'string containing filename of ASP file to view
      Dim ProcessString     'flag determining whether or not to output each line
      Dim location, blnPrintLine
      ' We don't start showing code till we find the start script comment
      ProcessString = 0

      ' Get file name
      strASPFileName = "template.htm"

      Set objFSO = CreateObject("Scripting.FileSystemObject")
      
      If objFSO.FileExists(Request.ServerVariables("APPL_PHYSICAL_PATH") & strASPFileName) Then
            Set objInFile = objFSO.OpenTextFile(Request.ServerVariables("APPL_PHYSICAL_PATH") & strASPFileName)

            ' Loop Through Real File and Output Results to Browser
            Do While Not objInFile.AtEndOfStream
                  strIn = objInFile.ReadLine
                  ' Check for start script comment
                  If InStr(1, strIn, "<!-- START " & strSection & " -->", 1) Then
                        ProcessString = 1
                        strIn = objInFile.ReadLine
                  End If
                  ' Check for end script comment
                  If InStr(1, strIn, "<!-- END " & strSection & " -->", 1) Then ProcessString = 0
                  ' If we're on a line to be processed then do so
                  If ProcessString = 1 Then
                        blnPrintLine = True
                        location = InStr( 1, strIn, "%%CATEGORIES%%", 1 )
                        If location Then
                              Response.Write left(strIn, location - 1 )
                              printSidebarCategories()
                              Response.Write right( strIn, Len(strIn) - location - Len("%%CATEGORIES%%") +1 ) & vbCrLf
                              blnPrintLine = False
                        End If
                        
                        location = InStr( 1, strIn, "%%SEARCH OPTIONS%%", 1 )
                        If location Then
                              Response.Write left(strIn, location - 1 )
                              printSearchOptionsSelect()
                              Response.Write right( strIn, Len(strIn) - location - Len("%%SEARCH OPTIONS%%") +1 ) & vbCrLf
                              blnPrintLine = False
                        End If
                  
                        If blnPrintLine Then
                              ' Output out processed line
                              Response.Write strIn & vbCRLF
                        End If

                  End If
            Loop
      
            ' Close file and free variables
            objInFile.Close
            Set objInFile = Nothing
      End If

      Set objFSO = Nothing
      
End Sub
0
 
kristinahbmAuthor Commented:


'
' No connecting to the database in here.  You should be able to include this file
' in pages which dont need a connection..

' GLOBAL VARIABLES
      Dim strDbConDefault
      strDbConDefault = "DSN=A9180_hbmdb"

      Dim str_ASP_SELF 'This holds the main/first script name that is running - good for FORM ACTION

      Dim blnDefaultHTMLemail
      blnDefaultHTMLemail = True ' True

      Dim strProductImagesDir, strCategoryImagesDir, strProductImagesURL, strCategoryImagesURL
      strProductImagesDir = "data"
      strCategoryImagesDir = "data"
      
      ' Use the following if direct access IS available to the image directory
      'strProductImagesURL = "data/"
      'strCategoryImagesURL = "data/"

      ' Use the following if direct access IS NOT available to the image directory
      strProductImagesURL = "image.asp?image="
      strCategoryImagesURL = "image.asp?image="

      Dim strDeletePrefix
      strDeletePrefix = "0000delme"

      Dim strCSVFileName
      strCSVFileName = "requests.csv"

      Dim connMyDb
      Dim rsCategories

      Dim intFailedAttempts
      intFailedAttempts = 3

      ' This is for the onscreen dumps of emails, in order to
      ' cut and paste into a mail client.
      Dim strEmailDelimiter
      strEmailDelimiter = ";"

Dim objSitePrefs
Set objSitePrefs = Server.CreateObject("Scripting.Dictionary")


Dim strThisDir, strPrefFile
'strThisDir = Request.ServerVariables("PATH_TRANSLATED")
'Response.Write strThisDir
'strPrefFile = left( strThisDir, ( Instr( cstr(strLocalDir), "admin" ) - 1 ) ) & strProductImagesDir
'strPrefFile = "c:\inetpub\wwwroot\hbm2\a\admin\prefs.asp"
strPrefFile = "data\prefs.asp"
      
'--------------------------------------------------
' Misc CODE below this point
'--------------------------------------------------
Const ForReading = 1, ForWriting = 2, ForAppending = 8

'------------------------------------------------------------------------------
' For each GLOBAL property enter the stuff below...
'------------------------------------------------------------------------------
' Now lets calli it
Call LoadSitePrefs

' This is the maximum size that the meta tags will be
Dim intMaxMETA
If objSitePrefs.Item("'p_intMaxMETA") <> "" AND IsNumeric(objSitePrefs.Item("'p_intMaxMETA")) Then
      intMaxMETA = objSitePrefs.Item("'p_intMaxMETA")
Else
      intMaxMETA = 1000
End If

' this is the divider for the text based navigation
Dim strNavDivider
If objSitePrefs.Item("'p_strNavDivider") <> "" Then
      strNavDivider = objSitePrefs.Item("'p_strNavDivider")
Else
      strNavDivider = " : "
End If

' Product Image size
Dim strProdImageSize, intProdImageSize
If objSitePrefs.Item("'p_intProdImageSize") <> "" _
 And IsNumeric(objSitePrefs.Item("'p_intProdImageSize")) Then
      If objSitePrefs.Item("'p_intProdImageSize") < 1 Then
            strProdImageSize = ""
      Else
            intProdImageSize = objSitePrefs.Item("'p_intProdImageSize")
            strProdImageSize = " HEIGHT=" & chr(34) & intProdImageSize & chr(34)
      End If
Else
      intProdImageSize = 70
      strProdImageSize = " HEIGHT=" & chr(34) & intProdImageSize & chr(34)
End If

' Database String
Dim strDbCon
If objSitePrefs.Item("'p_strDbCon") <> "" Then
      strDbCon = objSitePrefs.Item("'p_strDbCon")
Else
      '"DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=db\hbmdb.mdb"
      strDbCon = strDbConDefault
End If

Dim strAdminUsername
If objSitePrefs.Item("'p_strAdminUsername") <> "" Then
      strAdminUsername = objSitePrefs.Item("'p_strAdminUsername")
Else
      strAdminUsername = "hbmadmin"
End If

Dim strAdminPassword
If objSitePrefs.Item("'p_strAdminPassword") <> "" Then
      strAdminPassword = objSitePrefs.Item("'p_strAdminPassword")
Else
      strAdminPassword = "hbm&admin!"
End If

Dim intCategoryCols
If objSitePrefs.Item("'p_intCategoryCols") <> "" Then
      intCategoryCols = CInt( objSitePrefs.Item("'p_intCategoryCols") )
Else
      intCategoryCols = 2
End If

Dim intProductCol
If objSitePrefs.Item("'p_intProductCol") <> "" Then
      intProductCol = CInt( objSitePrefs.Item("'p_intProductCol") )
Else
      intProductCol = 2
End If

Dim intShowSpecialsIndex
If objSitePrefs.Item("'p_intShowSpecialsIndex") <> "" Then
      intShowSpecialsIndex = CInt( objSitePrefs.Item("'p_intShowSpecialsIndex") )
Else
      intShowSpecialsIndex = 5
End If

' Product Image size
Dim strIndexSpecialImageSize, intIndexSpecialImageSize
If objSitePrefs.Item("'p_intIndexSpecialImageSize") <> "" _
 And IsNumeric(objSitePrefs.Item("'p_intIndexSpecialImageSize")) Then
      If objSitePrefs.Item("'p_intIndexSpecialImageSize") < 1 Then
            strIndexSpecialImageSize = ""
      Else
            intIndexSpecialImageSize = objSitePrefs.Item("'p_intIndexSpecialImageSize")
            strIndexSpecialImageSize = " HEIGHT=" & chr(34) & intIndexSpecialImageSize & chr(34)
      End If
Else
      intIndexSpecialImageSize = 120
      strIndexSpecialImageSize = " HEIGHT=" & chr(34) & intIndexSpecialImageSize & chr(34)
End If

Dim intProductsPerPage
If objSitePrefs.Item("'p_intProductsPerPage") <> "" Then
      intProductsPerPage = CInt( objSitePrefs.Item("'p_intProductsPerPage") )
Else
      intProductsPerPage = 10
End If

Dim blnSendEmail
If objSitePrefs.Item("'p_blnSendEmail") <> "" Then
      blnSendEmail = CBool( objSitePrefs.Item("'p_blnSendEmail") )
Else
      blnSendEmail = True
End If

Dim strRequestEmailTo
If objSitePrefs.Item("'p_strRequestEmailTo") <> "" Then
      strRequestEmailTo = objSitePrefs.Item("'p_strRequestEmailTo")
Else
      ' Remember to remove this email!!!!
      strRequestEmailTo = "catalogue@h-b-m.com"
End If

Dim strCopyright
If objSitePrefs.Item("'p_strCopyright") <> "" Then
      strCopyright = objSitePrefs.Item("'p_strCopyright")
Else
      strCopyright = "&copy; Copyright 2002 Hardware Bath and More"
End If

Dim strPopupHeight
If objSitePrefs.Item("'p_strPopupHeight") <> "" Then
      strPopupHeight = objSitePrefs.Item("'p_strPopupHeight")
Else
      strPopupHeight = "500"
End If

Dim strPopupWidth
If objSitePrefs.Item("'p_strPopupWidth") <> "" Then
      strPopupWidth = objSitePrefs.Item("'p_strPopupWidth")
Else
      strPopupWidth = "450"
End If

Dim intShowNewsChars
If objSitePrefs.Item("'p_intShowNewsChars") <> "" Then
      intShowNewsChars = objSitePrefs.Item("'p_intShowNewsChars")
Else
      intShowNewsChars = "140"
End If

'------------------------------------------------------------------------------
Set objSitePrefs = Nothing




' this is a variable that carries the name of the file/script that is running
Dim objFileSystem
Set objFileSystem = Server.CreateObject( "Scripting.FileSystemObject" )
'Request.ServerVariables("URL")
'Request.ServerVariables("SCRIPT_NAME")
'Request.ServerVariables("PATH_INFO")
str_ASP_SELF = objFileSystem.GetFileName(Request.ServerVariables("PATH_INFO"))
Set objFileSystem = Nothing


'--------------------------------------------------




' This Sub should make local scope variables
Sub LoadSitePrefs()

      Dim objFSOx, objTextFilex
      Set objFSOx = Server.CreateObject("Scripting.FileSystemObject")
      
      If objFSOx.FileExists( Request.ServerVariables("APPL_PHYSICAL_PATH") & strPrefFile ) Then
            Set objTextFilex = objFSOx.OpenTextFile( Request.ServerVariables("APPL_PHYSICAL_PATH") & strPrefFile, ForReading )

            ' Load our Dictionary object up with all the elements of the text file.
            Do While Not objTextFilex.AtEndOfStream
                  Dim strCurLinex, strPartx
                  strCurLinex = objTextFilex.ReadLine
                  strPartx = split( strCurLinex, "=" , 2 )
                  If ubound( strPartx ) = 1 Then
                        objSitePrefs.Add Trim(strPartx(0)), strPartx(1)
                  End If
            Loop

            objTextFilex.Close

            Set objTextFilex = Nothing

      End If

      Set objFSOx = Nothing

End Sub ' End of local scope vars



'--------------------------------------------------
      ' this Function will truncate a string to a specified length
      ' and Then add the elipses (sp)
      Function fun_truncString( byval strString , intMaxLen )
            If len( strString ) > cint( intMaxLen ) Then
                  strString = Left( strString, ( intMaxLen -3 ) ) & "..."
            End if
            fun_truncString = strString
      End function
 '--------------------------------------------------
      ' this Function will truncate a string to a specified length
      ' and Then add the elipses (sp)
      Function truncStr( byval strString , intMaxLen )
            If len( strString ) > cint( intMaxLen ) Then
                  strString = Left( strString, ( intMaxLen -3 ) ) & "..."
            End if
            truncStr = strString
      End function
'--------------------------------------------------


'--------------------------------------------------
'--------------------------------------------------
      ' This will print a nice looking divider.
      Sub printDivider( strTitle )
            Response.Write( vbCrLf & "<TABLE class=dividerTable BORDER=0 WIDTH=100% >" & vbCrLf )
            Response.Write( "  <TR><TD>" )
            Response.Write( "<FONT CLASS=dividerText color=#FFFFFF><B>" )
            Response.Write( strTitle )
            Response.Write( "</B></FONT></TD>" & vbCrLf  )
            Response.Write( "  </TR>" & vbCrLf  )
            Response.Write( "</TABLE>" & vbCrLf  )
      End sub
'--------------------------------------------------

'--------------------------------------------------
'--------------------------------------------------
      '----------------------------
      ' Navigation - where we are
      '----------------------------
      Function funcWhereWeAre( rsTable, intInCategory, blnProdDetail )
            Dim strNavUrl 'Holder for the URL String.
            Dim intWhere ' Holder for the id of the category we are in.
            intWhere = intInCategory ' Set our holder to where we are.
            Dim x
            x = 0
            While intWhere <> 0
                  'Find our record in the recordSet
                  rsTable.Filter = "id = " & intWhere
                  If Not rsTable.EOF Then   ' make sure that the category exists
                        Dim strHolder
                        'Build our url
                        If x <> 0 or blnProdDetail Then
                              strHolder = "<A CLASS=navBreadCrumbs HREF=" & chr(34) & "products.asp" & "?intCatId="  & _
                                    rsTable.Fields("id") & chr(34) & ">" &_
                                    rsTable.Fields("title") & "</A>"
                        else
                              strHolder = "<FONT CLASS=navLocation>" &_
                                    rsTable.Fields("title") & "</FONT>"
                        End if
                              
                        If x <> 0 Then
                              strHolder = strHolder & "<FONT CLASS=navBreadCrumbs>" & strNavDivider & "</FONT>"
                        End if
                        x = x + 1
                        strNavUrl = strHolder & strNavUrl
                        intWhere = cint( rsTable.Fields( "category_id" ) )
                  End if
            WEnd
            ' Print out our navagation URL
            funcWhereWeAre = strNavUrl
      End function
      '----------------------------
      ' Navigation - End
      '----------------------------
'--------------------------------------------------

'--------------------------------------------------
'--------------------------------------------------
      Function funcBuildINChildren( rsTable, intParentCategory )
            Dim strINCategories
                  
            rsTable.Filter = "id = " & intParentCategory
            strINCategories = intParentCategory & rsTable.Fields("id")
                  
            rsTable.Filter = "category_id = " & intParentCategory
                  
            While Not rsTable.EOF
                  rsTable.Filter = "id = " & intParentCategory
                  strINCategories = strINCategories  & " " & rsTable.Fields("id")
                  ' reitterate
                  rsTable.moveNext
            WEnd

            ' Print out our navagation URL
            funcWhereWeAre = strNavUrl
      End function
'--------------------------------------------------


'--------------------------------------------------
' This Function will save a file to the system...
'--------------------------------------------------
      Function uploadFile( strFilePrefix, strExistingImage, strSaveDir, objPostData )
            ' Check If 'delete is checked' or 'New file uploaded'
            Dim objNewFile
            Set objNewFile = Server.CreateObject("Scripting.FileSystemObject")

            uploadFile = "Nothing" 'Default response

            Dim strDeleteFilename
            strDeleteFilename = strDeletePrefix & getDateTimeStamp()
            Randomize
            ' FormatNumber( Rnd, 3, False )

            ' Check for 'new file upload'      
            If TypeName(objPostData.Files.Item(strFilePrefix & "_upload" )) = "UploadedFile" Then
                  Dim objUploadedFile
                  Set objUploadedFile = objPostData.Files.Item(strFilePrefix & "_upload" )
                  ' If a file exists, and we are Not just replacing the same file with a new one Then...
                  If objNewFile.fileExists(strSaveDir & objUploadedFile.FileName ) And _
                   objUploadedFile.FileName <> strExistingImage Then
                        ' We have a duplicate file here...
                        uploadFile = "File Exists"
                  Else
                        ' Clear out the old file If one existed
                        If objNewFile.fileExists( strSaveDir & "\" & objPostData.Form(strFilePrefix) ) Then
                              'objNewFile.DeleteFile( strSaveDir & "\" & objPostData.Form(strFilePrefix) )
                              objNewFile.MoveFile strSaveDir & "\" & objPostData.Form(strFilePrefix), strSaveDir & "\" & strDeleteFilename & FormatNumber( Rnd, 3, False )
                        End If
                        ' File is unique Lets upload it
                        objUploadedFile.SaveToDisk strSaveDir
                        ' Set the new name of the uploaded file
                        uploadFile = objUploadedFile.FileName
                  End If
                  Set objUploadedFile = Nothing
            ' We didnt upload a file so lets check If we need to delete an image.
            ElseIf objPostData.Form(strFilePrefix & "_remove") = "remove" Then
                  If objNewFile.fileExists(strSaveDir & objPostData.Form(strFilePrefix) ) Then
                        'objNewFile.DeleteFile( strSaveDir & objPostData.Form(strFilePrefix) )
                        objNewFile.MoveFile strSaveDir & "\" & objPostData.Form(strFilePrefix), strSaveDir & "\" & strDeleteFilename & FormatNumber( Rnd, 3, False )
                  End If
                  uploadFile = ""
            End If
            Set objNewFile = Nothing
      End Function
'--------------------------------------------------

'--------------------------------------------------
' This Function will save a file to the DATABASE...
'--------------------------------------------------
      Function uploadFile2db( strFilePrefix, strExistingImage, byref objRSimageTable, objPostData )

            uploadFile2db = "Nothing" 'Default response

            Dim strDeleteFilename
            strDeleteFilename = strDeletePrefix & getDateTimeStamp()
            Randomize
            ' FormatNumber( Rnd, 3, False )
      
            ' Check for 'new file upload'      
            If TypeName(objPostData.Files.Item(strFilePrefix & "_upload" )) = "UploadedFile" And _
             objPostData.Files.Item(strFilePrefix & "_upload" ).FileName <> "" Then
                  Dim objUploadedFile
                  Set objUploadedFile = objPostData.Files.Item(strFilePrefix & "_upload" )

                  Dim blnImageExists
                  blnImageExists = False
                  If objRSimage.EOF And Not objRSimage.BOF Then
                        objRSimageTable.MoveFirst
                  End If
                  If objUploadedFile.FileName <> "" Then
                        objRSimageTable.Find "filename='" & objUploadedFile.FileName & "'"
                        If Not objRSimageTable.EOF Then
                              blnImageExists = True
                        End If
                  End If
                  
                  ' If a file exists, and we are Not just replacing the same file with a new one Then...
                  If blnImageExists And _
                   objUploadedFile.FileName <> strExistingImage Then
                        ' We have a duplicate file here...
                        uploadFile2db = "File Exists"
                  Else
                        ' Clear out the old file If one existed
                        If objRSimage.EOF And Not objRSimage.BOF Then
                              objRSimageTable.MoveFirst
                        End If
                        objRSimageTable.Find "filename='" & objPostData.Form(strFilePrefix) & "'"
                        If Not objRSimageTable.EOF Then
                              objRSimageTable.Delete
                              objRSimageTable.Update
                        End If
                        
                        ' File is unique Lets upload it
                        ' objUploadedFile.SaveToDisk strSaveDir
                        ' Set the new name of the uploaded file

                        objRSimageTable.AddNew ' create a new record
                  
                        objRSimageTable("filename")    = objUploadedFile.FileName
                        objRSimageTable("filesize")        = objUploadedFile.FileSize
                        objRSimageTable("contenttype") = objUploadedFile.ContentType
            
                        ' Save the file to the database
                        objUploadedFile.SaveToDatabase objRSimageTable("filedata")
                  
                        ' Commit the changes and close
                        objRSimageTable.Update
                        
                        uploadFile2db = objUploadedFile.FileName
                        
                        
                  End If
                  Set objUploadedFile = Nothing
            ' We didnt upload a file so lets check If we need to delete an image.
            ElseIf objPostData.Form(strFilePrefix & "_remove") = "remove" Then
                  If objRSimage.EOF And Not objRSimage.BOF Then
                        objRSimageTable.MoveFirst
                  End If
                  objRSimageTable.Find "filename='" & objPostData.Form(strFilePrefix) & "'"
                  If Not objRSimageTable.EOF Then
                        objRSimageTable.Delete
                        objRSimageTable.Update
                  End If
                  uploadFile2db = ""
            End If
      End Function
'--------------------------------------------------

'-----------------------------------------------------------------------------
'Purpose            What the procedure does (Not how).
'Assumptions      List of any external variable, control, or other element whose
'                        state affects this procedure.
'Effects            List of the procedure's effect on each external variable,
'                        control, or other element.
'Inputs                  Explanation of each argument that is Not obvious. Each argument
'                        should be on a separate line with inline comments.
'Return Values      Explanation of the value returned.
'-----------------------------------------------------------------------------


'-----------------------------------------------------------
' This Function will load up a global variable array with
' all the id's of the categories in an expanded tree
' order.
'-----------------------------------------------------------
      Sub GetChildren( objResultSet, ByRef resultArray, intParent, intIndex, intLevel )
            objResultSet.Filter = 0
            objResultSet.Sort = "display_order, title"
            objResultSet.Filter = "category_id = " & intParent
            If Not objResultSet.EOF Then
                  objResultSet.MoveFirst
                  While Not objResultSet.EOF
                        resultArray(intIndex,0) = objResultSet.Fields("id")
                        resultArray(intIndex,1) = intLevel
                        intIndex = intIndex + 1
                        Dim objCloneRS
                        Set objCloneRS = objResultSet.Clone
                        Call GetChildren( objCloneRS, resultArray, objResultSet.Fields("id"), intIndex, intLevel + 1 )
                        objCloneRS.Close
                        Set objCloneRS = Nothing
                        objResultSet.MoveNext
                  WEnd
            End If
      End Sub
'-----------------------------------------------------------


Sub checkAuthentication()
      If IsEmpty(Application(Session.SessionID)) Then
            Response.Redirect( "login.asp?page=" & Server.URLEncode(str_ASP_SELF) )
            Response.End
      End If
End Sub

public Sub printAdminTop()
      ' eventually i would like to combine page_top.asp and page_bot.asp and Then
      ' have the code parse out the data.  That would make editing
      ' the page_ files easier, because things like front page wouldn't
      ' insist on closing the tables when you edit them...
      %><!-- #include file="admin/admin_page_top.asp" --><%
End sub

public Sub printAdminBottom()
      ' Clean up
      If Not IsEmpty(rsCategories) Then
            rsCategories.Close
            Set rsCategories = Nothing
      End If

      If Not IsEmpty(connMyDb) Then
            connMyDb.Close
            Set connMyDb = Nothing
      End If

      %><!-- #include file="admin/admin_page_bot.asp" --><%
End sub




'------------------------------------------------------------
Function sendEmail( strFrom, strTo, strSubject, strMessage )
      If Len(strTo) > 0 Then
            Dim objMailer
            Set objMailer = CreateObject("Dundas.Mailer")
            objMailer.TOs.Add strTo
            objMailer.FromAddress      = strFrom
            objMailer.Subject      = strSubject
            objMailer.Body      = strMessage
                  objMailer.SMTPRelayServers.Add "mail.h-b-m.com", 25, "h-b-m.com"
            If Not objMailer.Sendmail() Then
                  sendEmail = True
            else
                  sendEmail = False
            End if
            Set objMailer = Nothing
End If
      End Function
'------------------------------------------------------------

Function getDateTimeStamp()
      ' This function returns a date time stamp

      Dim lngDateStamp, datNow

      datNow = Now
      lngDateStamp = Year( datNow )
      If Month( datNow ) < 10 Then
            lngDateStamp = lngDateStamp & "0" & Month( datNow )
      Else
            lngDateStamp = lngDateStamp & Month( datNow )
      End If
      If Day( datNow ) < 10 Then
            lngDateStamp = lngDateStamp & "0" & Day( datNow )
      Else
            lngDateStamp = lngDateStamp & Day( datNow )
      End If
      If Hour( datNow ) < 10 Then
            lngDateStamp = lngDateStamp & "0" & Hour( datNow )
      Else
            lngDateStamp = lngDateStamp & Hour( datNow )
      End If
      If Minute( datNow ) < 10 Then
            lngDateStamp = lngDateStamp & "0" & Minute( datNow )
      Else
            lngDateStamp = lngDateStamp & Minute( datNow )
      End If
      If Second( datNow ) < 10 Then
            lngDateStamp = lngDateStamp & "0" & Second( datNow )
      Else
            lngDateStamp = lngDateStamp & Second( datNow )
      End If
      
      getDateTimeStamp = lngDateStamp

End Function
0
 
kristinahbmAuthor Commented:
I think this is the last one?
Call checkAuthentication()
Response.Buffer = True
Call printAdminTop()

Dim objDicPrefs
Set objDicPrefs = Server.CreateObject("Scripting.Dictionary")


Dim objFSO, objTextFile
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")

Dim strSaveDirX, strLocalDirX

strLocalDirX = Request.ServerVariables("PATH_TRANSLATED")
strSaveDirX = left( strLocalDirX, ( Instr( cstr(strLocalDirX), "admin" ) - 1 ) ) & strPrefFile

'Response.write strSaveDirX
'------------------------------------------------------------------------------
' Save the new preferences file...
'------------------------------------------------------------------------------
If Request("action") = "save" Then
      Set objTextFile = objFSO.CreateTextFile(strSaveDirX, True)
      objTextFile.WriteLine( "<" & chr(37))
      Dim item
      for each item in Request.Form
            if InStr( item, "p_" ) And Request.Form(item) <> "" then
                  objTextFile.WriteLine( chr(39) & item & "=" & Replace( Request.Form(item), vbCrLf, "<BR>" ) ) ' chr(39) = '
            end if
      next
      objTextFile.WriteLine( chr(37) & ">") ' chr(37) = %

      objTextFile.Close
      Set objTextFile = Nothing

      Response.Redirect( str_ASP_SELF )
End If
'------------------------------------------------------------------------------

If objFSO.FileExists(strSaveDirX) Then

      Set objTextFile = objFSO.OpenTextFile( strSaveDirX,ForReading )

      ' Load our Dictionary object up with all the elements of the text file.
      Do While Not objTextFile.AtEndOfStream
            Dim strCurLine, strPart
            strCurLine = objTextFile.ReadLine
            strPart = split( strCurLine, "=" , 2 )
            If ubound( strPart ) = 1 Then
                  objDicPrefs.Add Trim(strPart(0)), strPart(1)
            End If
      Loop

      objTextFile.Close
      Set objTextFile = Nothing

End If

Set objFSO = Nothing



'------------------------------------------------------------------------------
' For all properties enter the stuff below...
'------------------------------------------------------------------------------

Dim p_intMaxMETA, p_strNavDivider, p_intProdImageSize, p_strDbCon
Dim p_strAdminUsername, p_strAdminPassword, p_intCategoryCols


If objDicPrefs.Item("'p_intMaxMETA") <> "" Then
      p_intMaxMETA = objDicPrefs.Item("'p_intMaxMETA")
Else
      p_intMaxMETA = intMaxMETA
End If

If objDicPrefs.Item("'p_strNavDivider") <> "" Then
      p_strNavDivider = objDicPrefs.Item("'p_strNavDivider")
Else
      p_strNavDivider = strNavDivider
End If

If objDicPrefs.Item("'p_intProdImageSize") <> "" Then
      p_intProdImageSize = objDicPrefs.Item("'p_intProdImageSize")
Else
      p_intProdImageSize = intProdImageSize
End If

If objDicPrefs.Item("'p_strDbCon") <> "" Then
      p_strDbCon = objDicPrefs.Item("'p_strDbCon")
Else
      p_strDbCon = strDbCon
End If

If objDicPrefs.Item("'p_strDbCon") <> "" Then
      p_strDbCon = objDicPrefs.Item("'p_strDbCon")
Else
      p_strDbCon = strDbCon
End If

If objDicPrefs.Item("'p_strAdminUsername") <> "" Then
      p_strAdminUsername = objDicPrefs.Item("'p_strAdminUsername")
Else
      p_strAdminUsername = strAdminUsername
End If

If objDicPrefs.Item("'p_strAdminPassword") <> "" Then
      p_strAdminPassword = objDicPrefs.Item("'p_strAdminPassword")
Else
      p_strAdminPassword = strAdminPassword
End If

If objDicPrefs.Item("'p_intCategoryCols") <> "" Then
      p_intCategoryCols = objDicPrefs.Item("'p_intCategoryCols")
Else
      p_intCategoryCols = intCategoryCols
End If

Dim p_intProductCol
If objDicPrefs.Item("'p_intProductCol") <> "" Then
      p_intProductCol = objDicPrefs.Item("'p_intProductCol")
Else
      p_intProductCol = intProductCol
End If

Dim p_intShowSpecialsIndex
If objDicPrefs.Item("'p_intShowSpecialsIndex") <> "" Then
      p_intShowSpecialsIndex = objDicPrefs.Item("'p_intShowSpecialsIndex")
Else
      p_intShowSpecialsIndex = intShowSpecialsIndex
End If

Dim p_intIndexSpecialImageSize
If objDicPrefs.Item("'p_intIndexSpecialImageSize") <> "" Then
      p_intIndexSpecialImageSize = objDicPrefs.Item("'p_intIndexSpecialImageSize")
Else
      p_intIndexSpecialImageSize = intIndexSpecialImageSize
End If

Dim p_intProductsPerPage
If objDicPrefs.Item("'p_intProductsPerPage") <> "" Then
      p_intProductsPerPage = objDicPrefs.Item("'p_intProductsPerPage")
Else
      p_intProductsPerPage = intProductsPerPage
End If

Dim p_blnSendEmail
If objDicPrefs.Item("'p_blnSendEmail") <> "" Then
      p_blnSendEmail = CBool( objDicPrefs.Item("'p_blnSendEmail") )
Else
      p_blnSendEmail = CBool( blnSendEmail )
End If

Dim p_strRequestEmailTo
If objDicPrefs.Item("'p_strRequestEmailTo") <> "" Then
      p_strRequestEmailTo = objDicPrefs.Item("'p_strRequestEmailTo")
Else
      p_strRequestEmailTo = strRequestEmailTo
End If

Dim p_strCopyright
If objDicPrefs.Item("'p_strCopyright") <> "" Then
      p_strCopyright = objDicPrefs.Item("'p_strCopyright")
Else
      p_strCopyright = strCopyright
End If

Dim p_strPopupHeight
If objDicPrefs.Item("'p_strPopupHeight") <> "" Then
      p_strPopupHeight = objDicPrefs.Item("'p_strPopupHeight")
Else
      p_strPopupHeight = strPopupHeight
End If

Dim p_strPopupWidth
If objDicPrefs.Item("'p_strPopupWidth") <> "" Then
      p_strPopupWidth = objDicPrefs.Item("'p_strPopupWidth")
Else
      p_strPopupWidth = strPopupWidth
End If

Dim p_intShowNewsChars
If objDicPrefs.Item("'p_intShowNewsChars") <> "" Then
      p_intShowNewsChars = objDicPrefs.Item("'p_intShowNewsChars")
Else
      p_intShowNewsChars = intShowNewsChars
End If

'------------------------------------------------------------------------------
Set objDicPrefs = Nothing



%>

<table WIDTH="100%" ALIGN=left>
  <TR>
    <TD>
        <FONT size="+3" color="#000080"><b>Site Properties</b></FONT></TD>
  </TR>
  <TR>
    <TD>
        <FONT COLOR="RED"><B>Caution:</B></FONT>Changing these settings will affect the entire site.</TD>
  </TR>
</table>


<p>
<br clear="all">
<hr>
<p>

<SCRIPT Language="JavaScript" Type="text/javascript"><!--
function Form1_Validator(theForm)
{

  var checkOK = "0123456789";
  var checkStr = theForm.p_intMaxMETA.value;
  var allValid = true;
  var validGroups = true;
  var decPoints = 0;
  var allNum = "";
  for (i = 0;  i < checkStr.length;  i++)
  {
    ch = checkStr.charAt(i);
    for (j = 0;  j < checkOK.length;  j++)
      if (ch == checkOK.charAt(j))
        break;
    if (j == checkOK.length)
    {
      allValid = false;
      break;
    }
    allNum += ch;
  }
  if (!allValid)
  {
    alert("Please enter only digit characters in the \"Max META\" field.");
    theForm.p_intMaxMETA.focus();
    return (false);
  }

  var checkOK = "0123456789";
  var checkStr = theForm.p_intProdImageSize.value;
  var allValid = true;
  var validGroups = true;
  var decPoints = 0;
  var allNum = "";
  for (i = 0;  i < checkStr.length;  i++)
  {
    ch = checkStr.charAt(i);
    for (j = 0;  j < checkOK.length;  j++)
      if (ch == checkOK.charAt(j))
        break;
    if (j == checkOK.length)
    {
      allValid = false;
      break;
    }
    allNum += ch;
  }
  if (!allValid)
  {
    alert("Please enter only digit characters in the \"Product Image size\" field.");
    theForm.p_intProdImageSize.focus();
    return (false);
  }
 
  return (true);
}
//--></SCRIPT>

<FORM METHOD="POST" action="admin_site_edit.asp" onsubmit="return Form1_Validator(this)" language="JavaScript">


<!--<FORM METHOD="POST" action="admin_site_edit.asp" >-->

<INPUT TYPE="hidden" NAME="action" VALUE="save">
&nbsp;<INPUT type="submit" NAME="save" value="   Save   "><INPUT type="button" value=" Cancel " onClick="javascript:window.location.href='./'"><BR>&nbsp;

<table BORDER="1" CELLPADDING="5" CELLSPACING="0" style="border-collapse: collapse" bordercolor="#111111">
  <TR>
    <TD COLSPAN="2"><B>Products Page</B></TD>
  </TR>
  <TR>
    <TD ALIGN="right"><span lang="en-us">Show Categories in</span></TD>
    <TD>
    <INPUT type="TEXT" NAME="p_intCategoryCols" size="5" value="<%=p_intCategoryCols%>" maxlength="255"> Columns</TD>
  </TR>
  <TR>
    <TD ALIGN="right"><span lang="en-us">Show Products in</span></TD>
    <TD>
    <INPUT type="TEXT" NAME="p_intProductCol" size="5" value="<%=p_intProductCol%>" maxlength="255"> Columns</TD>
  </TR>  
  <TR>
    <TD ALIGN="right"><span lang="en-us">Max. products to show on a page</span></TD>
    <TD>
    <INPUT type="TEXT" NAME="p_intProductsPerPage" size="5" value="<%=p_intProductsPerPage%>" maxlength="255"></TD>
  </TR>  
  <TR>
    <TD ALIGN="right"><span lang="en-us">Forced Height of Images</span></TD>
    <TD>
    <INPUT type="TEXT" NAME="p_intProdImageSize" size="15" value="<%=Server.HTMLEncode( p_intProdImageSize )%>" maxlength="255"> (0 for noresize)</TD>
  </TR>
  <TR>
    <TD ALIGN="right"><span lang="en-us">Bread Crumb Nav Divider</span></TD>
    <TD>
    <INPUT type="TEXT" NAME="p_strNavDivider" size="25" value="<%=p_strNavDivider%>" maxlength="255"></TD>
  </TR>
  <TR>
    <TD ALIGN="right"><span lang="en-us">Product Detail Popup Window </span></TD>
    <TD>
    <INPUT type="TEXT" NAME="p_strPopupHeight" size="5" value="<%=p_strPopupHeight%>" maxlength="25"> Height</TD>
  </TR>
  <TR>
    <TD ALIGN="right"><span lang="en-us"></span></TD>
    <TD>
    <INPUT type="TEXT" NAME="p_strPopupWidth" size="5" value="<%=p_strPopupWidth%>" maxlength="25"> Width</TD>
  </TR>
  <TR>
    <TD COLSPAN="2"><B>Index/Main Page</B></TD>
  </TR>
  <TR>
    <TD ALIGN="right"><span lang="en-us">News Snippet Length </span></TD>
    <TD>
    <INPUT type="TEXT" NAME="p_intShowNewsChars" size="5" value="<%=p_intShowNewsChars%>" maxlength="255">  characters to show on main page.</TD>
  </TR>
  <TR>
    <TD ALIGN="right"><span lang="en-us">Specials images: Display </span></TD>
    <TD>
    <INPUT type="TEXT" NAME="p_intShowSpecialsIndex" size="5" value="<%=p_intShowSpecialsIndex%>" maxlength="255"> Images on main page.</TD>
  </TR>
  <TR>
    <TD ALIGN="right"><span lang="en-us">Forced Height of Specials Images<BR>on Main (Index) page</span></TD>
    <TD>
    <INPUT type="TEXT" NAME="p_intIndexSpecialImageSize" size="15" value="<%=Server.HTMLEncode( p_intIndexSpecialImageSize )%>" maxlength="255"> (0 for noresize)</TD>
  </TR>
  <TR>
    <TD COLSPAN="2"><B>Request Page</B></TD>
  </TR>
  <TR>
    <TD ALIGN="right"><span lang="en-us">Send emails out when requests come in</span></TD>
    <TD>
    <INPUT type="radio" NAME="p_blnSendEmail" VALUE="True" <%
    If p_blnSendEmail Then
            Response.Write " CHECKED"
      End If
    %>>Yes  <INPUT type="radio" NAME="p_blnSendEmail" VALUE="False" <%
    If Not p_blnSendEmail Then
            Response.Write " CHECKED"
      End If
    %>>No
  </TR>
  <TR>
    <TD ALIGN="right"><span lang="en-us">Who should get request emails</span></TD>
    <TD>
    <INPUT type="TEXT" NAME="p_strRequestEmailTo" size="25" value="<%=p_strRequestEmailTo%>" maxlength="255"></TD>
  </TR>
  <TR>
    <TD COLSPAN="2"><B>General</B></TD>
  </TR>
  <TR>
    <TD ALIGN="right"><span lang="en-us">Max Length of Meta Keywords Tags</span></TD>
    <TD>
    <INPUT type="TEXT" NAME="p_intMaxMETA" size="7" value="<%=p_intMaxMETA%>" maxlength="55"></TD>
  </TR>
  <TR>
    <TD ALIGN="right"><span lang="en-us">Page Footer on all pages</span></TD>
    <TD>
    <INPUT type="TEXT" NAME="p_strCopyright" size="55" value="<%=Server.HTMLEncode( p_strCopyright )%>" maxlength="255"></TD>
  </TR>
  <TR>
    <TD COLSPAN="2"><B>Administration</B></TD>
  </TR>
  <TR>
    <TD ALIGN="right"><span lang="en-us">Database Connection String</span></TD>
    <TD>
    <INPUT type="TEXT" NAME="p_strDbCon" size="25" value="<%=p_strDbCon%>" maxlength="255"></TD>
  </TR>
  <TR>
    <TD ALIGN="right"><span lang="en-us">Username For administration</span></TD>
    <TD>
    <INPUT type="TEXT" NAME="p_strAdminUsername" size="25" value="<%=p_strAdminUsername%>" maxlength="255"></TD>
  </TR>
  <TR>
    <TD ALIGN="right"><span lang="en-us">Password</span></TD>
    <TD>
    <INPUT type="TEXT" NAME="p_strAdminPassword" size="25" value="<%=p_strAdminPassword%>" maxlength="255"></TD>
  </TR>
 </table>
<p>&nbsp;<INPUT type="submit" NAME="save" value="   Save   "><INPUT type="button" value=" Cancel " onClick="javascript:window.location.href='./'"></p>
</FORM>
<!-- #include file="admin_page_bot.asp" -->

</body>

</html>

0
 
rdivilbissCommented:
Several things can affect your performance.

1. Your heavy reliance on the file system object.  This is an expensive object and slow as well.  You definately want to get away from using that to load template pages.  Use server side includes.

2. I question that this routine will always clean up.  I also wonder if that is the best place to include an ASP file.

public Sub printAdminBottom()
     ' Clean up
     If Not IsEmpty(rsCategories) Then
          rsCategories.Close
          Set rsCategories = Nothing
     End If

     If Not IsEmpty(connMyDb) Then
          connMyDb.Close
          Set connMyDb = Nothing
     End If

     %><!-- #include file="admin/admin_page_bot.asp" --><%
End sub

Use:

public Sub printAdminBottom()
     ' Clean up
     on error resume next
     rsCategories.Close
     Set rsCategories = Nothing
     connMyDb.Close
     Set connMyDb = Nothing
End sub

That will always dispose of the objects.

3. Sorting a recordset is another huge resource hog.  Let the database do the work, not the web server.  If you are retrieving records, you should be using a snap shot recordset.  Any use of client side cursors or recordset manipulations is guaranteed to consume a lot of resourses and this could easily cause the problems you describe when the server is under load.

' this is so that we can use the RecordSet.Sort method
          rsCategories.CursorLocation = adUseClient

I can't go through every line of code looking for undisposed objects, and there are probably other optimizations you could perform.  My general impression was that the site was designed for the developer's convenience rather than for robustness and speed.

It appears some sort of poorly designed web site design interface is being used to create or modify pages instead of simply creating the pages in an editor.

If you do not change your database access methods and your heavy handed use of the file system object, you will continue to have an unmanageable site.

Sorry to sound blunt, but I can't thing of a better way to describe this.

Regards,
Rod
0

Featured Post

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

  • 5
  • 4
Tackle projects and never again get stuck behind a technical roadblock.
Join Now