<% case "subpage" %> <%=g_strTitle %>

<% case "store" %> Grinberg.com <% case else %> <%=g_strTitle %>

<% end select end sub sub DrawMenu %> <% end sub sub DrawLeftColumn %>

Gary Grinberg, MD

General, Advanced Laparoscopic and
Bariatric Surgery
800 Howe Ave., Suite 300
Sacramento, CA 95825

office: (916) 568-5564
fax: (916) 568-5575

<% end sub sub DrawHeaderOld(byVal strTitle, strPageType) if not strTitle = "" then g_strTitle = strTitle & " at " & STR_MERCHANT_NAME else g_strTitle = strTitle & " at " & STR_MERCHANT_NAME end if %> <%= g_strTitle %> <% select case strPageType case "store", "cart", "custserv" %> <% end select %>

<% DrawSubMenu strPageType select case strPageType case "default" case "store" DrawCrumbs strPageType case "custserv" %>

Customer Service

<% case "cart" %>

Shopping Cart

<% case "contact" %>

Contact <%= STR_MERCHANT_NAME %>

<% case else end select end sub '--------------------------------------------- ' DrawSubmenu ' Desc: Structure teh left-hand menu ' Inputs: strPageType - Page Display Type '--------------------------------------------- sub DrawSubmenu(strPageType) dim strSQL, rsTemp 'RecordSet 1- Top 6 categories strSQL = "SELECT vchItemName, intID " strSQL = strSQL & "FROM " & STR_TABLE_INVENTORY & " " strSQL = strSQL & "WHERE chrType = 'B' " strSQL = strSQL & "AND chrStatus = 'A' " strSQL = strSQL & "AND chrSpecial = 'Y' " strSQL = strSQL & "ORDER BY vchItemName;" 'RecordSet 2- Top 7 categories strSQL = strSQL & "SELECT vchItemName, intID " strSQL = strSQL & "FROM " & STR_TABLE_INVENTORY & " " strSQL = strSQL & "WHERE chrType = 'A' " strSQL = strSQL & "AND chrStatus = 'A' " strSQL = strSQL & "AND chrSpecial = 'Y' " strSQL = strSQL & "ORDER BY vchItemName;" ' response.write strSQL strSQL = strSQL & "SELECT TOP 7 vchItemName, intID " strSQL = strSQL & "FROM " & STR_TABLE_INVENTORY & " " strSQL = strSQL & "WHERE chrType = 'I' " strSQL = strSQL & "AND chrStatus = 'A' " strSQL = strSQL & "AND mnyWholesale IS NOT NULL " strSQL = strSQL & "ORDER BY vchItemName;" set rsTemp = ConnOpenRS(strSQL) if rsTemp.eof then ' response.write "Error:There are currently no active Folders in the repository

" ' response.end end if if (gintOrderID > 0) or (gintUserID > 0) then DrawCartMenu end if if not rsTemp.eof then DrawSpecials rsTemp, "Gallery Collections", "viewall=galleries" end if set rsTemp = rsTemp.NextRecordSet() if not rsTemp.eof then DrawSpecials rsTemp, "Categories", "viewall=categories" end if set rsTemp = rsTemp.NextRecordSet() if not rsTemp.eof then DrawSpecials rsTemp, "Sales & Clearance", "viewall=clearance" end if DrawBannerAds strPageType %> <% rsTemp.close set rsTemp = nothing end sub '--------------------------------------------- ' DrawCartMenu ' Desc: Draw E-Commerce links in

format '--------------------------------------------- sub DrawCartMenu %>

Shopping Cart

<% if (gintUserID > 0) and (gstrUserStatus = "") then %> Log Out My Account <% else %> Log In <% end if if (gintOrderItemCount > 0) then if (gintOrderItemCount = 1) then %> View Cart (<%= gintOrderItemCount %> item) <% else %> View Cart (<%= gintOrderItemCount %> items) <% end if %> Check Out <% end if %>

<% end sub '--------------------------------------------- ' DrawSpecials ' Desc: Draw Specials submenus ' Input: rsTemp - recordset of relative inventory '--------------------------------------------- sub DrawSpecials(rsTemp, strTitle, strViewAll) %>

<%= strTitle %>

<% while not rsTemp.eof %> "><%= rsTemp("vchItemName") %> <% rsTemp.MoveNext wend %>

› All <%=strTitle%>

<% end sub '--------------------------------------------- ' DrawBannerAds ' Desc: Draw Banners ' Input: strPageType - Page Display Type '--------------------------------------------- sub DrawBannerAds(strPageType) select case strPageType case "default" %>

Web Design by American Web Services
Content Management System by ArrowClick

<% case "store" %>

<% case else %>

