'GLOBAL UNLOCK OF ALL CHILKAT OBJECTS
If NOT IsObject( oChilkatUnlockGlobal ) Then
Set oChilkatUnlockGlobal = Server.CreateObject("Chilkat_9_5_0.Global")
bSuccess = oChilkatUnlockGlobal.UnlockBundle("WBMRKC.CB1042021_qGkqkA756rn9")
End If
Randomize
Function Authen()
Authen = Authenticated()
End Function
Function Authenticated()
Authenticated = CBool( Session("bAuthen") )
End Function
Private Function Login( ByVal sEmail, ByVal sPassword )
If ( AdminSuper AND sPassword = True ) Then
'Address SuperAdmin Swap to any Specific User
If Session("bAdminSuperUser") <> True Then
Session("iAdminSuperUser") = iOwner
End If
Session("bAdminSuperUser") = True
sPhone = "NOT Phone" 'Required to avoid validating an empty field
Else
Session("bAdminSuperUser") = False
Session("iAdminSuperUser") = 0
iPhone = Numeric( sEmail )
If iPhone > 2002000000 Then
sPhone = Phone( iPhone )
Else
sPhone = "NOT Phone" 'Required to avoid validating an empty field
End If
End If
Login = False
sEmail = Clean( sEmail )
sKeyAccount = UCase( Left( AlphaNumeric( sEmail & Now ), 15 ) )
sSQL = "SELECT TOP 1 tblAccounts.* FROM tblAccounts WHERE bLive > 0 AND bDeleted = 0 AND ( '@' + sUserID = '" & sEmail & "' OR sEmail = '" & LCase( sEmail ) & "' OR sPhone = '" & sPhone & "' OR sKey = '" & sEmail & "')"
Set rsLogin = CreateObject("ADODB.Recordset")
rsLogin.CursorLocation = adUseClient
rsLogin.Open sSQL, Connection, adOpenReadOnly, adLockReadOnly, adCmdText
If rsLogin.EOF Then
Login = "Passport | Account does not exist."
Else
If Session("bAdminSuperUser") <> True Then
rsLogin.Filter = "sPassword = '" & Clean( sPassword ) & "'"
End If
If rsLogin.EOF Then
Login = "Password is incorrect."
Else
Session("bAuthen") = True
Session("iTypeAccount") = rsLogin("iTypeAccount")
Session("iSubscriptionType") = rsLogin("iSubscriptionType")
Session("sKey") = rsLogin("sKey")
Session("sKeyAccount") = rsLogin("sKey")
Session("sUserID") = rsLogin("sUserID")
Session("sKeyPersonasAdministrative") = rsLogin("sKeyPersonasAdministrative")
Session("bAdmin") = CBool( rsLogin("bAdmin") )
Session("bSuper") = CBool( rsLogin("bSuper") ) OR Session("bAdminSuperUser")
Session("iSavvy") = rsLogin("iSavvy")
Session("bAdminSavvy") = CBool( ( Session("bAdmin") AND Session("iSavvy") > 3 ) OR Session("bSuper") )
Session("iOwner") = rsLogin("ID")
Session("sFacebookID") = rsLogin("sFacebookID")
Session("sName") = rsLogin("sName")
aNameFull = Split( Session("sName") & "", " ")
Session("sNameFirst") = aNameFull( 0 )
Session("sEmail") = rsLogin("sEmail")
Session("sPhone") = rsLogin("sPhone")
Session("sPostal") = rsLogin("sPostal")
Session("sAddress1") = rsLogin("sAddress1")
Session("sAddress2") = rsLogin("sAddress2")
Session("sCity") = rsLogin("sCity")
Session("bMemberOPA") = rsLogin("bMemberOPA")
Login = True
If Session("bAdminSuperUser") <> True Then
Call LoginLog()
End If
If Session("sURLRedirectAfterDetourComplete") = Empty Then
Set oJSON = Server.CreateObject("Chilkat_9_5_0.JsonObject")
bSuccess = oJSON.Load( rsLogin("jsonPreferences") )
If bSuccess Then
Session("sURLAfterSignIn") = oJSON.StringOf("sURLAfterSignIn")
End If
Destroy oJSON
Else
Session("sURLAfterSignIn") = Session("sURLRedirectAfterDetourComplete")
End If
End If
End If
Destroy( rsLogin )
If AppVar("bSuspended") AND NOT AdminSuper Then
Call Logout()
Redirect("/")
Quit
End If
End Function
Private Function LoginLog()
sSQL = "SELECT TOP 1 tblAccountsLog.* FROM tblAccountsLog WHERE tblAccountsLog.iOwner = " & iOwner & " AND tblAccountsLog.iSessionID = " & Numeric( Request.Cookies("Session.SessionID") )
Set rsLog = CreateObject("ADODB.Recordset")
rsLog.CursorLocation = adUseClient
rsLog.Open sSQL, Connection, adOpenStatic, adLockOptimistic, adCmdText
If rsLog.EOF Then
rsLog.AddNew
rsLog("iSessionID") = Numeric( Session.SessionID )
End If
rsLog("sIPAddress") = ServerVariable("REMOTE_ADDR")
rsLog("iOwner") = iOwner
rsLog("bAuthen") = 1
rsLog("sKeyPersona") = Session("sKeyPersona")
rsLog("idPersona") = Session("idPersona")
rsLog("dSessionEnd") = Now
rsLog.Update
Destroy( rsLog )
End Function
Private Function Logout()
Session("bAuthen") = 0
Session("bAdmin") = 0
Session("bSuper") = 0
Session("iSavvy") = 1
Session("iOwner") = 0
Session("iTypeAccount") = 0
Session("iLevel") = 0
Session("sKeyAccount") = Empty
Session("sEmail") = Empty
Session("sName") = Empty
Session("sNameFirst") = Empty
Session("bAdminSuperUser") = False
Session("iAdminSuperUser") = 0
Call LogoutLog()
End Function
Private Function LogoutLog() 'This needs to be added to the Session.End event in the Global.asa
sSQL = "SELECT TOP 1 tblAccountsLog.* FROM tblAccountsLog WHERE tblAccountsLog.iOwner = " & iOwner & " AND tblAccountsLog.iSessionID = " & Numeric( Request.Cookies("Session.SessionID") )
Set rsLog = CreateObject("ADODB.Recordset")
rsLog.CursorLocation = adUseClient
rsLog.Open sSQL, Connection, adOpenStatic, adLockOptimistic, adCmdText
If NOT rsLog.EOF Then
rsLog("dSessionEnd") = Now
rsLog.Update
End If
Destroy( rsLog )
End Function
Function LogContact( iTypeContact, sKeyAccountRecipient, sKeyAccountContact, sMessage, sIPData, sURLSentFrom )
LogContact = False
sSQL = "SELECT tblContactRelations.* FROM tblContactRelations WHERE tblContactRelations.ID = -1"
Set rsCMS = CreateObject("ADODB.Recordset")
rsCMS.CursorLocation = adUseClient
rsCMS.Open sSQL, Connection, adOpenStatic, adLockOptimistic, adCmdText
If rsCMS.EOF Then
rsCMS.AddNew
rsCMS("sKey") = Key( 15 )
rsCMS("iTypeContact") = iTypeContact 'Sale Successful = 1, Lead/Message = 5
rsCMS("sKeyPersona") = sKeyAccountRecipient 'Website Persona or Recipient Person
rsCMS("sKeyAccountContact") = AlphaNumeric( sKeyAccountContact ) 'Meaning the Sender
rsCMS("sMessage") = Clean( sMessage )
rsCMS("sIPData") = sIPData 'JSONLocationGet( ServerVariable("REMOTE_ADDR") )
rsCMS("sURLSentFrom") = sURLSentFrom
rsCMS.Update
LogContact = True
End If
Destroy( rsCMS )
End Function
Private Function AsideAd( sLayout )
If AppVar("bAdPublisher") Then
If Session("sAreasOfLaw") = Empty Then
Session("sAreasOfLaw") = " TERMINATOR,, "
End If
sTemp = " " & Replace( Replace( Replace( Session("sAreasOfLaw") & "", "TERMINATOR", ""), " ", ""), ",,,", ",")
sTemp = Trim( Left( sTemp, Len( sTemp ) - 1 ) )
aTemp = Split( sTemp, ",")
sTemp = Empty
For iLoop = 0 To UBound( aTemp )
sTemp = sTemp & " CHARINDEX(' " & aTemp( iLoop ) & ",', tbl@Ads.sAreasOfLaw) > 0"
If iLoop < UBound( aTemp ) Then
sTemp = sTemp & " OR "
End If
Next
'THERE IS SOME FUCKING PROBLEM AMONG THE NEXT 5 LINES IN SOME NEW PERSONAS'
sTemp = " ( " & sTemp & " ) "
sSQL = "SELECT tbl@Ads.* FROM tbl@Ads WHERE tbl@Ads.sKeyBusiness = '" & Session("sKeyBusiness") & "' AND ( " & sTemp & " OR tbl@Ads.bGeneric <> 0 ) AND sCodeLanguage = '" & Session("sCodeLanguage") & "' AND tbl@Ads.bLive <> 0 AND tbl@Ads.bDeleted = 0 AND CONVERT( datetime, '" & Now & "' ) < tbl@Ads.dDateEnd ORDER BY NEWID()"
Set rsAds = CreateObject("ADODB.Recordset")
rsAds.CursorLocation = adUseClient
rsAds.Open sSQL, Connection, adOpenStatic, adLockOptimistic, adCmdText
If rsAds.EOF Then
sHeading = "Advertise Here"
sDescription = "Your advertisement could be here and viewed thousands of times per month."
sURLPageLanding = "https://marketing.legal/contact"
sThemeColor = "primary"
Else
rsAds.Filter = "bGeneric = 0"
If rsAds.EOF Then
rsAds.Filter = ""
End If
sKeyAd = rsAds("sKey")
sHeading = rsAds("sHeading")
sDescription = rsAds("sDescription")
sURLPageLanding = rsAds("sURLPageLanding")
sFileImage1 = rsAds("sFileImage1") & ""
sThemeColor = rsAds("sThemeColor") & ""
bUseScreenShot = rsAds("bUseLandingPageScreenShot")
If IsBot() = False Then
On Error Resume Next
rsAds("iImpressions") = rsAds("iImpressions") + 1
rsAds.Update
On Error Goto 0
End If
End If
Destroy( rsAds )
If InStr( sURLPageLanding, Session("sDomain") ) = 0 Then
sTarget = "_blank"
End If
If Len( AlphaNumeric( sFileImage1 ) ) < 20 AND bUseScreenShot > 0 Then
sStrUrlImage = "url=" & sURLPageLanding & "&width=1200&height=630&quality=100"
sFileImage1 = "//api.urlbox.io/v1/F4UVscE5zgqc3BVd/" & UrlBoxEncode( sStrUrlImage ) & "/jpg?" & sStrUrlImage
End If
sURL = "/admin/advertisement-log.asp?sKeyAd=" & sKeyAd
If sLayout = "vertical" Then
sAd = ""
sAd = sAd & ""
sAd = sAd & ""
End If
If sLayout = "horizontal" Then
sAd = ""
sAd = sAd & ""
sAd = sAd & ""
End If
End If
AsideAd = sAd
End Function
Private Function BlogInfo( sHTML, sKeyPage )
sTemp = Empty
If InStr( sHTML, "#TOKEN-sBlogInfo#") > 0 Then
sSQL = "SELECT tblPageHTML.* FROM tblPageHTML WHERE sKey = '" & AlphaNumeric( sKeyPage ) & "'"
Set rsBlog = CreateObject("ADODB.Recordset")
rsBlog.CursorLocation = adUseClient
rsBlog.Open sSQL, Connection, adOpenReadOnly, adLockReadOnly, adCmdText
If rsBlog.EOF = False Then
sTemp = "
"
If Len( Alpha( rsBlog("sNameAuthor") ) ) > 3 Then
sTemp = sTemp & "Author: " & rsBlog("sNameAuthor") & " "
End If
sTemp = sTemp & "Date Posted: " & DateString( rsBlog("dAuthored"), False )
sTemp = sTemp & "
"
End If
Destroy( rsBlog )
End If
BlogInfo = Replace( sHTML, "#TOKEN-sBlogInfo#", sTemp )
End Function
Private Function SendTextMessage( iPhoneNumber, sMessageToSend )
iPhoneNumber = Numeric( Phone( iPhoneNumber ) )
Set oRest = Server.CreateObject("Chilkat_9_5_0.Rest")
'Establish connection to the AWS REST server, such as https://sns.us-west-2.amazonaws.com
bTls = 1
iPort = 443
bAutoReconnect = 1
oSuccess = oRest.Connect("sns.us-west-2.amazonaws.com",iPort,bTls,bAutoReconnect)
Set oAuthAws = Server.CreateObject("Chilkat_9_5_0.AuthAws")
oAuthAws.AccessKey = "AKIAIS2G3MGFGFUDIM7A"
oAuthAws.SecretKey = "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"
'The region should match our connection URL above.
oAuthAws.Region = "us-west-2"
oAuthAws.ServiceName = "sns"
oSuccess = oRest.SetAuthAws( oAuthAws )
oSuccess = oRest.AddQueryParam("Action", "Publish")
oSuccess = oRest.AddQueryParam("PhoneNumber", "+1" & iPhoneNumber )
oSuccess = oRest.AddQueryParam("Message", sMessageToSend )
oXML = oRest.FullRequestNoBody("GET","/")
SendTextMessage = ( oRest.ResponseStatusCode = 200 )
Destroy( oSuccess )
Destroy( oAuthAws )
Destroy( oRest )
End Function
Private Function TranslateLanguage( sStringToTranslate, sCodeLanguage )
sStringToTranslate = Replace( sStringToTranslate, "#TOKEN-", "#ZXCVB" ) 'STOP TOKEN FROM BEING TRANSLATED
sStringToTranslate = Replace( sStringToTranslate, "#col-aside-", "#MNBVCX" )
sStringToTranslate = Replace( sStringToTranslate, "#aside-call-to-", "#QAZXSW" )
aTemp = Split( sStringToTranslate & " ", Chr( 60 ) & "!--TRANSLATION-->") 'Use Chr(60) instead of < due to some odd quirk
sTranslated = ""
For iLoop = 0 To UBound( aTemp )
sTranslated = sTranslated & TranslatedByAWS( aTemp( iLoop ), sCodeLanguage )
Next
sTranslated = Replace( sTranslated, "#QAZXSW", "#aside-call-to-" )
sTranslated = Replace( sTranslated, "#aside-call-to-action #", "#aside-call-to-action#")
sTranslated = Replace( sTranslated, "#MNBVCX", "#col-aside-" )
sTranslated = Replace( Replace( Replace( sTranslated, "#col-aside-children #", "#col-aside-children#"), "#col-aside-siblings #", "#col-aside-siblings#"), "#col-aside-cousins #", "#col-aside-cousins#")
sTranslated = Replace( sTranslated, "#ZXCVB", "#TOKEN-" )
TranslateLanguage = FixBrokenTokens( sTranslated )
End Function
Private Function TranslatedByAWS( sStringToTranslate, sCodeLanguage )
iCharacterLength = Len( sStringToTranslate ) 'BUILD SOMETHING TO LOG THIS AND MAKE IT ULTIMATELY BILLABLE TO THE CLIENT UPON A SUCCESSFUL TRANSLATION
Set oRest = Server.CreateObject("Chilkat_9_5_0.Rest")
Set oAuthAWS = Server.CreateObject("Chilkat_9_5_0.AuthAws")
oAuthAWS.AccessKey = "AKIAIS2G3MGFGFUDIM7A"
oAuthAWS.SecretKey = "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"
oAuthAWS.Region = "us-west-2"
oAuthAWS.ServiceName = "translate"
bSuccess = oRest.SetAuthAws( oAuthAWS )
'URL: https://translate.us-west-2.amazonaws.com/ OR ANOTHER SERVER
bTls = 1
iPort = 443
bAutoReconnect = 1
bSuccess = oRest.Connect("translate.us-west-2.amazonaws.com", iPort, bTls, bAutoReconnect )
If ( bSuccess <> 1 ) Then
bError = True
End If
'Translate sStringToTranslate from English to sCodeLanguage
Set oJSON = Server.CreateObject("Chilkat_9_5_0.JsonObject")
bSuccess = oJSON.UpdateString("SourceLanguageCode", "en" )
bSuccess = oJSON.UpdateString("TargetLanguageCode", sCodeLanguage )
bSuccess = oJSON.UpdateString("Text", sStringToTranslate )
bSuccess = oRest.AddHeader("Content-Type","application/x-amz-json-1.1")
bSuccess = oRest.AddHeader("X-Amz-Target","AWSShineFrontendService_20170701.TranslateText")
Set sbRequestBody = Server.CreateObject("Chilkat_9_5_0.StringBuilder")
bSuccess = oJSON.EmitSb( sbRequestBody )
Set sbResponseBody = Server.CreateObject("Chilkat_9_5_0.StringBuilder")
bSuccess = oRest.FullRequestSb("POST","/", sbRequestBody, sbResponseBody )
If ( bSuccess <> 1 ) Then
bError = True
End If
respStatusCode = oRest.ResponseStatusCode
Set oJSONResponse = Server.CreateObject("Chilkat_9_5_0.JsonObject")
bSuccess = oJSONResponse.LoadSb( sbResponseBody )
oJSONResponse.EmitCompact = 0
If bError Then
TranslatedByAWS = sStringToTranslate 'Return the original data if there was a problem trying to translate.
Else
TranslatedByAWS = oJSONResponse.StringOf("TranslatedText") 'Return the translated data
End If
Destroy( oJSONResponse )
Destroy( sbResponseBody )
Destroy( sbRequestBody )
Destroy( oJSON )
Destroy( oAuthAWS )
Destroy( oRest )
End Function
Private Function UrlBoxEncode( sStrToEncode )
sStrToEncode = Replace( Replace( Replace( Server.URLEncode( sStrToEncode ), "%2E", "."), "%3D", "="), "%26", "&" )
Set oChilkatCrypt2 = Server.CreateObject("Chilkat_9_5_0.Crypt2")
oChilkatCrypt2.HashAlgorithm = "sha1"
oChilkatCrypt2.EncodingMode = "hexlower"
oChilkatCrypt2.KeyLength = 256
oChilkatCrypt2.SetHmacKeyEncoded "caf8b10dd473438196b514bbefac9ea6","ascii"
UrlBoxEncode = Server.HTMLEncode( oChilkatCrypt2.HmacStringENC( sStrToEncode ) )
Destroy( oChilkatCrypt2 )
End Function
Private Function AppVar( sName )
AppVar = Application( sName & Session("sKeyPersona") )
End Function
Private Function AppVarGet( sName )
AppVarGet = AppVar( sName )
End Function
Private Function AppVarSet( sName, sValue )
Application( sName & Session("sKeyPersona") ) = sValue
End Function
Private Function ArrayRandomize( aArrayRandom )
Dim iLoop, sTemp
If UBound( aArrayRandom ) > 0 Then
Randomize
iUpper = UBound( aArrayRandom )
For iLoop = 0 To Int( iUpper / 2 ) + 1
iRnd = Int( Rnd * ( iUpper + 1 ) )
sTemp = aArrayRandom( iRnd )
aArrayRandom( iRnd ) = aArrayRandom( iLoop )
aArrayRandom( iLoop ) = sTemp
Next
End If
ArrayRandomize = aArrayRandom
End Function
Private Function Aside( sKeyPersona, sKeyPage, sType )
Dim iLoop
sType = Trim( LCase( sType ) )
'Aside = sKeyPersona & "|" & sKeyPage
'sSQL = "SELECT tblPageHTML.* FROM tblPageHTML WHERE tblPageHTML.sKeyPersona = '" & sKeyPersona & "' AND tblPageHTML.sCodeLanguage = '" & Session("sCodeLanguage") & "' AND tblPageHTML.bLive <> 0 AND tblPageHTML.bDeleted = 0"
sSQL = "SELECT tblPageHTML.* FROM tblPageHTML WHERE tblPageHTML.idPersona = " & Session("idPersona") & " AND tblPageHTML.sCodeLanguage = '" & Session("sCodeLanguage") & "' AND tblPageHTML.bLive <> 0 AND tblPageHTML.bDeleted = 0"
Set rsPage = CreateObject("ADODB.Recordset")
rsPage.CursorLocation = adUseClient
rsPage.Open sSQL, Connection, adOpenReadOnly, adLockReadOnly, adCmdText
rsPage.Filter = "sKey = '" & sKeyPage & "'"
sPageAreasOfLaw = rsPage("sAreasOfLaw")
iPageID = rsPage("ID")
rsPage.Filter = ""
sSQL = "SELECT tblNavigation.* FROM tblNavigation WHERE tblNavigation.idPersona = " & Session("idPersona") & " AND tblNavigation.sCodeLanguage = '" & Session("sCodeLanguage") & "' AND tblNavigation.sPath IS NOT NULL AND tblNavigation.bLive <> 0 AND tblNavigation.bDeleted = 0 ORDER BY NEWID()"
Set rsNav = CreateObject("ADODB.Recordset")
rsNav.CursorLocation = adUseClient
rsNav.Open sSQL, Connection, adOpenReadOnly, adLockReadOnly, adCmdText
rsNav.Filter = "iPageID=" & iPageID
If sType = "children" Then
ID = rsNav("ID")
rsNav.Filter = "iPageID > 0 AND iParent=" & ID
End If
If sType = "siblings" Then
iParent = rsNav("iParent")
ID = rsNav("ID")
rsNav.Filter = "iPageID > 0 AND iParent=" & iParent & " AND ID <> " & ID
End If
Aside = Aside & "
"
Destroy( rsNav )
Destroy( rsPage )
End Function
Private Function AsideCourtHousesAndVenues( sPageAreasOfLaw )
If Numeric( AppVar("sCourtHouses") ) > 0 Then
sSQL = "SELECT tbl@CourtHouses.* FROM tbl@CourtHouses WHERE bLive = 1 AND bDeleted = 0 ORDER BY sName"
If Numeric( sPageAreasOfLaw ) > 0 Then
aTemp = Split( sPageAreasOfLaw, "," )
sTemp = Empty
For iLoop = 0 To UBound( aTemp )
If Numeric( aTemp( iLoop ) ) > 0 Then
sTemp = sTemp & " tbl@CourtHouses.sAreasOfLaw LIKE '% " & aTemp( iLoop ) & ",%'"
sTemp = sTemp & " OR "
End If
Next
sTemp = Left( sTemp, Len( sTemp ) - 4 )
Else
sTemp = "1=2"
End If
sSQL = Replace( sSQL, " WHERE ", " WHERE ( " & sTemp & " ) AND " )
sSQL = Replace( sSQL, " ", " ") 'Important
Set rsCourtHouse = CreateObject("ADODB.Recordset")
rsCourtHouse.CursorLocation = adUseClient
rsCourtHouse.Open sSQL, Connection, adOpenReadOnly, adLockReadOnly, adCmdText
If rsCourtHouse.EOF = False Then
'' sVenues = ""
End If
aCourtHouses = Split( AppVar("sCourtHouses") & "", "," )
Call ArrayRandomize( aCourtHouses )
For iLoop = 0 To UBound( aCourtHouses )
If Numeric( aCourtHouses( iLoop ) ) > 0 Then
rsCourtHouse.Filter = "ID=" & aCourtHouses( iLoop )
If rsCourtHouse.EOF = False Then
sTmpURL = IIf( Len( rsCourtHouse("sCity") ) > 3 ,Replace( rsCourtHouse("sCity") & ", Ontario", " ", "_"), "/cities")
sVenues = sVenues & "
#TOKEN-sNameShort# attends: "
sVenues = sVenues & "" & rsCourtHouse("sName") & " "
sVenues = sVenues & "(" & rsCourtHouse("sNameShort") & ") "
sVenues = sVenues & "" & rsCourtHouse("sAddress1") & " "
sVenues = sVenues & "" & rsCourtHouse("sCity") & ", Ontario, " & rsCourtHouse("sPostal") & " "
If Numeric( rsCourtHouse("sPhone1") ) > 0 Then
'' sVenues = sVenues & "P: " & rsCourtHouse("sPhone1") & " "
End If
If Numeric( rsCourtHouse("sPhone2") ) > 0 Then
'' sVenues = sVenues & "P: " & rsCourtHouse("sPhone2") & " "
End If
If Numeric( rsCourtHouse("sPhoneFax") ) > 0 Then
'' sVenues = sVenues & "F: " & rsCourtHouse("sPhoneFax") & " "
End If
sVenues = sVenues & "
"
End If
End If
If iLoop > 3 Then
Exit For
End If
Next
AsideCourtHousesAndVenues = sVenues
If AppVar("bShowTestimonials") Then
AsideCourtHousesAndVenues = AsideCourtHousesAndVenues & " #TOKEN-htmlTestimonials-1#"
End If
Destroy( rsCourtHouse )
End If
End Function
Private Function AsideForm()
'AT SOME TIME, CONSOLIDATE THE 2 (FORM-CONTACT) FORMS AND HANDLE THEM IN A THANK YOU PAGE WITH ERROR CHECKING
Set oFS = Server.CreateObject("Scripting.FileSystemObject")
Set oTextFile = oFS.OpenTextFile( MapPath("/form-contact-aside.asp"), 1, False )
AsideForm = oTextFile.ReadAll
Destroy( oTextFile )
Destroy( oFS )
End Function
Private Function AsideCallToAction()
If AppVar("iTypeFirm") > 0 AND AppVar("iTypeFirm") < 4 Then
aTemp1 = Split("Have Legal Questions and Need Answers?~|~Have Legal Issues and Need Help?~|~Do You Need to Address a Legal Matter?", "~|~")
sTemp1 = aTemp1( RandomInteger( 0, UBound( aTemp1 ) ) )
aTemp2 = Split("Avoid Delays.~|~Protect Your Legal Rights.~|~Address Your Legal Rights Today!~|~Discuss Your Legal Matter!~|~Get Legal Help Now.", "~|~")
sTemp2 = aTemp2( RandomInteger( 0, UBound( aTemp2 ) ) )
aTemp3 = Split("Contact #TOKEN-sNameShort#~|~Call #TOKEN-sPhone1#~|~Contact #TOKEN-sNameShort# #TOKEN-sPhone1#", "~|~")
sTemp3 = aTemp3( RandomInteger( 0, UBound( aTemp3 ) ) )
aTemp4 = Split("Discuss Your Legal Rights Today!~|~Get Started Today!~|~Don't Delay, Start Today!","~|~")
sTemp4 = aTemp4( RandomInteger( 0, UBound( aTemp4 ) ) )
sTemp = ""
Else
sTemp = ""
End If
AsideCallToAction = sTemp
End Function
Private Function AsidePromoConsultation()
If AppVar("iOfferFreeConsultation") > 0 Then
sTemp = "
This email was securely sent via MailGun, initiated on " & DateTime( Now ) & " from the IP Address: " & ServerVariable("REMOTE_ADDR") & " by a user on the " & AppVar("sNameShort") & " website; "
sHTML = sHTML & "which is hosted on the Success.Legal | Referrals.Legal professional network and software platform serving all Canadians interacting among the legal community.
"
sMessageShell = Scrape("/emails/shell-master.txt")
sEmailHTML = Replace( sMessageShell, "#TOKEN-CONTENT#", sHTML )
sEmailHTML = Replace( sEmailHTML, "#TOKEN-sDomain#", Session("sDomain") )
sEmailHTML = Replace( sEmailHTML, "#TOKEN-sName#", AppVar("sName") )
sEmailHTML = Replace( sEmailHTML, "#TOKEN-sNameShort#", AppVar("sNameShort") )
sEmailHTML = Replace( sEmailHTML, "#TOKEN-sButtonLogin#", "Login to " & AppVar("sNameShort") & "" )
sEmailHTML = Replace( Replace( sEmailHTML, "'", "'"), "’", "'")
sEmailHTML = Replace( sEmailHTML, "#TOKEN-bg-primary#", AppVar("sColorPrimary") )
Set oEmail = Server.CreateObject("Chilkat_9_5_0.Email")
oEmail.Subject = sSubject
oEmail.From = UCase( Session("sDomain") ) & " | " & AppVar("sNameShort") & " <" & sFrom & ">"
bSuccess = oEmail.AddTo("Recipient", sTo )
bSuccess = oEmail.AddHtmlAlternativeBody( sEmailHTML )
Set oHTTP = Server.CreateObject("Chilkat_9_5_0.Http")
oHTTP.Login = "api"
oHTTP.Password = "16691d9e9fba229287a965e990f05048-c76388c3-45b49225"
Set oPost = Server.CreateObject("Chilkat_9_5_0.HttpRequest")
oPost.HttpVerb = "POST"
oPost.Path = "/v3/cpd.legal/messages.mime"
oPost.ContentType = "multipart/form-data"
oPost.AddParam "from", UCase( Session("sDomain") ) & " | " & AppVar("sNameShort") & " <" & sFrom & ">"
oPost.AddParam "to","<" & sTo & ">"
oPost.AddParam "o:tag","IsOpened"
If sTo = AppVar("sEmail") AND IsEmail( AppVar("sEmailSecondary") ) Then
oPost.AddParam "to","<" & AppVar("sEmailSecondary") & ">"
bSuccess = oEmail.AddTo("", AppVar("sEmailSecondary") )
End If
bSuccess = oPost.AddStringForUpload2("message","message.eml",oEmail.GetMime(),"utf-8","application/octet-stream")
Set oResp = oHTTP.SynchronousRequest("api.mailgun.net", 443, 1, oPost )
Destroy( oResp )
Destroy( oPost )
Destroy( oHTTP )
Destroy( oEmail )
'BCC HACK FOR NOW, UNTIL MAILGUN BCC IS FIGURED OUT
Set oEmail = Server.CreateObject("Chilkat_9_5_0.Email")
oEmail.Subject = sSubject
oEmail.From = UCase( Session("sDomain") ) & " | " & AppVar("sNameShort") & " <" & sFrom & ">"
bSuccess = oEmail.AddTo("", "steve@marketing.legal" )
bSuccess = oEmail.AddTo("", "success@marketing.legal" )
bSuccess = oEmail.AddHtmlAlternativeBody( sEmailHTML )
Set oHTTP = Server.CreateObject("Chilkat_9_5_0.Http")
oHTTP.Login = "api"
oHTTP.Password = "16691d9e9fba229287a965e990f05048-c76388c3-45b49225"
Set oPost = Server.CreateObject("Chilkat_9_5_0.HttpRequest")
oPost.HttpVerb = "POST"
oPost.Path = "/v3/cpd.legal/messages.mime"
oPost.ContentType = "multipart/form-data"
oPost.AddParam "from", UCase( Session("sDomain") ) & " | " & AppVar("sNameShort") & " <" & sFrom & ">"
oPost.AddParam "to",""
oPost.AddParam "to",""
oPost.AddParam "o:tag","IsOpened"
bSuccess = oPost.AddStringForUpload2("message","message.eml",oEmail.GetMime(),"utf-8","application/octet-stream")
Set oResp = oHTTP.SynchronousRequest("api.mailgun.net", 443, 1, oPost )
Destroy( oResp )
Destroy( oPost )
Destroy( oHTTP )
Destroy( oEmail )
End Function
Private Function Fetch( ByVal sTable, ByVal sField, ByVal sFilter )
On Error Resume Next
sSQL = "SELECT TOP 1 " & sTable & "." & sField & " FROM " & sTable & " WHERE " & sFilter
Set rs = CreateObject("ADODB.RecordSet")
rs.CursorLocation = adUseClient
rs.Open sSQL, Connection, adOpenReadOnly, adLockReadOnly, adCmdText
If rs.EOF = False Then
Fetch = rs( sField )
End If
Destroy( rs )
End Function
Private Function FetchAvg( ByVal sTable, ByVal sField, ByVal sFilter )
On Error Resume Next
sSQL = "SELECT AVG(" & sField & ") -0.0 AS iAverage FROM " & sTable & " WHERE " & sFilter 'WITHOUT THE -0.0, IT ALWAYS RETURNS A WHOLE NUMBER '
Set rs = CreateObject("ADODB.RecordSet")
rs.CursorLocation = adUseClient
rs.Open sSQL, Connection, adOpenReadOnly, adLockReadOnly, adCmdText
If rs.EOF = False Then
FetchAvg = rs("iAverage")
End If
Destroy( rs )
End Function
Private Function FetchRows( sSQL, iRows, iRowStart, aFields ) 'THIS FUNCTION IS NOT USEFUL WHEN SUBSEQUENT ITERATION THROUGH A RECORDSET REQUIRES REFERENCING FIELD ITEMS BY THEIR RESPECTIVE NAMES
If Numeric( iRows ) < 1 Then
iRows = adGetRowsRest
End If
If Numeric( iRowStart ) < 1 Then
iRowStart = 1
End If
Set rs = CreateObject("ADODB.Recordset")
rs.CursorLocation = adUseClient
rs.Open sSQL, Connection, adOpenReadOnly, adLockReadOnly, adCmdText
If NOT rs.EOF Then
FetchRows = rs.GetRows( iRows, iRowStart, aFields )
End If
Destroy( rs )
End Function
Private Function FileExists( ByVal sPathFile )
If InStr( sPathFile, ":") = 0 Then
sPathFile = Server.MapPath( sPathFile )
End If
Set oFSO = CreateObject("Scripting.FileSystemObject")
FileExists = oFSO.FileExists( sPathFile )
Destroy( oFSO )
End Function
Private Function FileRead( ByVal sPathFile )
If FileExists( sPathFile ) Then
If InStr( sPathFile, ":") = 0 Then
sPathFile = Server.MapPath( sPathFile )
End If
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFile = oFSO.OpenTextFile( sPathFile, 1 ) '1 = Reading
FileRead = oFile.ReadAll
Destroy( oFile )
Destroy( oFSO )
End If
End Function
Private Function FileWrite( sPathFile, sTextToWrite, bAllowOverwrite, jsonX )
If InStr( sPathFile, ":") = 0 Then
sPathFile = Server.MapPath( sPathFile )
End If
If InStr( sPathFile, "/files/" & Session("sKeyPersona") & "/") > 0 Then
sPathFile = ServerVariable("APPL_PHYSICAL_PATH") & sPath & "custom.css"
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set fText = oFSO.CreateTextFile( sPathFile )
aTemp = Split( Trim( sTextToWrite ), vbCrLf )
For iLoop = 0 To UBound( aTemp )
fText.WriteLine( aTemp( iLoop ) )
Next
Destroy( fText )
Destroy ( oFSO )
End If
End Function
Function Flush()
Response.Flush
End Function
Private Function Form( sTemp )
Form = Request.Form( sTemp )
End Function
Function FormatTimeOfDay( ByVal sTempFormat )
FormatTimeOfDay = RegularExpression( sTempFormat, "(\b\d{1,2}:\d{2})\s(AM|PM)\b", "$1$2" )
End Function
Private Function GetURLSlug( ByVal sURL )
Set oURL = Server.CreateObject("Chilkat_9_5_0.Url")
bParseIt = oURL.ParseUrl( sURL )
GetURLSlug = oURL.Path
Destroy( oURL )
End Function
Private Function GetText( sPath )
On Error Resume Next
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oTStream = oFSO.OpenTextFile( Server.MapPath( sPath ), 1 )
Do Until oTStream.AtEndOfStream
sTemp = sTemp & oTStream.ReadLine & vbCRLF
Loop
Destroy( oTStream )
GetText = sTemp
End Function
'This is NOT yet working... ??
Private Function TextSet( sPath, sText )
On Error Resume Next
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFile = oFSO.CreateTextFile( Server.MapPath( sPath ), True )
oFile.Write( sText )
Destroy( oFile )
Destroy( oFSO )
On Error Goto 0
End Function
Private Function Greeting
Select Case Hour( Now )
Case 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11
Greeting = "Good Morning "
Case 18, 19, 20, 21, 22, 23
Greeting = "Good Evening "
Case Else
Greeting = "Good Afternoon "
End Select
End Function
Private Function GreetString
GreetString = Greeting() & " " & Session("sName")
End Function
Private Function HoursOfBusiness( jsonHoursBusiness )
Set oJSON = Server.CreateObject("Chilkat_9_5_0.JsonObject")
bSuccess = oJSON.Load( jsonHoursBusiness & "" )
aDays = Split("Sunday Monday Tuesday Wednesday Thursday Friday Saturday")
sTemp = ""
For iLoop = 0 To UBound( aDays )
If oJSON.StringOf( aDays( iLoop ) & ".sOpen" ) <> Empty Then
sTime = TwelveHourClock( oJSON.StringOf( aDays( iLoop ) & ".sOpen" ) )
sTemp = sTemp & Left( sTime, 5 ) & Right( sTime, 2 )
sTemp = sTemp & " - "
sTime = TwelveHourClock( oJSON.StringOf( aDays( iLoop ) & ".sClose" ) )
sTemp = sTemp & Left( sTime, 5 ) & Right( sTime, 2 ) & " "
End If
Next
sTemp = sTemp & ""
For iLoop = 0 To UBound( aDays )
If oJSON.StringOf( aDays( iLoop ) & ".sOpen" ) <> Empty Then
sTemp = sTemp & Left( aDays( iLoop ), 3 )
sTemp = sTemp & "" & Mid( aDays( iLoop ), 4 ) & ": "
End If
Next
Destroy( oJSON )
HoursOfBusiness = sTemp
End Function
Function HTMLArea( ByVal sHTML )
HTMLArea = HTMLAreaSized( sHTML, "100%", "80vh")
End Function
Function HTMLAreaSized( sHTML, iWidthWYSIWYG, iHeightWYSIWYG )
Set rte = new RichTextEditor
rte.AjaxPostbackUrl = "/master.asp"
rte.DesignDocType = "HTML5"
rte.DisabledItems = "new,print,spellcheck,pasteword,pageproperties,virtualkeyboard,googlemap,insertdate,syntaxhighlighter,inserttemplate,insertimagemap,insertlayer,insertform,toggleborder,fontname,fontsize,formatpainter"
' rte.SetSecurity("Gallery,Image", "*", "MaxFileSize", "102400")
rte.AllowScriptCode = True
rte.EnableDragDrop = True
rte.ShowPreviewToolbar = False
rte.Text = sHTML
rte.SaveButtonScript = "return doSwalSaving();"
rte.Name = "sHTML"
rte.ShiftEnterKeyTag = "br"
rte.Skin = "office2003silver2"
rte.TagBlackList = "object"
rte.TagWhiteList = "style"
'rte.URLType = "siterelative"
rte.UseHTMLEntities = True
rte.Width = iWidthWYSIWYG
rte.Height = iHeightWYSIWYG
'rte.ContentCss = "//stackpath.bootstrapcdn.com/bootstrap/4.1.3/css/bootstrap.min.css,/css/bootstrap.css,/css/style.css,/css/project.custom.css,files/" & Session("sKeyPersona") & "/css/custom.css,//maxcdn.bootstrapcdn.com/font-awesome/4.7.0/css/font-awesome.min.css,//fonts.googleapis.com/css?family=Open+Sans"
rte.ContentCss = "//stackpath.bootstrapcdn.com/bootstrap/4.1.3/css/bootstrap.min.css,/css/project.custom.css,//fonts.googleapis.com/css2?family=Open+Sans:wght@300;400;600;700;800"
rte.EditorBodyStyle = "overflow-x:hidden;"
' All rte.Security config is in master.asp and needs to be
If sCommunalLocked = "readonly" Then
rte.EditorMode = "View"
rte.ShowBottomBar = False
rte.ReadOnly
End If
rte.MvcInit()
Write( rte.GetString() )
HTMLAreaSized = rte.ID
Destroy( rte )
End Function
Function HTMLGateway( idPageGateway, jsonDataOptions )
Dim iParent, iCols, sIcon, htmlOutput, sTemp, aIcon
'iParent = Numeric( Fetch("tblNavigation", "ID", "iPageID=" & idPageGateway) ) 'IN CASE RETURNS 0, THE SQL BELOW EXCLUDES 0, WHICH OTHERWISE WOULD RETURN THOUSANDS OF IMPROPER RESULTS
sTemp = IIf( Session("bHomePage") = True, 0, "( SELECT ID FROM tblNavigation WHERE iPageID = " & idPageGateway & ") ")
sSQL = "SELECT tblNavigation.*, tblPageHTML.sTitle, tblPageHTML.sSynopsis, tblPageHTML.sIconFontAwesome FROM tblNavigation INNER JOIN tblPageHTML ON tblPageHTML.ID = tblNavigation.iPageID " & _
"WHERE tblNavigation.idPersona = " & Session("idPersona") & " AND tblNavigation.iParent = " & _
sTemp & " AND tblNavigation.bLive > 0 AND tblNavigation.bDeleted = 0 AND tblNavigation.sLabel <> 'About' AND tblNavigation.sLabel <> 'Home' " & _
"ORDER BY tblNavigation.iWeight, tblNavigation.sLabel, tblNavigation.ID"
Set rsGate = Server.CreateObject("ADODB.Recordset")
rsGate.CursorLocation = adUseClient
rsGate.Open sSQL, Connection, adOpenReadOnly, adLockReadOnly, adCmdText
If NOT rsGate.EOF Then
Select Case rsGate.RecordCount
Case 1
iCols = 12
Case 2
iCols = 6
Case Else
iCols = 4
End Select
htmlTemplate = FileRead("/mvc-models/gateway-default-html.asp")
Do Until rsGate.EOF
tempTemplate = htmlTemplate ' Start with a fresh template each iteration.
If InStr( rsGate("sIconFontAwesome"), "fa-") = 0 Then
sIcon = AppVar("sIconDefault") '"fa-balance-scale" ' Change to a persona-wide AppVar default configurable by Admin
Else
aIcon = Split( rsGate("sIconFontAwesome") & "", ",")
sIcon = aIcon( 0 )
End If
tempTemplate = Replace( tempTemplate, "#TOKEN-iCols#", iCols )
tempTemplate = Replace( tempTemplate, "#TOKEN-sIcon#", sIcon )
tempTemplate = Replace( tempTemplate, "#TOKEN-sLabel#", rsGate("sLabel") )
tempTemplate = Replace( tempTemplate, "#TOKEN-sSynopsis#", Truncate( rsGate("sSynopsis"), 63 ) )
tempTemplate = Replace( tempTemplate, "#TOKEN-sPath#", rsGate("sPath") )
htmlOutput = htmlOutput & tempTemplate
rsGate.MoveNext
Loop
HTMLGateway = "
" & htmlOutput & "
"
End If
Destroy( rsGate )
End Function
Function IIf(blnExpression, vTrueResult, vFalseResult)
If blnExpression Then
IIf = vTrueResult
Else
IIf = vFalseResult
End If
End Function
Private Function ImageMaxWidth( sFile, iWidth ) 'OUTPUT IS ALWAYS IN .JPG
If InStr(".bmp.gif.jpeg.jpg.png", Right( sFile, 4 ) ) > 0 Then
Set oJpeg = Server.CreateObject("Persits.Jpeg")
oJpeg.Open Server.MapPath( sFile )
If oJpeg.Width > iWidth Then
sPathSave = Server.MapPath( sFile )
oJpeg.PreserveAspectRatio = True
oJpeg.Width = iWidth
oJpeg.Quality = 90
oJpeg.Save sPathSave
End If
Destroy( oJpeg )
End If
End Function
Private Function InstallPage( idMasterPage, idPersonaDestination, jsonData )
sSQL = "SELECT tblPageHTML.* FROM tblPageHTML WHERE ID = " & idMasterPage
Set rsExport = CreateObject("ADODB.Recordset")
rsExport.CursorLocation = adUseClient
rsExport.Open sSQL, Connection, adOpenReadOnly, adLockReadOnly, adCmdText
If NOT rsExport.EOF Then
sSQL = "SELECT tblPageHTML.* FROM tblPageHTML WHERE ID = 0"
Set rsImport = CreateObject("ADODB.Recordset")
rsImport.CursorLocation = adUseClient
rsImport.Open sSQL, Connection, adOpenStatic, adLockOptimistic, adCmdText
rsImport.AddNew
rsImport("sKey") = Key( 15 )
rsImport("idPersona") = idPersonaDestination
rsImport("sKeyPersona") = Fetch("tbl@Personas","sKey","ID=" & idPersonaDestination )
rsImport("sKeyPageHTMLSyndicate") = rsExport("sKey")
sFieldsSkip = ",ID,sKey,idPersona,sKeyPersona,sKeyPageHTMLSyndicate,iOwner,iCreator,bCommunal,bCommunalSyncAllow,dCreated,dModified," 'LEADING AND TRAILING COMMAS ARE REQUIRED
For Each oField In rsExport.Fields
If InStr( sFieldsSkip, "," & oField.Name & "," ) = 0 AND NOT IsNull( oField.Value ) Then
rsImport( oField.Name ) = oField.Value
End If
Next
rsImport("bCommunalSyncAllow") = 1
rsImport("iOwner") = iOwner
rsImport("iCreator") = iOwner
rsImport("dCreated") = Now
rsImport("dModified") = Now
rsImport.Update
InstallPage = rsImport("ID") 'RETURN ID OF PAGE
Destroy( rsImport )
End If
Destroy( rsExport )
End Function
Private Function InstallPageNav( idMasterNav, idPersonaDestination, idPage, idParentNew, sPath, jsonData )
sSQL = "SELECT tblNavigation.* FROM tblNavigation WHERE ID = " & idMasterNav
Set rsExport = CreateObject("ADODB.Recordset")
rsExport.CursorLocation = adUseClient
rsExport.Open sSQL, Connection, adOpenReadOnly, adLockReadOnly, adCmdText
If NOT rsExport.EOF Then
sSQL = "SELECT tblNavigation.* FROM tblNavigation WHERE ID = 0"
Set rsImport = CreateObject("ADODB.Recordset")
rsImport.CursorLocation = adUseClient
rsImport.Open sSQL, Connection, adOpenStatic, adLockOptimistic, adCmdText
rsImport.AddNew
rsImport("sKey") = Key( 15 )
rsImport("idPersona") = idPersonaDestination
rsImport("sKeyPersona") = Fetch("tbl@Personas","sKey","ID=" & idPersonaDestination )
sFieldsSkip = ",ID,sKey,idPersona,sKeyPersona,idPage,iOwner,iCreator,dCreated,dModified," 'LEADING AND TRAILING COMMAS ARE REQUIRED
For Each oField In rsExport.Fields
If InStr( sFieldsSkip, "," & oField.Name & "," ) = 0 AND NOT IsNull( oField.Value ) Then
rsImport( oField.Name ) = oField.Value
End If
Next
rsImport("iPageID") = idPage
rsImport("iParent") = idParentNew
If sPath <> Empty Then
rsImport("sPath") = sPath
End If
rsImport("iOwner") = iOwner
rsImport("iCreator") = iOwner
rsImport("dCreated") = Now
rsImport("dModified") = Now
rsImport.Update
InstallPageNav = rsImport("ID") 'RETURN ID OF NAV-ITEM
Destroy( rsImport )
End If
Destroy( rsExport )
End Function
Function IsBot()
sUserAgent = ServerVariable("HTTP_USER_AGENT")
iLocationOfBot = InStr( 1, sUserAgent, "Bot", 1 )
IsBot = ( iLocationOfBot > 0 )
End Function
Function IsFirefox()
sUserAgent = ServerVariable("HTTP_USER_AGENT")
iLocationOfFirefox = InStr( 1, sUserAgent, "Firefox", 1 )
IsFirefox = ( iLocationOfFirefox > 0 )
End Function
Function IsChrome()
sUserAgent = ServerVariable("HTTP_USER_AGENT")
iLocationOfChrome = InStr( 1, sUserAgent, "Chrome", 1 )
IsChrome = ( iLocationOfChrome > 0 )
End Function
Function IsEdge()
sUserAgent = ServerVariable("HTTP_USER_AGENT")
iLocationOfEdge = InStr( 1, sUserAgent, "Edge", 1 )
IsEdge = ( iLocationOfEdge > 0 )
End Function
Function IsInternetExplorer()
sUserAgent = ServerVariable("HTTP_USER_AGENT")
iLocationOfInternetExplorer = InStr( 1, sUserAgent, "MSIE", 1 )
IsInternetExplorer = ( iLocationOfInternetExplorer > 0 )
End Function
Private Function Issue301Redirect( sURLSlugOld, sURLSlugNew, sKeyRecordIssuing )
sURLSlugOld = Replace( sURLSlugOld, "//", "/" )
sURLSlugNew = Replace( sURLSlugNew, "//", "/" )
sKeyRecordIssuing = AlphaNumeric( sKeyRecordIssuing )
sSQL = "SELECT * FROM tbl@301Redirects WHERE tbl@301Redirects.sURLSlugOld = '" & sURLSlugOld & "' AND tbl@301Redirects.sURLSlugNew = '" & sURLSlugNew & "'"
Set rs301 = CreateObject("ADODB.RecordSet")
rs301.CursorLocation = adUseClient
rs301.Open sSQL, Connection, adOpenStatic, adLockOptimistic, adCmdText
If rs301.EOF = True Then
rs301.AddNew
rs301("sKey") = Key( 15 )
rs301("sURLSlugOld") = sURLSlugOld
rs301("sURLSlugNew") = sURLSlugNew
rs301("sKeyRecordIssuing") = AlphaNumeric( sKeyRecordIssuing )
rs301("iOwner") = iOwner
rs301.Update
End If
Destroy( rs301 )
End Function
'****** THE BELOW FUNCTIONS CREATED ON FEBRUARY 4 2024, SHOULD ACCOMMODATE ALL BASIC JSON REQUIREMENTS'
Function jsonAddObjectMemberValue( ByVal jsonData, ByVal sObjectName, ByVal sMemberName, ByVal vValue, jsonMore )
jsonAddObjectMemberValue = jsonSetObjectMemberValue( jsonData, sObjectName, sMemberName, vValue, jsonMore ) 'SYNONYMOUS FUNCTION, USE SET
End Function
Function jsonGetObjectMemberValueAsString( ByVal jsonData, ByVal sObjectName, ByVal sMemberName, jsonMore )
Dim oJSON
Set oJSON = Server.CreateObject("Chilkat_9_5_0.JsonObject")
jsonGetObjectMemberValueAsString = ""
If oJSON.Load( jsonData ) Then
If oJSON.HasMember( sObjectName & "." & sMemberName ) Then
jsonGetObjectMemberValueAsString = oJSON.StringOf( sObjectName & "." & sMemberName )
End If
End If
Destroy( oJSON )
End Function
Function jsonRemoveObjectMember( ByVal jsonData, ByVal sObjectName, ByVal sMemberName )
Dim oJSON
Set oJSON = Server.CreateObject("Chilkat_9_5_0.JsonObject")
If oJSON.Load( jsonData ) Then
bSuccess = oJSON.Delete( sObjectName & "." & sMemberName )
jsonRemoveObjectMember = oJSON.Emit()
Else
jsonRemoveObjectMember = jsonData
End If
Destroy(oJSON)
End Function
Function jsonRenameObjectMember( ByVal jsonData, ByVal sObjectName, ByVal sMemberName, ByVal sMemberNameNew )
Dim oJSON
Set oJSON = Server.CreateObject("Chilkat_9_5_0.JsonObject")
If oJSON.Load( jsonData ) Then
bSuccess = oJSON.Rename( sObjectName & "." & sMemberName, sObjectName & "." & sMemberNameNew )
jsonRenameObjectMember = oJSON.Emit()
Else
jsonRenameObjectMember = jsonData
End If
Destroy(oJSON)
End Function
Function jsonSetObjectMemberValue( ByVal jsonData, ByVal sObjectName, ByVal sMemberName, ByVal vValue, jsonMore )
Dim oJSON
Set oJSON = Server.CreateObject("Chilkat_9_5_0.JsonObject")
If oJSON.Load( jsonData ) Then
Dim sPath
sPath = sObjectName & "." & sMemberName
Dim sDataType
sDataType = TypeName( vValue )
Select Case sDataType
Case "Integer", "Long"
oJSON.UpdateInt sPath, vValue
Case "String"
oJSON.UpdateString sPath, vValue
Case "Boolean"
oJSON.UpdateBool sPath, vValue
Case "Double", "Single"
oJSON.UpdateNumber sPath, vValue
Case Else
If IsJSONObject( vValue ) Then
Dim oTemp
Set oTemp = Server.CreateObject("Chilkat_9_5_0.JsonObject")
If oTemp.Load( vValue ) Then
oJSON.UpdateObject sPath, oTemp
End If
ElseIf IsJSONArray( vValue ) Then
Dim aTemp
Set aTemp = Server.CreateObject("Chilkat_9_5_0.JsonArray")
If aTemp.Load( vValue ) Then
oJSON.UpdateArray sPath, aTemp
End If
Else
oJSON.UpdateNull sPath 'Handle null or unrecognized data types
End If
End Select
jsonSetObjectMemberValue = oJSON.Emit()
Else
jsonSetObjectMemberValue = jsonData 'On a failure, return the original JSON
End If
Destroy( oTemp )
Destroy( aTemp )
Destroy( oJSON )
End Function
'****** THE ABOVE FUNCTIONS CREATED ON FEBRUARY 4 2024, SHOULD ACCOMMODATE ALL BASIC JSON REQUIREMENTS'
Private Function JSONLocationGet( sIPAddress )
JSONLocationGet = Scrape("https://api.ipdata.co/" & sIPAddress & "?api-key=75f7172b027c17cf0278dada8a0c2613aead13f80164c7f70cd0f4eb")
Call LogUseResources("IPData", "{""iCost"": .002 }" )
End Function
Private Function JSONStringsOf( sJSON, sItems ) 'sItems is a csv list, if more than one item is being sought, an Array of Strings is returned in same pecking order as sItems
Set oJSON = Server.CreateObject("Chilkat_9_5_0.JsonObject")
oJSON.EmitCompact = 0
bSuccess = oJSON.Load( sJSON )
aItems = Split( sItems, ",")
For iLoop = 0 To UBound( aItems )
aItems( iLoop ) = oJSON.StringOf( aItems( iLoop ) ) 'Essentially replaces Items( iLoop ) from being the name of the JSON item requested, to being the value of the JSON item requested
Next
If UBound( aItems ) = 0 Then
JSONStringsOf = aItems( 0 ) 'Returns value as String
Else
JSONStringsOf = aItems 'Returns values as Strings in Array
End If
Destroy( oJSON )
End Function
Private Function jsonStringsGet( sJSON, sItems ) 'sItems is a ~|~ delimited list, if more than one item is being sought, an Array of Strings is returned in same pecking order as sItems
Set oJSON = Server.CreateObject("Chilkat_9_5_0.JsonObject")
oJSON.EmitCompact = 0
bSuccess = oJSON.Load( sJSON )
If bSuccess Then
aItems = Split( sItems, "~|~")
For iLoop = 0 To UBound( aItems )
aItems( iLoop ) = oJSON.StringOf( aItems( iLoop ) ) 'Essentially replaces Items( iLoop ) from being the name of the JSON item requested, to being the value of the JSON item requested
Next
If UBound( aItems ) = 0 Then
JSONStringsOf = aItems( 0 ) 'Returns value as String
Else
JSONStringsOf = aItems 'Returns values as Strings in Array
End If
Else
'sJSON does not contain parseable JSON data, return Empty
jsonStringsGet = Empty
End If
Destroy( oJSON )
End Function
Private Function jsonStringsSet( aItems ) 'A two dimensional array of key-value pairs is expected.'
If IsArray( aItems ) Then
Set oJSON = Server.CreateObject("Chilkat_9_5_0.JsonObject")
iIndex = -1 'An index value of -1 is used to append at the end.
For iLoop = 0 To UBound( aItems )
bSuccess = oJSON.AddStringAt( iIndex, aItems( iLoop )(0), aItems( iLoop )(1) )
Next
oJSON.EmitCompact = 1 'Compacts JSON data to a single line, not nested/human readable.
jsonStringsSet = oJSON.Emit()
Destroy( oJSON )
Else
jsonStringsSet = "ERROR: The function expects an array as an argument."
End If
End Function
Private Function Key( iLength ) 'Advanced Key Generator - New as of Nov 28 2018
aTemp = Split("A B C D E F G H J K L M N P Q R S T U V W X Y Z 2 3 4 5 6 7 8 9")
sTemp = aTemp( Year( Now ) - 2018 ) 'Keep this as 2018
sTemp = sTemp & aTemp( Month( Now ) - 1 )
sTemp = sTemp & aTemp( Day( Now ) - 1 )
sTemp = sTemp & aTemp( Hour( Now ) ) 'Already zero based (24 hour clock)
sTemp = sTemp & aTemp( Int( Minute( Now ) / 2 ) )
sTemp = sTemp & aTemp( Int( Second( Now ) / 2 ) )
sTemp = sTemp & Right( CStr( Numeric( Now ) ), 4 )
Randomize
For iLoopPrivate = 1 To 3
Key = Key & aTemp ( Int( UBound( aTemp ) * Rnd( 1 ) ) + 1 )
Next
Key = Right( sTemp & Key, iLength )
Do Until Len( Key ) = iLength
Key = Key & aTemp ( Int( UBound( aTemp ) * Rnd( 1 ) ) + 1 )
Loop
End Function
Private Function Keywords( sTemp )
sTemp = Replace( sTemp, " ", " " )
Keywords = AlphaNumericSpace( RegularExpression( Replace( Replace( Replace( Clean( sTemp ), ",", " "), ".", " "), "/", " "), "\b\w{1,2}\b", " " ) ) 'Removes commas and words < 3 chars.
Keywords = Replace( LCase( RegularExpression( Keywords, "\s{2,}", " ") ), " ", "," ) 'Removes double spaces and makes lower case.
aKeywordsToMute = Split("and for the that they who can are get with also what has such more", " ")
For iLoop = 0 To UBound( aKeywordsToMute )
Keywords = Replace( Keywords, "," & aKeywordsToMute( iLoop ) & ",", ",")
Next
Keywords = DistinctTerms( Keywords, "," )
End Function
Function KillSession()
sSQL = "SELECT TOP 1 tblAccountsLog.* FROM tblAccountsLog WHERE iSessionID = " & Numeric( Session.SessionID ) & " ORDER BY ID DESC"
Set rsLog = CreateObject("ADODB.Recordset")
rsLog.CursorLocation = adUseClient
rsLog.Open sSQL, Connection, adOpenStatic, adLockOptimistic, adCmdText
If rsLog.EOF = False Then
rsLog("iSessionID") = 0
rsLog("dSessionEnd") = Now
rsLog.Update
End If
Destroy( rsLog )
Session.Contents.RemoveAll()
End Function
Function iOwner
iOwner = Numeric( Session("iOwner") )
End Function
Private Function IsAllLCase( sTemp )
IsAllLCase = NOT CBool( StrComp( sTemp, LCase( sTemp ) ) )
End Function
Private Function IsAllUCase( sTemp )
IsAllUCase = NOT CBool( StrComp( sTemp, UCase( sTemp ) ) )
End Function
Private Function IsAllCaps( sTemp )
IsAllCaps = IsAllUCase( sTemp )
End Function
Private Function IsEmail( sTemp )
Set oRegExp = New RegExp
oRegExp.Pattern = "^[a-z0-9][\w\.-]*[a-z0-9]@[a-z0-9][\w\.-]*[a-z0-9]\.[a-z][a-z\.]*[a-z]$"
IsEmail = oRegExp.Test( LCase( Trim( sTemp & "" ) ) )
Destroy( oRegExp )
End Function
Function IsDeviceMobile()
Set oRegExp = New RegExp
With oRegExp
.Pattern = "(up.browser|up.link|mmp|smartphone|midp|wap|phone|windows ce|pda|mobile|mini|ipad|Android|BlackBerry|iPhone|iPod|Palm|Symbian)"
.IgnoreCase = True
.Global = True
End With
IsDeviceMobile = oRegExp.Test( ServerVariable("HTTP_USER_AGENT") )
Destroy( oRegExp )
End Function
Private Function LoadPersonaTheme()
aTemp = Split("sFontsGoogle,sHTMLLogo,sHTMLLogoVertical,sFileLogo,sFileLogoVertical,jsonIconsAndImages,sColorPrimary,sFileCustomCSS,bHeroBar,sFilePathImagesHero,sHeroOverlayColor,iHeroOverlayColorPercent,bHeaderTopShowDesktop,iHeaderTopConfig,bHeaderCentered,bHeaderLogoLock,bHeaderLight,bShowHeaderSignIn,bNavbarSearch,bNavbarLight,bNavbarFancy,bGrayscaleImages,iImagesMonotoneOffsetSaturation,iImagesMonotoneOffsetHue,bImagesScreenshotHome,bBreadcrumbsStriped,bSidebar,sSidebarColor,bLiveFX,sNameFXDefault,tDelayFX,bIncludeAnimateCSS", ",")
sSQL = "SELECT tbl@PersonasThemes.* FROM tbl@PersonasThemes WHERE tbl@PersonasThemes.idPersona = " & Session("idPersona") & " OR tbl@PersonasThemes.ID = 1 ORDER BY tbl@PersonasThemes.ID DESC"
Set rsTheme = CreateObject("ADODB.Recordset")
rsTheme.CursorLocation = adUseClient
rsTheme.Open sSQL, Connection, adOpenReadOnly, adLockReadOnly, adCmdText
If rsTheme.EOF = False Then
For iLoop = 0 To UBound( aTemp )
Call AppVarSet( aTemp( iLoop ), rsTheme( aTemp( iLoop ) ) )
Next
End If
Call AppVarSet("sIconDefault", jsonGetObjectMemberValueAsString( rsTheme("jsonIconsAndImages"), sObjectName, "sIconDefault", jsonMore ) )
Destroy( rsTheme )
End Function
Private Function MapPath( sPath )
If InStr( sPath, ":\" ) = 0 Then
MapPath = Server.MapPath( sPath )
Else
MapPath = sPath
End If
End Function
Private Function NoHTML( sTemp )
sTemp = Replace( Replace( sTemp, " ", " "), " ", " ")
Set oRegExp = New RegExp
oRegExp.Global = True
oRegExp.Pattern = "<[^>]*>"
NoHTML = Replace( oRegExp.Replace( Trim( sTemp ) & "", "" ), Chr( 10 ), "" )
Destroy( oRegExp )
NoHTML = Replace( NoHTML, " ", " " )
End Function
Private Function NoWWW( ByVal sTemp )
NoWWW = Replace( sTemp & "", "www.", "")
End Function
Private Function NowDB()
sSQL = "SELECT TOP 1 ID, GETDATE() AS dtNow FROM tblAccounts" 'Make certain that this only ever seeks a single record.
Set rsNow = CreateObject("ADODB.Recordset")
rsNow.CursorLocation = adUseClient
rsNow.Open sSQL, Connection, adOpenReadOnly, adLockReadOnly, adCmdText
NowDB = rsNow("dtNow")
Destroy( rsNow )
End Function
Private Function Numeric( ByVal sTemp )
If VarType( sTemp ) <> 9 Then
Numeric = Abs( RegularExpression( "0" & sTemp, "[^0-9]", "" ) )
End If
End Function
Private Function DateTimeFromRFC3339( dDateTimeFromRFC3339, a )
DateTimeFromRFC3339 = Replace( Replace( dDateTimeFromRFC3339, "T", " "), "Z", "")
End Function
Private Function DateTimeToRFC3339( dDateTimeToRFC3339, a ) '2016-12-02T12:59:14Z
If InStr( dDateTimeToRFC3339, "Z") = 0 Then
If IsDate( dDateTimeToRFC3339 ) Then
DateTimeToRFC3339 = Year( dDateTimeToRFC3339 ) & "-" & Right( "0" & Month( dDateTimeToRFC3339 ), 2 ) & "-" & Right( "0" & Day( dDateTimeToRFC3339 ), 2 ) & "T" & Right( "0" & Hour( dDateTimeToRFC3339 ), 2 ) & ":" & Right( "0" & Minute( dDateTimeToRFC3339 ), 2 ) & ":" & Right( "0" & Second( dDateTimeToRFC3339 ), 2 ) & "Z"
End If
Else
DateTimeToRFC3339 = dDateTimeToRFC3339
End If
End Function
Private Function DateTimeOffsetUTC( dDateTimeUTC, a )
Set oDateTime = Server.CreateObject("Chilkat_9_5_0.CkDateTime")
oDateTime.SetFromTimestamp( DateTimeToRFC3339( dDateTimeUTC, a ) )
DateTimeOffsetUTC = oDateTime.UtcOffset 'Returns number of seconds offset from the
Destroy( oDateTime )
End Function
Private Function DateTimeEastern( dDateTimeZulu, a )
dDateTimeZulu = DateTimeToRFC3339( dDateTimeZulu, a )
Set oDateTime = Server.CreateObject("Chilkat_9_5_0.CkDateTime")
bSuccess = oDateTime.SetFromTimestamp( dDateTimeZulu )
If bSuccess Then
oDateTime.AddSeconds( DateTimeOffsetUTC( dDateTimeZulu, a ) )
DateTimeEastern = DateTimeFromRFC3339( oDateTime.GetAsTimestamp( 0 ), a )
End If
Destroy( oDateTime )
End Function
Function NavTreeFix( sCodeLanguage, idParentTop, jsonData )
sCodeLanguage = Clean( sCodeLanguage )
sSQL = "SELECT tblNavigation.* FROM tblNavigation WHERE idPersona = " & Session("idPersona") & " AND sCodeLanguage = '" & sCodeLanguage & "' AND iPageID > 0 AND bDeleted = 0 ORDER BY iWeight ASC" 'idPersona of communal master persona/network'
Set rsTree = CreateObject("ADODB.Recordset")
rsTree.CursorLocation = adUseClient
rsTree.Open sSQL, Connection, adOpenStatic, adLockOptimistic, adCmdText
If NOT rsTree.EOF Then
idParentTop = 0 'HARDCODED FOR NOW TO BE ABSOLUTE TOP PARENT'
Call NavTreeFixPaths( idParentTop, "/" & sCodeLanguage, rsTree, jsonData )
End If
Destroy( rsTree )
End Function
Function NavTreeFixPaths( parentId, sSlugOrig, rsTreeOrig, jsonData )
Dim sSlug
Dim rsTreeClone 'MUST USE DIM
Set rsTreeClone = rsTreeOrig.Clone()
rsTreeClone.Filter = "iParent = " & parentId
If NOT rsTreeClone.EOF Then
rsTreeClone.Sort = "iWeight ASC"
sSlug = sSlugOrig
Do Until rsTreeClone.EOF
sPathOld = rsTreeClone("sPath")
sPathNew = sSlug & "/" & PagePathEncode( rsTreeClone("sLabel") )
rsTreeClone("sPath") = sPathNew
rsTreeClone.Update
Call NavTreeFixModals( sPathOld, sPathNew, jsonData )
Call NavTreeFixHTML( sPathOld, sPathNew, jsonData )
sPath = rsTreeClone("sPath")
Call NavTreeFixPaths( rsTreeClone("ID"), sPath, rsTreeOrig, jsonData )
rsTreeClone.MoveNext
Loop
End If
Destroy( rsTreeClone )
End Function
Function NavTreeFixModals( sPathOld, sPathNew, jsonData )
sSQL = "SELECT tblModals.* FROM tblModals WHERE idPersona = " & Session("idPersona") & " AND sURLTrigger = '" & sPathOld & "' AND tblModals.bDeleted = 0"
Set rsModal = CreateObject("ADODB.Recordset")
rsModal.CursorLocation = adUseClient
rsModal.Open sSQL, Connection, adOpenStatic, adLockOptimistic, adCmdText
Do Until rsModal.EOF
rsModal("sURLTrigger") = sPathNew
rsModal.Update
rsModal.MoveNext
Loop
Destroy( rsModal )
End Function
Function NavTreeFixHTML( sPathOld, sPathNew, jsonData )
Dim rsHTML
sSQL = "SELECT tblPageHTML.sHTML FROM tblPageHTML WHERE tblPageHTML.idPersona = " & Session("idPersona") & " AND tblPageHTML.sHTML LIKE '% href=" & Chr( 34 ) & sPathOld & "%' AND tblPageHTML.bDeleted = 0"
Set rsHTML = CreateObject("ADODB.Recordset")
rsHTML.CursorLocation = adUseClient
rsHTML.Open sSQL, Connection, adOpenStatic, adLockOptimistic, adCmdText
Do Until rsHTML.EOF
rsHTML("sHTML") = Replace( rsHTML("sHTML"), " href=" & Chr( 34 ) & sPathOld, " href=" & Chr( 34 ) & sPathNew )
'' rsHTML("sHTML") = Replace( rsHTML("sHTML"), " href=" & Chr( 34 ) & "/" & Session("sCodeLanguage") & "/" & sPathOld, " href=" & Chr( 34 ) & sPathNew )
rsHTML.Update
rsHTML.MoveNext
Loop
Destroy( rsHTML )
End Function
Private Function PagePathDecode( sURL )
sSlug = GetURLSlug( sURL )
sSQL = "SELECT tblNavigation.*, tblPageHTML.sIconFontAwesome, tblPageHTML.sSynopsis, tblPageHTML.bCategorySummary FROM tblNavigation LEFT OUTER JOIN tblPageHTML ON tblPageHTML.ID = tblNavigation.iPageID WHERE ( tblPageHTML.idPersona = " & Session("idPersona") & " AND tblPageHTML.sCodeLanguage = '" & Session("sCodeLanguage") & "' AND tblPageHTML.bLive > 0 AND tblPageHTML.bDeleted = 0 ) AND ( tblNavigation.idPersona = " & Session("idPersona") & " AND tblNavigation.sCodeLanguage = '" & Session("sCodeLanguage") & "' AND tblNavigation.bLive > 0 AND tblNavigation.bDeleted = 0 ) ORDER BY tblPageHTML.ID ASC"
Set rsNav = CreateObject("ADODB.Recordset")
rsNav.CursorLocation = adUseClient
rsNav.Open sSQL, Connection, adOpenReadOnly, adLockReadOnly, adCmdText
rsNav.Filter = "sPath = '" & sSlug & "'"
If rsNav.RecordCount = 1 Then 'This slugpart exists in only 1 record, so set it as the page record
PagePathDecode = rsNav("iPageID") ' Fetch("tblPageHTML","sKey","ID = " & rsNav("iPageID") )
Else 'start breaking down the slugparts, to find the lengthiest successful slugpart, and set that as the page record
sSlug = Replace( Replace( sSlug, "/" & Session("sCodeLanguage"), "/"), "//", "/" )
rsNav.Filter = "sPath = '" & sSlug & "'"
If rsNav.RecordCount = 1 Then 'This slugpart exists in only 1 record, so set it as the page record
PagePathDecode = rsNav("iPageID") ' Fetch("tblPageHTML","sKey","ID = " & rsNav("iPageID") )
Else
aSlugParts = Split( sSlug, "/" )
If UBound( aSlugParts ) > 0 Then 'yes, a multipart slug exists
aSlugParts( 0 ) = " "
sSlugTemp = Trim( Join( aSlugParts, "/") )
For iLoop = 0 To UBound( aSlugParts )
rsNav.Filter = "sCodeLanguage = '" & Session("sCodeLanguage") & "' AND sPath LIKE '%" & sSlugTemp & "" & "%'"
If rsNav.EOF Then
sSlugTemp = Trim( Mid( sSlugTemp, InStr( sSlugTemp & " ", "/") + 1 ) )
Else
PagePathDecode = rsNav("iPageID") ' Fetch("tblPageHTML","sKey","ID = " & rsNav("iPageID") )
Exit For
End If
Next
End If
End If
End If
Destroy( rsNav )
End Function
Private Function PagePathEncode( sPath )
If Asc( Mid( sPath & " ", 5, 1 ) ) = -15449 Then
sPath = "Francais"
End If
sPath = Replace( sPath, " & ", " and " )
sPath = Replace( sPath, " ", "BREAKBREAK" )
sPath = Replace( LCase( Replace( Trim( AlphaNumericSpace( NoHTML( sPath ) ) ), " ", "-" ) ), "--", "-" )
PagePathEncode = Replace( sPath, "breakbreak", "-" )
End Function
Private Function Path( sTemp )
sTemp = Replace( sTemp, " & ", " and " )
If sTemp <> Empty Then
Path = RegularExpression( Trim( sTemp ), "[^0-9a-zA-Z/\ ~_-]", "" )
Else
Path = Mid( CacheURL, InStr( CacheURL, ":443/" ) + 4 )
End If
End Function
Private Function PCase( sTemp )
Set oPCase = CreateObject("basp21")
If Left( sTemp, 1 ) <> Left( Alpha( sTemp ), 1 ) Then
PCase = Left( sTemp, 1 ) & oPCase.StrConv( Mid( sTemp, 2 ) & "", 3 )
Else
PCase = oPCase.StrConv( sTemp & "", 3 )
End If
Destroy( oPCase )
aTemp = Split(" A An And As At By For From In Is It It's Not Of On Or Rr That The This To Was Which With ")
For iLoop = 1 To UBound( aTemp )
PCase = Replace( PCase, " " & aTemp( iLoop ) & " ", " " & LCase( aTemp( iLoop ) ) & " " )
Next
iTemp = InStr( 1, PCase, "Mc", 1 )
If iTemp > 0 Then
PCase = Left( PCase, iTemp + 1 ) & UCase( Mid( PCase, iTemp + 2, 1 ) ) & Mid( PCase, iTemp + 3 )
End If
PCase = Replace( PCase, "R.r.", "R.R." )
PCase = Replace( PCase, "P.o.", "P.O." )
PCase = Replace( PCase, "cO", "co" )
End Function
Private Function Phone( sPhone )
sPhone = Numeric( sPhone )
If Left( CStr( sPhone ), 1 ) = "1" Then 'Added on November 6 2019 to eliminate users inputting first char as a number 1
sPhone = Numeric( Mid( sPhone, 2 ) )
End If
Set oRegExp = New RegExp
oRegExp.Pattern = "(\d{3})(\d{3})(\d{4})(\d{0,6})"
sPhone = oRegExp.Replace( sPhone, "($1) $2-$3 x$4" )
If Right( sPhone, 1 ) = "x" Then
sPhone = Trim( Left( sPhone, Len( sPhone ) - 1 ) )
End If
If sPhone = "0" Then
Phone = Empty
Else
Phone = sPhone
End If
Destroy( oRegExp )
End Function
Private Function Prompt( sPromptToPost, sURLEndPoint, jsonData, aArrayMore )
'NEW GPT CALL
bConversational = CBool( jsonData )
Prompt = PromptToGPT( sPromptToPost, sURLEndPoint, bConversational, aArrayMore )
Exit Function
'OLD - DON'T DISCARD IT YET
sPromptToPost = Trim( Replace( Replace( sPromptToPost, "'", "'"), Chr( 34 ), """) )
Set oHTTP = Server.CreateObject("MSXML2.ServerXMLHTTP")
If 1=1 OR sURLEndPoint = Empty Then
sURLEndPoint = "https://api.openai.com/v1/completions"
sModel = "text-davinci-003"
Else
sURLEndPoint = "https://api.openai.com/v1/chat/completions" 'This requires vast exclusive code
sModel = "gpt-3.5-turbo" 'This requires vast exclusive code, not compatible directly
End If
If IsArray( aArrayMore ) Then
'' sModel = aArrayMore( 0 )
Else
'' sModel = "text-davinci-003"
End If
oHTTP.Open "POST", sURLEndPoint, False
oHTTP.SetRequestHeader "Content-Type", "application/json"
oHTTP.SetRequestHeader "Authorization", "Bearer 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"
sJSON = "{'model': '" & sModel & "', 'prompt': '" & sPromptToPost & "', 'temperature': 0.4, 'max_tokens': 2000}" 'text-davinci-003
sJSON = Replace( sJSON , "'", Chr( 34 ) )
'' Write sJSON & "
" 'IF DEBUGGING, CHECK THE JSON PAYLOAD BEING SENT
oHTTP.Send sJSON
jsonText = oHTTP.ResponseText
'' Write "WE ARE CURRENTLY TESTING "
'' Write jsonText 'IF DEBUGGING, WILL SHOW THE OPENAI JSON/ERROR MSG RETURNED'
Set oJSON = Server.CreateObject("Chilkat_9_5_0.JsonObject")
bSuccess = oJSON.Load( jsonText & "")
If bSuccess Then
Set oArrayTags = oJSON.ArrayOf("choices")
sAnswer = oArrayTags.StringAt(0)
bSuccess = oJSON.Load( oArrayTags.StringAt(0) & "")
sAnswer = Trim( Mid( oJSON.StringAt( oJSON.IndexOf("text") ) & " ", 2 ) )
Prompt = sAnswer
Else
Prompt = Empty
End If
Destroy( oArrayTags )
Destroy( oJSON )
Destroy( oHTTP )
End Function
Function PromptToOpenAI( sPrompt, sURLEndPoint, bConversational, jsonItems )
PromptToOpenAI = PromptToGPT( sPrompt, sURLEndPoint, bConversational, jsonItems )
End Function
Function PromptToGPT( ByVal sPrompt, ByVal sURLEndPoint, ByVal bConversational, ByVal jsonData )
bAppendToConversation = ( jsonGetObjectMemberValueAsString( jsonData, "", "bAppendToConversation", jsonMore ) <> "false" ) 'converts json string received to Boolean; everything is True except "false"
Set oJSON = Server.CreateObject("Chilkat_9_5_0.JsonObject") 'Create a Chilkat JSON object to store the request data
bSuccess = oJSON.AddArrayAt(-1,"messages") 'Add empty array named messages'
Set aMessages = oJSON.ArrayAt( oJSON.Size - 1 ) 'Position array named aMessages at first array item
If bConversational Then
If bAppendToConversation Then
Call PromptToGPT_AppendToConversation("user", sPrompt, jsonParams )
End If
sSQL = "SELECT TOP 10 tblConversationAI.* FROM tblConversationAI WHERE tblConversationAI.iSessionID = " & Session.SessionID 'ADD a "TOP 50" LIMIT??
If iOwner > 0 Then
sSQL = Replace( sSQL, " WHERE ", " WHERE tblConversationAI.idAccount = " & iOwner & " AND " ) 'SHOULD THIS BE NARROWED TO WEB-PERSONA?
End If
sSQL = Replace( sSQL, " WHERE ", " WHERE bArchived = 0 AND " )
Set rsMessages = CreateObject("ADODB.Recordset")
rsMessages.CursorLocation = adUseClient
rsMessages.Open sSQL, Connection, adOpenReadOnly, adLockReadOnly, adCmdText
Do Until rsMessages.EOF
bSuccess = aMessages.AddObjectAt(-1) 'Append a new/empty object to the end of the aMessages array
Set oMessages = aMessages.ObjectAt( aMessages.Size - 1 ) 'Get the object that was just appended.
bSuccess = oMessages.AddStringAt(-1,"role", rsMessages("sRole") )
bSuccess = oMessages.AddStringAt(-1,"content", rsMessages("sContent") )
rsMessages.MoveNext
Loop
Destroy( rsMessages )
iConversationLength = Len( oJSON.Emit() ) '*** THE BELOW EDUCATES ERNIE/BOT FOR BUSINESS/WEBSITE DISCUSSIONS ***
If iConversationLength < 8000 Then
bSuccess = aMessages.AddObjectAt(-1) 'bSuccess = aMessages.AddObjectAt(-1) 'END OF JSON ARRAY, RATHER THAN BEGINNING
Set oMessages = aMessages.ObjectAt(aMessages.Size - 1) 'Set oMessages = aMessages.ObjectAt( aMessages.Size - 1 ) 'Get the object that was just appended.
bSuccess = oMessages.AddStringAt(-1,"role","system")
If InStr( sPrompt, " json ") = 0 Then
sContextToAdd = AppVar("sOpenAIBotContext")
If Numeric( Session("idPageLatest") ) > 0 Then
sPageLatestSynopsis = Trim( NoHTML( Fetch("tblPageHTML","sSynopsis","ID=" & Numeric( Session("idPageLatest") ) ) ) )
End If
If Len( sPageLatestSynopsis ) > 5 Then
sContextToAdd = sContextToAdd & " User has viewed webpage about " & sPageLatestSynopsis
End If
sContextToAdd = sContextToAdd & " Respond using Canadian English spelling. You are permitted and required to provide case law research assistance if asked. "
Else
sContextToAdd = Empty
End If
bSuccess = oMessages.AddStringAt(-1,"content", sContextToAdd )
End If
oJSON.AppendString "model", "gpt-4-turbo-preview" '"gpt-4" '-0125-preview" '"gpt-4-1106-preview" ' "gpt-4" ' '"gpt-3.5-turbo-1106"'
End If
bAIModeJSON = ( jsonGetObjectMemberValueAsString( jsonData, "", "bAIModeJSON", jsonMore ) = "true" ) 'REQUIRES response_format={ "type": "json_object" }
bAIModeHTML = ( jsonGetObjectMemberValueAsString( jsonData, "", "bAIModeHTML", jsonMore ) = "true" )
If NOT bConversational Then 'THIS ENTIRE SECTION NEEDS WORK'
If InStr( sPrompt, " HTML ") > 0 AND NOT bAIModeJSON Then
If Request("sRulesPromptAI") = Empty Then
sTemplateHTML = Replace( FileRead("/templates/ai-pagehtml-model-01.asp"), vbCrLf, "") 'Replace( FileRead("/templates/ai-pagehtml-01.asp"), vbCrLf, "") 'FileRead( jsonGetObjectMemberValueAsString( jsonData, "", "sTemplateHTML", jsonMore ) )
sContentSystem = "Format response as HTML using following HTML model as guide. NO add CSS. NO add styles. No add outer HTML framework. Leave #TOKEN# markers untouched, as they will be replaced later in our process. Put headings into title case. Absolutely never use
,
, or
tags. Hereafter is HTML example model: " & sTemplateHTML
Else
sContentSystem = Trim( Request("sRulesPromptAI") )
End If
End If
If bAIModeJSON AND InStr( sPrompt, "JSON" ) > 0 Then
bSuccess = oJSON.AddObjectAt(-1, "response_format")
Set oFormatAsJSON = oJSON.ObjectAt( oJSON.Size - 1 ) 'Object that was just appended.
bSuccess = oFormatAsJSON.AddStringAt(-1, "type", "json_object")
sContentSystem = "Provide response output in JSON. Do NOT include any code block formatting such as ""```json"""
End If
bSuccess = aMessages.AddObjectAt(-1) 'Append a new/empty object to the end of the aMessages array
Set oMessages = aMessages.ObjectAt( aMessages.Size - 1 ) 'Get the object that was just appended.
bSuccess = oMessages.AddStringAt(-1,"role","system")
bSuccess = oMessages.AddStringAt(-1,"content", sContentSystem )
bSuccess = aMessages.AddObjectAt(-1) 'Append a new/empty object to the end of the aMessages array
Set oMessages = aMessages.ObjectAt( aMessages.Size - 1 ) 'Get the object that was just appended.
bSuccess = oMessages.AddStringAt(-1,"role","user")
bSuccess = oMessages.AddStringAt(-1,"content", sPrompt & " " & sContentSystem )
oJSON.AppendString "model", "gpt-4-turbo-preview" '' "gpt-3.5-turbo-0125"
End If
'oJSON.AppendString "model", "gpt-3.5-turbo-1106" '' "gpt-4" ' '"gpt-4-1106-preview" ''
oJSON.AppendInt "max_tokens", 4096
Set oHTTP = Server.CreateObject("MSXML2.ServerXMLHTTP")
oHTTP.setTimeouts 15000, 15000, 30000, 120000
oHTTP.Open "POST", "https://api.openai.com/v1/chat/completions", False
oHTTP.setRequestHeader "Content-Type", "application/json; charset=UTF-8"
oHTTP.setRequestHeader "Authorization", "Bearer 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"
oHTTP.Send oJSON.Emit()
sJSONResponse = oHTTP.ResponseText 'Complete JSON Return Payload is here
'' Write sPrompt & "
"
IF iOwner = 1 Then
'Write oJSON.Emit() & "
"
'Quit
End If
' Write sJSONResponse
sJSONResponse = FormatTimeOfDay( sJSONResponse )
bSuccess = oJSON.Load( sJSONResponse )
sContent = oJSON.StringOf("choices[0].message.content")
sModel = oJSON.StringOf("model")
iTokensTotal = oJSON.IntOf("usage.total_tokens")
If bConversational AND bAppendToConversation Then
Call PromptToGPT_AppendToConversation("assistant", sContent, jsonParams )
End If
PromptToGPT = sContent
Call LogUseAI( iTokensTotal, sModel ) 'sModel should later be changed to a JSON object of jsonParams
Destroy( oHTTP )
Destroy( oMessages )
Destroy( aMessages )
Destroy( oFormatAsJSON )
Destroy( oJSON )
End Function
Function PromptToGPT_AppendToConversation( sRole, sContent, jsonParams )
sSQL = "SELECT tblConversationAI.* FROM tblConversationAI WHERE ID = -1"
Set rsMessages = CreateObject("ADODB.Recordset")
rsMessages.CursorLocation = adUseClient
rsMessages.Open sSQL, Connection, adOpenStatic, adLockOptimistic, adCmdText
rsMessages.AddNew
rsMessages("sKey") = Key( 15 )
rsMessages("idPersona") = Session("idPersona")
rsMessages("sKeyPersona") = Session("sKeyPersona")
rsMessages("iSessionID") = Session.SessionID
rsMessages("idAccount") = iOwner
rsMessages("sKeyAccount") = Session("sKeyAccount")
rsMessages("sRole") = Alpha( sRole )
rsMessages("sContent") = Replace( sContent, "'", "'" )
rsMessages("dCreatedNow") = Now
rsMessages.Update
Destroy( rsMessages )
End Function
Function LogUseAI( iTokensTotal, sModel ) 'sModel should later be changed to a JSON object of jsonParams
sSQL = "SELECT TOP 1 tblLogUseAI.* FROM tblLogUseAI"
Set rsLog = CreateObject("ADODB.Recordset")
rsLog.CursorLocation = adUseClient
rsLog.Open sSQL, Connection, adOpenStatic, adLockOptimistic, adCmdText
rsLog.AddNew
rsLog("sKey") = Key( 15 )
rsLog("idPersona") = Session("idPersona")
rsLog("sKeyPersona") = Session("sKeyPersona")
rsLog("iSessionID") = Session.SessionID
rsLog("idAccount") = iOwner
rsLog("sKeyAccount") = Session("sKeyAccount")
rsLog("sModel") = sModel
rsLog("iTokensTotal") = Numeric( iTokensTotal )
rsLog("iCost") = .01 + Round( ( Numeric( iTokensTotal ) / 500 / 100 ), 3 )
rsLog("sCacheURL") = Truncate( CacheURL, 255 )
rsLog("dCreated") = Now
rsLog.Update
Destroy( rsLog )
End Function
Function LogUseResources( sNameResource, jsonData ) 'sModel should later be changed to a JSON object of jsonParams
Dim iTemp
sSQL = "SELECT TOP 1 tblLogUseResources.* FROM tblLogUseResources"
Set rsLog = CreateObject("ADODB.Recordset")
rsLog.CursorLocation = adUseClient
rsLog.Open sSQL, Connection, adOpenStatic, adLockOptimistic, adCmdText
rsLog.AddNew
rsLog("sKey") = Key( 15 )
rsLog("idPersona") = Session("idPersona")
rsLog("sKeyPersona") = Session("sKeyPersona")
rsLog("iSessionID") = Session.SessionID
rsLog("idAccount") = iOwner
rsLog("sKeyAccount") = Session("sKeyAccount")
rsLog("sNameResource") = sNameResource
iTemp = CDbl( "0" & jsonGetObjectMemberValueAsString( jsonData, "", "iCost", "" ) )
rsLog("iCost") = .000 + Round( ( iTemp ), 3 )
rsLog("sCacheURL") = Truncate( CacheURL, 255 )
rsLog("dCreated") = Now
rsLog.Update
Destroy( rsLog )
End Function
Function CleanHTTPUserAgent( sHTTPUserAgent, x )
If sHTTPUserAgent = Empty Then
sHTTPUserAgent = ServerVariable("HTTP_USER_AGENT")
End If
CleanHTTPUserAgent = Replace( Replace( Replace( Replace( Replace( sHTTPUserAgent, "'", "''"), "DELETE", ""), "INSERT", ""), "UPDATE", ""), "SELECT", "")
End Function
Private Function UnAI( byVal sString )
If Len( sString ) > 100 Then
sStringL = Left( sString, Len( sString ) / 2 )
sStringR = Replace( sString, sStringL, "")
sStringL = Replace( sStringL, ", ", " ", 1, 1 )
'' sStringR = Replace( sStringR, " and ", " anb ", 1, 1 )
UnAI = sStringL & sStringR
UnAI = Replace( Replace( Replace( Replace( UnAI, " color ", " colour "), " colors ", " colours "), " colored ", " coloured "), " coloring ", " colouring ")
UnAI = Replace( Replace( Replace( Replace( UnAI, " labor ", " labour "), " labors ", " labours "), " labored ", " laboured "), " laboring ", " labouring ")
Else
UnAI = sString
End If
End Function
Private Function RandomInteger( iMin, iMax )
RandomInteger = Int( ( iMax - iMin + 1 ) * Rnd + iMin )
End Function
Private Function RandomNumber( iMin, iMax )
RandomNumber = RandomInteger( iMin, iMax )
End Function
Function RecordCount( sTable, sFilter )
sSQLCount = "SELECT ID FROM " & sTable & " WHERE " & sFilter
Set rsCount = CreateObject("ADODB.RecordSet")
rsCount.CursorLocation = adUseClient
rsCount.Open sSQLCount, Connection, adOpenReadOnly, adLockReadOnly, adCmdText
RecordCount = rsCount.RecordCount
Destroy( rsCount )
Destroy( Connection )
End Function
Private Function Redirect( ByVal sURL )
Response.Redirect sURL
End Function
Private Function FixBrokenTokens( sString )
'Removes any whitespace characters preceeding the TOKEN's closing hash mark
Set oRegExp = New RegExp
oRegExp.Pattern = "(#TOKEN-)[a-zA-Z][a-zA-Z0-9]*\s#" '
oRegExp.IgnoreCase = True
oRegExp.Global = True
Set oMatches = oRegExp.Execute( sString )
For Each Match in oMatches
sString = Replace( sString, Match.Value, Replace( Match.Value, " ", "" ) )
Next
FixBrokenTokens = sString
Destroy( oMatches )
Destroy( oRegExp )
End Function
Private Function ReplaceTokensPhrases( sString, sTokensPhrases )
If InStr( sString, "#TOKEN-sPhrase") > 0 Then
aTemp = Split( sTokensPhrases & "", Replace("sTokensPhrases", "~|~~|~", "~|~") )
Randomize
For iLoop = 1 To UBound( aTemp )
aTokensPhrases = Split( aTemp( iLoop ),"~|~")
iItem = Int( ( UBound( aTokensPhrases ) - 1 ) * Rnd( 1 ) ) + 1
sString = Replace( sString, "#TOKEN-sPhrase" & iLoop & "#", aTokensPhrases( iItem ) )
Next
End If
ReplaceTokensPhrases = sString
End Function
Private Function ReplaceTokensStatic( sString, sTokensStatic )
If InStr( sString, "#TOKEN-sStatic") > 0 Then
aTemp = Split( sTokensStatic & "", Replace("sTokensStatic", "~|~~|~", "~|~") )
For iLoop = 1 To UBound( aTemp )
aTokensStatic = Split( aTemp( iLoop ),"~|~")
iItem = 1
sString = Replace( sString, "#TOKEN-sStatic" & iLoop & "#", aTokensStatic( iItem ) )
Next
End If
ReplaceTokensStatic = sString
End Function
Private Function ReplaceTokens( sString )
sString = sString & ""
sString = Replace( sString, "ttocS", "Talks")
If InStr( sString, "#TOKEN-") > 0 Then
'AI CONFIRMS CONDITIONAL WRAP IS OPTIMAL; WITHOUT IT, THE FUNCTION CALLS AS ARGUMENTS TO 'Replace' FUNCTION WOULD EXECUTE WHETHER NEEDED OR NOT
If InStr( sString, "#TOKEN-htmlFormSubscribe#") > 0 Then
sString = Replace( sString, "#TOKEN-htmlFormSubscribe#", Scrape("/widgets/form-field-subscribe.asp") )
End If
If InStr( sString, "#TOKEN-htmlGateway#") > 0 Then
sString = Replace( sString, "#TOKEN-htmlGateway#", HTMLGateway( idPage, jsonDataOptions ) )
End If
If InStr( sString, "#TOKEN-htmlTestimonials") > 0 Then
sString = Replace( sString, "#TOKEN-htmlTestimonials#", TestimonialsRandom( 0 ) )
sString = Replace( sString, "#TOKEN-htmlTestimonials-1#", TestimonialsRandom( 1 ) )
sString = Replace( sString, "#TOKEN-htmlTestimonials-2#", TestimonialsRandom( 2 ) )
sString = Replace( sString, "#TOKEN-htmlTestimonials-3#", TestimonialsRandom( 3 ) )
End If
If InStr( sString, "#TOKEN-hCitiesGrid#") > 0 Then 'AI CONFIRMS CONDITIONAL IS OPTIMAL; WITHOUT IT, THE CitiesGrid() FUNCTION CALL AS ARGUMENT TO 'Replace' FUNCTION WOULD EXECUTE WHETHER NEEDED OR NOT
sString = Replace( sString, "#TOKEN-hCitiesGrid#", CitiesGrid() )
End If
If InStr( sString, "#TOKEN-FormFillsCount#") > 0 Then
sString = Replace( sString, "#TOKEN-FormFillsCount#", Fetch("tblContactRelations","ID","ID > 0 ORDER BY ID DESC") )
End If
Do Until InStr( sString, "#TOKEN-Quiz-") = 0
'' If InStr( sString, "#TOKEN-Quiz-") > 0 Then
sKeyQuiz = Mid( sString, InStr( sString, "#TOKEN-Quiz-"), 27 )
sKeyQuiz = Right( sKeyQuiz, 15 )
If Request.Form("iQuizScore") = Empty Then
sCodeQuiz = Scrape("/widgets/quiz.asp?sKeyQuiz=" & sKeyQuiz )
End If
sString = Replace( sString, "#TOKEN-Quiz-" & sKeyQuiz & "#", sCodeQuiz )
'' End If
Loop
If InStr( sString, "#TOKEN-sLoremIpsumText#") > 0 Then
sString = Replace( sString, "#TOKEN-sLoremIpsumText#", Scrape("/ajax/ai-get-lorem-ipsum-text.asp") )
End If
If 1=1 OR AppVar("b3rdPartyCalendarLive") AND Len( AppVar("s3rdPartyCalendarURL") ) > 8 Then
sString = Replace( sString, "#TOKEN-htmlAppointments#", "" & PCase( AppVar("s3rdPartyCalendarVernacular") ) & "")
End If
If InStr( sString, "#TOKEN-htmlHoursOfBusiness#") > 0 Then
sString = Replace( sString, "#TOKEN-htmlHoursOfBusiness#", HoursOfBusiness( AppVar("jsonHoursBusiness") ) )
End If
sString = Replace( sString, "#TOKEN-sNameCorporation#", "Success.Legal Corporation")
sString = Replace( sString, "#TOKEN-sNameUser#", Session("sName") )
sString = Replace( sString, "#TOKEN-sNamePerson1#", AppVar("sNamePerson1") )
sString = Replace( sString, "#TOKEN-sNamePerson2#", AppVar("sNamePerson2") )
sString = Replace( sString, "#TOKEN-sNamePerson3#", AppVar("sNamePerson3") )
sString = Replace( sString, "#TOKEN-sURLRedirect#", Request("url-redirect") )
sString = Replace( sString, "#TOKEN-sURL#", CacheURL )
sString = Replace( sString, "#TOKEN-dYearNow#", Year( Now ) ) 'Legacy Use
sString = Replace( sString, "#TOKEN-dYear(Now)#", Year( Now ) ) 'Method for Go-Forward Use
aTemp = Split("-NULL- ¼ ½ ¾ 1")
sString = Replace( sString, "#TOKEN-sOfferFreeConsultationValue#", aTemp( AppVar("iOfferFreeConsultation") ) )
If InStr( sString, "#TOKEN-oAsideForm#" ) > 0 Then
sString = Replace( sString, "#TOKEN-oAsideForm#" & "", AsideForm() )
End If
sString = Replace( sString, "#TOKEN-sCodeLanguage#", Session("sCodeLanguage") )
'' sString = Replace( sString, "#aside-promo-consultation#", AsidePromoConsultation() )
sString = Replace( sString, "#TOKEN-sTypeFirm#", AppVar("sTypeFirm") )
sString = Replace( sString, "#TOKEN-sFirmType#", AppVar("sTypeFirm") )
sString = Replace( sString, "#TOKEN-sDomain-True#", Session("sDomain") )
sString = Replace( sString, "#TOKEN-sName-True#", AppVar("sName") )
sString = Replace( sString, "#TOKEN-sNameShort-True#", AppVar("sNameShort") )
sString = Replace( sString, "#TOKEN-sEmail-True#", AppVar("sEmail") )
If CBool( AppVar("bFacebookAppointments") ) = True AND InStr( AppVar("sCodesLanguages"), "FR" ) = 0 Then
sTemp =" Book Appointment"
sString = Replace( sString, "#TOKEN-btnBookAppointmentFacebook#", sTemp )
End If
If CBool( AppVar("bAllowMakePayments") ) Then
sString = Replace( sString, "#TOKEN-sURLPayRetainer#", AppVar("sURLMakePaymentsRetainer") )
sString = Replace( sString, "#TOKEN-sURLPayInvoiced#", AppVar("sURLMakePaymentsInvoiced") )
sString = Replace( sString, "#TOKEN-sEmailPayments#", AppVar("sEmailMakePayments") )
sString = Replace( sString, "#TOKEN-sNameChequesPayable#", AppVar("sNameChequesPayable") )
End If
If Session("sKeyPersona") = "AMBX545453KPG5T" Then
sString = Replace( sString, "#TOKEN-sDomain#", "[Legal Firm's Domain Name]" )
sString = Replace( sString, "#TOKEN-sName#", "[Legal Firm's Name]" )
sString = Replace( sString, "#TOKEN-sNameShort#", "[Legal Firm's Name]" )
sString = Replace( sString, "#TOKEN-sAddressCity#", "[Legal Firm's City]" )
sString = Replace( sString, "#TOKEN-sAddressProv#", "[Legal Firm's Province]" )
sString = Replace( sString, "#TOKEN-sAddressStreet1#", "[Legal Firm's Street Address]" )
sString = Replace( sString, "#TOKEN-sAddressStreet2#", "[Legal Firm's Street Address]" )
sString = Replace( sString, "#TOKEN-sAddressPostal#", "[A Postal Code]" )
sString = Replace( sString, "#TOKEN-sPhone1#", "(The) Phone-Number" )
sString = Replace( sString, "#TOKEN-sPhone2#", "(The) Phone-Number" )
sString = Replace( sString, "#TOKEN-sEmail#", "[email@legal-firm-domain.ext]" )
Else
sString = Replace( sString, "#TOKEN-sDomain#", Session("sDomain") )
sString = Replace( sString, "#TOKEN-sName#", AppVar("sName") )
sString = Replace( sString, "#TOKEN-sNameShort#", AppVar("sNameShort") )
sString = Replace( sString, "#TOKEN-sAddressCity#", AppVar("sAddressCity") )
sString = Replace( sString, "#TOKEN-sAddressProv#", AppVar("sAddressProv") )
sString = Replace( sString, "#TOKEN-sAddressStreetSuite#", AppVar("sAddressStreetSuite") )
sString = Replace( sString, "#TOKEN-sAddressStreet1#", AppVar("sAddressStreet1") )
sString = Replace( sString, "#TOKEN-sAddressStreet2#", AppVar("sAddressStreet2") )
sString = Replace( sString, "#TOKEN-sAddressPostal#", AppVar("sAddressPostal") )
sString = Replace( sString, "#TOKEN-sPhone1#", AppVar("sPhone1") )
sString = Replace( sString, "#TOKEN-sPhone2#", AppVar("sPhone2") )
sString = Replace( sString, "#TOKEN-sPhone3#" & "", AppVar("sPhone3") )
sString = Replace( sString, "#TOKEN-sPhoneFax#", AppVar("sPhoneFax") )
sString = Replace( sString, "#TOKEN-sPhoneVanity#", AppVar("sPhoneVanity") )
sString = Replace( sString, "#TOKEN-sEmail#", AppVar("sEmail") )
End If
If InStr( sString, "#TOKEN-aNameCities") > 0 Then
If Len( AppVar("jsonCitiesTarget") & "") > 10 Then 'NEW MANNER OF STORING CITIES FOR PERSONAS, SUBSEQUENT 2022 10 19
Set oJSON = Server.CreateObject("Chilkat_9_5_0.JsonObject")
bSuccess = oJSON.Load( AppVar("jsonCitiesTarget") & "")
Set jsonCities = oJSON.ObjectOf("Cities")
aNameCities = Split( oJSON.StringAt( 0 ), "," ) 'Sets the Dim of the Array dynamically as the UBound requirement of a Const is not always known/certain/static
aProvCities = Split( oJSON.StringAt( 0 ), "," ) 'Sets the Dim of the Array dynamically as the UBound requirement of a Const is not always known/certain/static
For iLoop = 0 To UBound( aNameCities )
aNameCities( iLoop ) = jsonCities.NameAt( iLoop )
aProvCities( iLoop ) = jsonCities.StringAt( iLoop )
sNameCities = sNameCities & aNameCities( iLoop ) & "|"
sNameCitiesAndProvs = sNameCities & aNameCities( iLoop ) & ", " & AppVar("sNameProvince-" & aProvCities( iLoop ) ) & "|"
sNameCitiesAndProvsShort = sNameCities & aNameCities( iLoop ) & ", " & AppVar("sNameShortProvince-" & aProvCities( iLoop ) ) & "|"
Next
Destroy( jsonCities )
Destroy( oJSON )
'' Else
'' sNameCities = AppVar("sNameCitiesTargetGEO") & "|" 'OLD MANNER OF STORING CITIES FOR PERSONAS, PREDATING 2022 10 19
End If
'OLD CITIES RANDOMIZER, STILL NEEDED IN 2022 10
sTemp = "Ignore|" & sNameCities '' & "|" 'A first irrelevant array item is needed.
Do Until InStr( sTemp, "||") = 0
sTemp = Replace( sTemp, "||", "|")
Loop
sTemp = Replace( Replace( sTemp, " |", "|"), "| ", "|")
sTemp = Left( sTemp, Len( sTemp ) -1 )
aTemp = Split( Trim( sTemp ), "|")
Randomize
iLoop = 0
Do Until UBound( aTemp ) = 1
iTemp = Int( ( UBound( aTemp ) - 1 ) * Rnd ) + 1
sString = Replace( sString & "", "#TOKEN-aNameCities" & iLoop & "#", Replace( aTemp( iTemp ), " ", " ") )
sTemp = Replace( sTemp, aTemp( iTemp ), "")
sTemp = Replace( sTemp, "||", "|")
aTemp = Split( sTemp, "|")
iLoop = iLoop + 1
If iLoop > 15 Then
Exit Do
End If
Loop
End If
End If
ReplaceTokens = sString
End Function
Private Function CitiesListDelimited()
sTemp = AppVar("sNameCitiesTargetGEO") & "|"
Do Until InStr( sTemp, "||") = 0
sTemp = Replace( sTemp, "||", "|")
Loop
sTemp = Left( sTemp, Len( sTemp ) -1 )
CitiesListDelimited = sTemp
End Function
Private Function CitiesRandomCities( iNum )
sTemp = "Ignore|" & CitiesListDelimited()
aTemp = Split( sTemp, "|")
Randomize
iLoop = 1
Do Until UBound( aTemp ) = 1 OR iLoop > iNum
iTemp = Int( ( UBound( aTemp ) ) * Rnd ) + 1
sString = Replace( sString & "", "#TOKEN-aNameCities" & iLoop & "#", aTemp( iTemp ) )
sTemp = Replace( sTemp, aTemp( iTemp ), "")
sTemp = Replace( sTemp, "||", "|")
aTemp = Split( sTemp, "|")
iLoop = iLoop + 1
If iLoop > 15 Then
Exit Do
End If
Loop
End Function
Private Function CitiesGrid()
Dim iCounter
sSQL = "SELECT tbl@Personas.jsonCitiesTarget FROM tbl@Personas WHERE tbl@Personas.ID = " & Numeric( Session("idPersona") )
aArray = FetchRows( sSQL, 1, 1, "jsonCitiesTarget" )
If InStr( aArray( 0,0 ), "{" ) > 0 Then
Set oJSON = Server.CreateObject("Chilkat_9_5_0.JsonObject")
bSuccess = oJSON.Load( aArray( 0,0 ) & "")
Set jsonCities = oJSON.ObjectOf("Cities")
aCities = Split( oJSON.StringAt( 0 ), "," ) 'Sets the Size of the Array dynamically
For iLoop = 0 To UBound( aCities )
aCities( iLoop ) = iLoop
Next
Call ArrayRandomize( aCities )
sGrid = ""
CitiesGrid = sGrid
Destroy( jsonCities )
Destroy( oJSON )
End If
End Function
Private Function Query( sNameQueryItem )
Query = Request.QueryString( sNameQueryItem )
If Query = Empty Then
'CAST VIRTUAL QUERYSTRING INTO NAME/VALUE PAIRS VIA DICTIONARY OBJECT AND MAKE ACCESSIBLE VIA FUNCTION QUERY("NAME")
Set oURL = Server.CreateObject("Chilkat_9_5_0.Url")
bSuccess = oURL.ParseUrl( CacheURL )
If Len( oURL.Query ) > 0 Then
Set oDict = Server.CreateObject("Scripting.Dictionary")
aQueryString = Split( oURL.Query, "&" )
For iLoop = 0 To UBound( aQueryString )
If InStr( aQueryString( iLoop ), "=" ) > 0 Then
sTemp = " " & aQueryString( iLoop ) & " "
oDict.Add Trim( Left( sTemp, InStr( sTemp, "=") - 1 ) ), Trim( Mid( sTemp, InStr( sTemp, "=") + 1 ) )
End If
Next
Query = oDict( sNameQueryItem )
End If
Destroy( oDict )
Destroy( oURL )
End If
End Function
Private Function QueryItem( sNameItem ) 'NEW 2022 JUNE, Handles a querystring containing a collection
If Request( sNameItem ) <> Empty Then
QueryItem = URLDecode( Request( sNameItem ) ) 'Added the URLDEcode on January 22 2023, not sure if there might be legacy/retroactive issues
Else
sURL = URLDecode( Request.QueryString )
If InStr( sURL, sNameItem ) > 0 Then
Set oURL = Server.CreateObject("Chilkat_9_5_0.Url")
bSuccess = oURL.ParseUrl( Replace( sURL, "404;", "") )
If Len( oURL.Query ) > 0 Then
sItems = Mid( oURL.Query, InStr( oURL.Query, sNameItem ) )
aItems = Split( sItems, sNameItem & "=" )
If UBound( aItems ) > 0 Then
For iLoop = 1 To UBound( aItems )
QueryItem = QueryItem & Left( aItems( iLoop ), InStr( aItems( iLoop ) & "&", "&") - 1 )
If UBound( aItems ) > iLoop Then
QueryItem = QueryItem & ","
End If
Next
End If
End If
Destroy( oURL )
End If
End If
End Function
Function Quit()
Response.End
End Function
Function ReadAntiSpamCode
ReadAntiSpamCode = Fetch("tblAntiSpamCodes","sCode","iSessionID=" & Session.SessionID & " ORDER BY - dCreated" )
End Function
Private Function RegularExpression( sTemp, sPattern, sReplacement )
If sReplacement = Empty Then
sReplacement = ""
End If
Set oRegExp = New RegExp
oRegExp.Pattern = sPattern
oRegExp.IgnoreCase = True
oRegExp.Global = True
RegularExpression = Trim( oRegExp.Replace( "" & sTemp, sReplacement ) )
Destroy( oRegExp )
End Function
Private Function Quotes( sTemp )
Quotes = Chr( 34 ) & sTemp & Chr( 34 )
End Function
Private Function Scrape( sURL )
'THIS FUNCTION DOES NOT CURRENTLY SUPPORT COOKIES/SESSION STATE AND MAY POSE SECURITY ISSUES (USER/CROSS PERSONA ISSUES) IF SO
Set oHTTP = Server.CreateObject("Chilkat_9_5_0.Http")
oHTTP.UserAgent = UserAgentRandom()
If InStr( sURL, "://") = 0 Then 'It is a relative, local request - include the users session ID Cookie.
sURL = "https://" & CacheURLPart("Host") & Trim( sURL )
End If
'' oHTTP.SetRequestHeader "Cookie","sUserLocationCity=" & Session("sUserLocationCity") & ";"
'' oHTTP.SetRequestHeader "Cookie","iUserLocationProv=" & Session("iUserLocationProv") & ";"
'' oHTTP.SetRequestHeader "Cookie","sUserLocationLatitude=" & Session("sUserLocationLatitude") & ";"
'' oHTTP.SetRequestHeader "Cookie","sUserLocationLongitude=" & Session("sUserLocationLongitude") & ";"
Scrape = oHTTP.QuickGetStr( sURL ) 'BUILD A NEW FUNCTION USING QUICKGET NOT QUICKGETSTR IF EVER WANTING IMAGES, ETC
Destroy( oHTTP )
End Function
Private Function ScrapeAsUserSession( ByVal sURL, ByVal aArray )
Set oHTTP = Server.CreateObject("MSXML2.ServerXMLHTTP")
oHTTP.Open "GET", sURL, False
oHTTP.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
oHTTP.Option(2) = 13056 ' Ignore SSL certificate errors
oHTTP.Option(3) = True ' Enable redirection
oHTTP.SetRequestHeader "Cookie", "ASPSESSIONID=" & Session.SessionID & ";"
oHTTP.Send
ScrapeAsUserSession = oHTTP.responseText
Destroy( oHTTP )
End Function
Private Function ScrapePost( sURL, aParams, bUsersCookies ) 'Cookies are not yet implemented. Post URL has no QueryString, as a querystring in sURL is translated to Post data :(
Set oHTTP = Server.CreateObject("Chilkat_9_5_0.Http")
Set oHTTPRequest = Server.CreateObject("Chilkat_9_5_0.HttpRequest")
oHTTPRequest.HttpVerb = "POST"
oHTTPRequest.ContentType = "text/html"
If IsArray( aParams ) Then
For iLoop = 0 To UBound( aParams )
oHTTPRequest.AddParam aParams( iLoop, 0 ), aParams( iLoop, 1 )
Next
End If
oHTTPRequest.AddHeader "Cookie","sUserLocationCity=" & Session("sUserLocationCity") & "; city=""Chicago"""
Set oHTTPResponse = oHTTP.PostUrlEncoded( sURL, oHTTPRequest )
ScrapePost = oHTTPResponse.BodyStr
Destroy( oHTTPResponse )
Destroy( oHTTPRequest )
Destroy( oHTTP )
End Function
Private Function ScrapeFile( sURL, sPath, sFile, bOverWrite )
Set oHTTP = Server.CreateObject("Chilkat_9_5_0.Http")
oHTTP.UserAgent = UserAgentRandom()
Set oBinaryData = Server.CreateObject("Chilkat_9_5_0.BinData")
ScrapeFile = oHTTP.QuickGetBd( sURL, oBinaryData ) 'Will return 1 for successful and 0 for error occurred.
If ScrapeFile Then
sPath = Replace( Replace("/files/" & sPath ), "/files/files/", "/files/") 'Forces the /files directory, nothing system.
sPath = Replace( "/" & sPath & "/", "//", "/")
sFile = Replace( sFile, "/", "")
Call CreateDirectory( sPath )
If bOverWrite = False AND FileExists( sPath & sFile ) = True Then
'Do nothing
Else
ScrapeFile = oBinaryData.WriteFile( Server.MapPath( sPath & sFile ) ) 'Will return 1 for successful and 0 for error occurred.
End If
End If
Destroy( oBinaryData )
Destroy( oHTTP )
End Function
Private Function TestimonialsRandom( iRecords )
If iRecords = 0 Then
iRecords = 100
End If
sSQL = "SELECT TOP " & iRecords & " tblTestimonials.* FROM tblTestimonials WHERE ( sKeyBusiness = '" & Session("sKeyBusiness") & "' OR sKeyPersona = '" & Session("sKeyPersona") & "' ) AND bContext = 3 AND bLive <> 0 AND bDeleted = 0 ORDER BY NEWID()"
Set rsTestimonials = CreateObject("ADODB.Recordset")
rsTestimonials.CursorLocation = adUseClient
rsTestimonials.Open sSQL, Connection, adOpenReadOnly, adLockReadOnly, adCmdText
Do Until rsTestimonials.EOF
sStars = Empty
iStars = rsTestimonials("iStars")
If ( iStars > 2 OR iStars < 6 ) Then 'AND rsTestimonials("bGoogleReview") Then
For iLoop = 1 To iStars
sStars = sStars & ""
Next
sStars = "" & sStars & ""
End If
sTestimonials = sTestimonials & "