<% end select end sub '--------------------------------------------- ' DrawCrumbs ' Desc: Draw Inventory Tree (Bread Crumbs) ' Input: strPageType - Page Display Type '--------------------------------------------- sub DrawCrumbs(strPageType) dim intRequestID, rsTemp, strSQL, strOutput if Request("id").Count <> 0 then intRequestID = Request("id") if IsNumeric(intRequestID) then intRequestID = CLng(intRequestID) else intRequestID = 0 end if else intRequestID = 0 end if strOutput = "" if intRequestID > 0 then strSQL = "SELECT intID, intParentID, vchItemName, chrType FROM " & STR_TABLE_INVENTORY & " WHERE (intID = " & intRequestID & ")" set rsTemp = ConnOpenRS(strSQL) if not rsTemp.eof then select case rsTemp("chrType") case "B" strOutput = "Galleries › " case "A" strOutput = "Categories › " case "I" strOutput = "Categories › " end select end if dim strCrumbs strCrumbs = "" while not rsTemp.eof if rsTemp("chrType") = "I" then strCrumbs = rsTemp("vchItemName") & "› " & strCrumbs else strCrumbs = "" & rsTemp("vchItemName") & " › " & strCrumbs end if strSQL = "SELECT intID, intParentID, vchItemName, chrType FROM " & STR_TABLE_INVENTORY & " WHERE (intID = " & rsTemp("intParentID") & ")" rsTemp.close set rsTemp = ConnOpenRS(strSQL) wend rsTemp.close set rsTemp = nothing end if strOutput = strOutput & strCrumbs if strOutput <> "" then strOutput = left(strOutput, len(strOutput)-7) strOutput = "

" & strOutput & "

" response.write strOutput end if end sub '--------------------------------------------- 'DrawFooter ' Desc: Draws Global Footer ' Input: strPageType - Page Display Type '--------------------------------------------- sub DrawFooter(strPageType) %>

<% end sub '--------------------------------------------- 'DrawFooter ' Desc: Draws Global Footer ' Input: strPageType - Page Display Type '--------------------------------------------- sub DrawFooterOld(strPageType) select case strPageType case "default" case "store" case else end select %>

<% end sub ' END: DRAW METHODS ' ===================================================================================== sub InitDomain() dim rootfolder gstrUser = Request.ServerVariables("REMOTE_USER") gstrUserIP = Request.ServerVariables("REMOTE_ADDR") gblnSecure = (Request.ServerVariables("SERVER_PORT_SECURE") = 1) strServerHost = Request.ServerVariables("HTTP_HOST") strScriptName = Request.ServerVariables("SCRIPT_NAME") if gblnSecure then strScript = "http://" & strServerHost & strScriptName & "?" else strScript = "http://" & strServerHost & strScriptName & "?" end if if gblnSecure then absbase = "http://" else absbase = "http://" end if if lcase(strServerHost) = "awsdev" then ' running from internal rootfolder = "/handwrittencards/www/" absbase = absbase & strServerHost & rootfolder gstrHostBase = "internal" securebase = "http://" & strServerHost & rootfolder nonsecurebase = "http://" & strServerHost & rootfolder homebase = nonsecurebase gstrConnectString = "DSN=webdatasql; UID=webuser; PWD=webdata" elseif InStr(lcase(strServerHost), "awstest") > 0 then ' running from internal sub-domain rootfolder = "/" absbase = absbase & rootfolder nonsecurebase = "http://" & strServerHost & rootfolder securebase = nonsecurebase gstrHostBase = "internal" homebase = absbase gstrConnectString = "DSN=webdatasql; UID=webuser; PWD=webdata" elseif InStr(lcase(strServerHost), "clients") > 0 then ' running from staging rootfolder = "/handwrittencards/www/" absbase = absbase & strServerHost & rootfolder gstrHostBase = "staging" securebase = "http://" & strServerHost & rootfolder nonsecurebase = "http://" & strServerHost & rootfolder homebase = nonsecurebase gstrConnectString = "DSN=stagingsql; UID=webadmin; PWD=gently" else ' running from live site if Request("dbg") = "" then on error resume next end if rootfolder = "/" absbase = absbase & strServerHost & rootfolder gstrHostBase = "live" securebase = "http://www." & STR_SITE_NAME & rootfolder nonsecurebase = "http://" & strServerHost & rootfolder homebase = nonsecurebase gstrConnectString = "DSN=livesql; UID=webuser; PWD=welcome" end if if InStr(lcase(strServerHost), "www.Grinberg.com") = 0 then 'response.Redirect "http://www.Grinberg.com" end if dim tmpPos tmpPos = instr(lcase(strScript),rootfolder) + len(rootfolder) while inStr(tmpPos, lcase(strScript), "/") virtualbase = virtualbase & "../" tmpPos = instr(tmpPos, lcase(strScript), "/") + 1 wend 'Comment out before going live 'tmpPos = instr(lcase(virtualbase),"/") 'virtualbase = right(virtualbase, len(virtualbase )-instr(lcase(virtualbase), "/") ) '----------------------------------- aspbase = virtualbase imagebase = virtualbase & "images/" userfilebase = virtualbase & "DocUserFiles/" stylebase = virtualbase & "_styles/" liveimagebase = virtualbase & "images/products/" photoimagebase = virtualbase & "images/products/big/" thumbimagebase = virtualbase & "images/products/small/" g_imagebase = virtualbase & "_images/" g_urlbase = aspbase end sub function GetSacWebUser(strUser, strPassword, intMinLevel) ' minimum levels: ' 15 = programmer admin ' 25 = system admin (normal) <-- *** ' 35 = guest admin (read-only) ' 45 = guest user (read-only, but not to admin pages) dim objAuth, intResult set objAuth = Server.CreateObject("IIS4Utils.SacWebSecurity") intResult = objAuth.Authenticate(strUser, strPassword) if (intResult > 0) and (intResult <= intMinLevel) then GetSacWebUser = intResult else GetSacWebUser = intResult end if set objAuth = nothing end function function FixFilename(s) dim strFileName strFileName = replace(s & "", " ", "%20") FixFilename = replace(strFileName & "", "+", "%20") end function sub DrawRefererGreeting dim strRefID, strUserName, strDiscount strRefID = Session(STR_SESSION_REFERER_ID) if strRefID <> "0" and strRefID <> "" then strUserName = Session(STR_SESSION_REFERER_NAME) strDiscount = Fix(Session(STR_SESSION_REFERER_DISCOUNT) * 100) response.write fontx(2,1,cBlack) & "Welcome, " & strUserName & " customer.
Your " & strDiscount & "% discount will be applied to your order upon checkout.

" end if end sub sub DrawMenuGroup(rsInput) dim intParentID, strParentName, blnShowChild blnShowChild = true if not rsInput.eof then intParentID = rsInput("intID") strParentName = rsInput("vchItemName") %>

<%= strParentName %>
<% dim rsTemp set rsTemp = Inventory_GetItemsFromFolder(rsInput("intID"), true, false) if not g_blnShowAllChildren then if g_strTitle = strParentName or gintInvParentUpID = intParentID then else blnShowChild = false end if end if if not rsTemp.eof then while not rsTemp.eof intParentID = rsTemp("intID") strParentName = rsTemp("vchItemName") if blnShowChild or gintInvParentUpID = intParentID then %> <%= strParentName %>
<% if g_strTitle = strParentName or gintInvParentUpID = intParentID then DrawMenuChild(intParentID) end if end if rsTemp.MoveNext wend end if rsTemp.close set rsTemp = nothing %>

<% end if end sub sub DrawMenuChild(intParentID) if IsNumeric(intParentID) then else intParentID = 0 end if if intParentID > 0 then dim rsChild, intChildID, strChildName set rsChild = Inventory_GetItemsFromFolder(intParentID, true, false) if not rsChild.eof then %>

<% while not rsChild.eof intChildID = rsChild("intID") strChildName = rsChild("vchItemName") %> . <%= strChildName %>
<% rsChild.MoveNext wend %>

<% end if rsChild.close set rsChild = nothing %> <% end if end sub sub DrawDocument(intID) dim strSQL, rsTemp, strContent strSQL = "SELECT vchTitle, txtContent FROM " & STR_TABLE_GOEDIT & " WHERE intID=" & intID set rsTemp = gobjConn.execute(strSQL) if not rsTemp.eof then strContent = rsTemp("txtContent") & "" strContent = replace(strContent, "<" & "% imagebase %" & ">", imagebase) strContent = replace(strContent, "<" & "% aspbase %" & ">", aspbase) response.write strContent else response.write "

The requested page could not be found or is unavailable.

" end if rsTemp.close set rsTemp = nothing end sub Sub SendMailX(fromName,toName,ccName,bccName,subject,bodyText) dim awscopy ' awscopy = "mred@americanwebservices.com" ' if IsValid(bccName) then ' if bccName <> awscopy then ' bccName = bccName & "," & awscopy ' end if ' else ' bccName = awscopy ' end if dim m set m = CreateObject("CDONTS.NewMail") m.From = fromName m.To = toName m.CC = ccName m.bcc = bccName m.Subject = subject m.Body = bodyText m.Importance = 1 m.Send() Set m = Nothing End Sub Sub AddStdEmailSecurity(b) ' Adds standard security text to the end of an email mesage b = b & vbcrlf b = b & "-- Security Information --" & vbcrlf ' add any database identification below: 'b = b & "DBUsername= " & rsDealer("ID") & "-" & rsDealer("Username") & vbcrlf b = b & "Reference= " & Request.ServerVariables("REMOTE_ADDR") & vbcrlf b = b & "Hostname= " & Request.ServerVariables("REMOTE_HOST") & vbcrlf b = b & "Browser= " & Request.ServerVariables("HTTP_USER_AGENT") & vbcrlf b = b & "Referer= " & Request.ServerVariables("HTTP_REFERER") & vbcrlf b = b & "Encryption= " if Request.ServerVariables("SERVER_PORT_SECURE") = 1 then b = b & "Enabled" & vbcrlf else b = b & "Not Enabled" & vbcrlf end if b = b & vbcrlf b = b & "=======================================================" end sub %>