<% Dim strZZSYSMGR_1,strZZSYSMGR_2, strZZSYSMGR_3, strZZSYSMGR_4, strZZSYSMGR_5, strZZSYSMGR_6, strZZSYSMGR_7, strZZSYSMGR_8 ' This page is called in every page to keep the session cookies used "fresh" Server.ScriptTimeout = 30 ' If they haven't logged in yet, then there will only be the TRAINERID cookie set ' if Request.Cookies("linktext") <> "" Then ' trainerID = Request.Cookies("linktext") ' Else ' trainerID = Request.Cookies("trainerID") ' End If ' trainerPathZZSYSMGR = "/members/" & trainerID & "/trainerDB.mdb" ' ConnectStringTrainerZZSYSMGR = "Provider=Microsoft.Ace.OLEDB.12.0;Data Source=" & Server.MapPath(trainerPathZZSYSMGR) ' Set connTrainerZZSYSMGR = Server.CreateObject("ADODB.Connection") ' connTrainerZZSYSMGR.open ConnectStringTrainerZZSYSMGR ' Now run through all cookies and "refresh" them. Right now this is simply ' loading up each cookie in a temp variable and then reloading it. strZZSYSMGR_1 = request.cookies("trainerID") strZZSYSMGR_2 = request.cookies("trainerdir") strZZSYSMGR_3 = request.cookies("username") strZZSYSMGR_4 = request.cookies("TFLevel") strZZSYSMGR_5 = request.cookies("linktext") strZZSYSMGR_6 = request.cookies("userclass") strZZSYSMGR_7 = request.cookies("traineremail") strZZSYSMGR_8 = request.cookies("AccessRules") response.cookies("trainerID") = strZZSYSMGR_1 response.cookies("trainerdir") = strZZSYSMGR_2 response.cookies("username") = strZZSYSMGR_3 Response.Cookies("TFLevel") = strZZSYSMGR_4 Response.Cookies("linktext") = strZZSYSMGR_5 Response.Cookies("userclass") = strZZSYSMGR_6 Response.Cookies("traineremail") = strZZSYSMGR_7 Response.Cookies("AccessRules") = strZZSYSMGR_8 Response.Cookies("trainerpublicdir") = request.cookies("trainerdir") ' connTrainerZZSYSMGR.Close ' Set connTrainerZZSYSMGR = Nothing %> <% ' *********************************************************************************** ' NOTE: Any changes made here must also be made in /tforcenet/members/masteradmin/ ' to the companion include file COMMON_FUNCTIONS_MYAP_MOD.ASP. ' *********************************************************************************** function hexEncode(str) dim strEncoded, i strEncoded = "" for i = 1 to Len(str) strEncoded = strEncoded + Hex(Asc(Mid(str, i, 1))) next hexEncode = strEncoded end function function GetUserSetting(iArr) ' This function returns the value of the passed array position for the USER_SETTINGS field in the CUSTOMERS table of TRAINERDB ' ALTERNATELY: If there is no entry for this user, default values are loaded. AND, if there are SOME values stored in DB ' but not ALL potential values, those missing values are defaulted to avoid error calling array out of bounds. dim rsUsersFunc, sqlFunc, strUserSetArray, strTempVal Set rsUsersFunc = Server.CreateObject("ADODB.Recordset") sqlFunc = "SELECT * FROM customers WHERE username = '" & username & "'" rsUsersFunc.Open sqlFunc, connTrainer, 0, 1 if not rsUsersFunc.EOF Then if IsNull(rsUsersFunc.Fields("user_settings")) then ' There has been no setting of this value for this client so just load up dummy zero values strTempNullValues = "0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0" strUserSetArray = Split(strTempNullValues,".") else strUserSetArray = Split(rsUsersFunc.Fields("user_settings"), ".") end if if UBound(strUserSetArray) < 2 then ' This user's stored db settings only has two places in the array (0 & 1) so need to check if what is ' being requested for return by this function is higher than that. if iArr > 1 then ' Looking for a value in the third or higher position (arr>=2) so need to default populate to avoid error strTempVal = "0" else ' Not asking for value above first two so go with what's stored in db for value strTempVal = strUserSetArray(iArr) end if elseif UBound(strUserSetArray) < 3 then if iArr > 2 then ' Looking for a value in the fourth or higher position (arr>=3) so need to default populate to avoid error strTempVal = "0" else ' Not asking for value above first two so go with what's stored in db for value strTempVal = strUserSetArray(iArr) end if elseif UBound(strUserSetArray) < 4 then if iArr > 3 then ' Looking for a value in the fourth or higher position (arr>=3) so need to default populate to avoid error strTempVal = "0" else ' Not asking for value above first two so go with what's stored in db for value strTempVal = strUserSetArray(iArr) end if else ' This user's settings in db are set large enough to handle this request (settings are for 4 arr places) strTempVal = strUserSetArray(iArr) end if else strTempVal = "ERROR" end if rsUsersFunc.Close Set rsUsersFunc = Nothing GetUserSetting = strTempVal end function function GetMYAPSetting(strUserID,iArr) ' This function returns the value of the passed array position for the SETTINGS field in the CLIENT_PREF table of MYAPDB dim rsUsersFunc, sqlFunc, strUserSetArray, strTempVal Set rsUsersFunc = Server.CreateObject("ADODB.Recordset") sqlFunc = "SELECT * FROM client_pref WHERE userid = '" & strUserID & "'" rsUsersFunc.Open sqlFunc, connMyAP, 0, 1 if not rsUsersFunc.EOF Then if IsNull(rsUsersFunc.Fields("settings")) then ' There has been no setting of this value for this client so just load up dummy zero values strTempNullValues = "0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0" strUserSetArray = Split(strTempNullValues,".") else strUserSetArray = Split(rsUsersFunc.Fields("settings"), ".") end if strTempVal = strUserSetArray(iArr) else strTempVal = "ERROR" end if rsUsersFunc.Close Set rsUsersFunc = Nothing GetMYAPSetting = strTempVal end function Function ScrambleItContent(strCodeword, strMessage, intAction) 'strCodeword is the encryption key that is used to scramble the message. 'strMessage is the actual message to be scrambled 'intAction must be 0 to encrypt or 1 to decrypt the message text. Dim strAlphabet Dim intMessageChar Dim intCodewordChar Dim intShiftAdjust Dim intHomeLocation strAlphabet = "0@1#2$3%4^5&6*7=8-9+AaBbC>cDdEeF!fG[gHhIiJjK 0 Then If InStr(1, strAlphabet, Mid(strCodeword, intCodewordChar, 1), vbBinaryCompare) > 0 Then intShiftAdjust = InStr(1, strAlphabet, Mid(strCodeword, intCodewordChar, 1), vbBinaryCompare) intHomeLocation = InStr(1, strAlphabet, Mid(strMessage, intMessageChar, 1), vbBinaryCompare) If intAction = 0 Then intShiftAdjust = intHomeLocation - intShiftAdjust If intAction = 1 Then intShiftAdjust = intHomeLocation + intShiftAdjust If intShiftAdjust > Len(strAlphabet) Then intShiftAdjust = intShiftAdjust - Len(strAlphabet) If intShiftAdjust < 1 Then intShiftAdjust = intShiftAdjust + Len(strAlphabet) Else intShiftAdjust = 1 End If ScrambleItContent = ScrambleItContent & Mid(strAlphabet, intShiftAdjust, 1) Else ScrambleItContent = ScrambleItContent & Mid(strMessage, intMessageChar, 1) End If If intCodewordChar > Len(strCodeword) Then intCodewordChar = 1 Else intCodewordChar = intCodewordChar + 1 Next End Function Function ScrambleItPhone(strCodeword, strMessage, intAction) ' This is strictly for processing VOX phone numbers. Since there are SQL calls made ' based on the phone number entered, eliminate the problem characters -- like single ' quote -- when they are in a SQL statement. 'strCodeword is the encryption key that is used to scramble the message. 'strMessage is the actual message to be scrambled 'intAction must be 0 to encrypt or 1 to decrypt the message text. Dim strAlphabet Dim intMessageChar Dim intCodewordChar Dim intShiftAdjust Dim intHomeLocation strAlphabet = "0@1#2$3456*78-9+AaBbC>cDdEeF!fG[gHhIiJjK 0 Then If InStr(1, strAlphabet, Mid(strCodeword, intCodewordChar, 1), vbBinaryCompare) > 0 Then intShiftAdjust = InStr(1, strAlphabet, Mid(strCodeword, intCodewordChar, 1), vbBinaryCompare) intHomeLocation = InStr(1, strAlphabet, Mid(strMessage, intMessageChar, 1), vbBinaryCompare) If intAction = 0 Then intShiftAdjust = intHomeLocation - intShiftAdjust If intAction = 1 Then intShiftAdjust = intHomeLocation + intShiftAdjust If intShiftAdjust > Len(strAlphabet) Then intShiftAdjust = intShiftAdjust - Len(strAlphabet) If intShiftAdjust < 1 Then intShiftAdjust = intShiftAdjust + Len(strAlphabet) Else intShiftAdjust = 1 End If ScrambleItPhone = ScrambleItPhone & Mid(strAlphabet, intShiftAdjust, 1) Else ScrambleItPhone = ScrambleItPhone & Mid(strMessage, intMessageChar, 1) End If If intCodewordChar > Len(strCodeword) Then intCodewordChar = 1 Else intCodewordChar = intCodewordChar + 1 Next End Function Function ProcessContent_MYAP(strUserID,strContent,intAction) ' This function automates translating the passed user's scrambled content Dim strIDPad, strComboCode iUserIDPos = CLng(strUserID) iUserIDNeg = CLng(strUserID) * -1 iUserIDDbl = iUserIDPos * iUserIDPos strIDPad = Hex(iUserIDDbl) & StrReverse(strUserID) & Hex(iUserIDPos) strCodeWord = uCase(strUserID & StrReverse(request.cookies("linktext")) & strIDPad) ProcessContent_MYAP = ScrambleItContent(strCodeWord,strContent,intAction) End Function Function ProcessContent_MYAP_2(strUserID,strContent,intAction,strLinkText) ' This function automates translating the passed user's scrambled content Dim strIDPad, strComboCode iUserIDPos = CLng(strUserID) iUserIDNeg = CLng(strUserID) * -1 iUserIDDbl = iUserIDPos * iUserIDPos strIDPad = Hex(iUserIDDbl) & StrReverse(strUserID) & Hex(iUserIDPos) strCodeWord = uCase(strUserID & StrReverse(strLinkText) & strIDPad) ProcessContent_MYAP_2 = ScrambleItContent(strCodeWord,strContent,intAction) End Function Function ScrambleItDir(strCodeword, strMessage, intAction) 'strCodeword is the encryption key that is used to scramble the message. 'strMessage is the actual message to be scrambled 'intAction must be 0 to encrypt or 1 to decrypt the message text. Dim strAlphabet Dim intMessageChar Dim intCodewordChar Dim intShiftAdjust Dim intHomeLocation 'strAlphabet = "0@1#2$3%4^5&6*7=8-9+AaBbCcDdEeFfGgHhIiJjKkLlMmNnOoPpQqRrSsTtUuVvWwXxYyZz" ' strAlphabet = "0@1#2$3%4^5&6*7=8-9+ AaBbCcDdEeFfGgHhIiJjKkLlMmNnOoPpQqRrSsTtUuVvWwXxYyZz" ' strAlphabet = "0123456789AaBbCcDdEeFfGgHhIiJjKkLlMmNnOoPpQqRrSsTtUuVvWwXxYyZz" strAlphabet = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" intCodewordChar = 8 For intMessageChar = 1 To Len(strMessage) If InStr(1, strAlphabet, Mid(strMessage, intMessageChar, 1), vbBinaryCompare) > 0 Then If InStr(1, strAlphabet, Mid(strCodeword, intCodewordChar, 1), vbBinaryCompare) > 0 Then intShiftAdjust = InStr(1, strAlphabet, Mid(strCodeword, intCodewordChar, 1), vbBinaryCompare) intHomeLocation = InStr(1, strAlphabet, Mid(strMessage, intMessageChar, 1), vbBinaryCompare) If intAction = 0 Then intShiftAdjust = intHomeLocation - intShiftAdjust If intAction = 1 Then intShiftAdjust = intHomeLocation + intShiftAdjust If intShiftAdjust > Len(strAlphabet) Then intShiftAdjust = intShiftAdjust - Len(strAlphabet) If intShiftAdjust < 1 Then intShiftAdjust = intShiftAdjust + Len(strAlphabet) Else intShiftAdjust = 1 End If ScrambleItDir = ScrambleItDir & Mid(strAlphabet, intShiftAdjust, 1) Else ScrambleItDir = ScrambleItDir & Mid(strMessage, intMessageChar, 1) End If If intCodewordChar > Len(strCodeword) Then intCodewordChar = 1 Else intCodewordChar = intCodewordChar + 1 Next End Function Function ScrambleItDir2(strCodeword, strMessage, intAction) ' This is used for TeamUp directory lookup 'strCodeword is the encryption key that is used to scramble the message. 'strMessage is the actual message to be scrambled 'intAction must be 0 to encrypt or 1 to decrypt the message text. Dim strAlphabet Dim intMessageChar Dim intCodewordChar Dim intShiftAdjust Dim intHomeLocation 'strAlphabet = "0@1#2$3%4^5&6*7=8-9+AaBbCcDdEeFfGgHhIiJjKkLlMmNnOoPpQqRrSsTtUuVvWwXxYyZz" ' strAlphabet = "0@1#2$3%4^5&6*7=8-9+ AaBbCcDdEeFfGgHhIiJjKkLlMmNnOoPpQqRrSsTtUuVvWwXxYyZz" ' strAlphabet = "0123456789AaBbCcDdEeFfGgHhIiJjKkLlMmNnOoPpQqRrSsTtUuVvWwXxYyZz" strAlphabet = "0123456789DEFABCPQRJKLXYZMNOGHISTUVW" intCodewordChar = 8 For intMessageChar = 1 To Len(strMessage) If InStr(1, strAlphabet, Mid(strMessage, intMessageChar, 1), vbBinaryCompare) > 0 Then If InStr(1, strAlphabet, Mid(strCodeword, intCodewordChar, 1), vbBinaryCompare) > 0 Then intShiftAdjust = InStr(1, strAlphabet, Mid(strCodeword, intCodewordChar, 1), vbBinaryCompare) intHomeLocation = InStr(1, strAlphabet, Mid(strMessage, intMessageChar, 1), vbBinaryCompare) If intAction = 0 Then intShiftAdjust = intHomeLocation - intShiftAdjust If intAction = 1 Then intShiftAdjust = intHomeLocation + intShiftAdjust If intShiftAdjust > Len(strAlphabet) Then intShiftAdjust = intShiftAdjust - Len(strAlphabet) If intShiftAdjust < 1 Then intShiftAdjust = intShiftAdjust + Len(strAlphabet) Else intShiftAdjust = 1 End If ScrambleItDir2 = ScrambleItDir2 & Mid(strAlphabet, intShiftAdjust, 1) Else ScrambleItDir2 = ScrambleItDir2 & Mid(strMessage, intMessageChar, 1) End If If intCodewordChar > Len(strCodeword) Then intCodewordChar = 1 Else intCodewordChar = intCodewordChar + 1 Next End Function Function ScrambleItFile(strCodeword, strMessage, intAction) 'strCodeword is the encryption key that is used to scramble the message. 'strMessage is the actual message to be scrambled 'intAction must be 0 to encrypt or 1 to decrypt the message text. Dim strAlphabet Dim intMessageChar Dim intCodewordChar Dim intShiftAdjust Dim intHomeLocation 'strAlphabet = "0@1#2$3%4^5&6*7=8-9+AaBbCcDdEeFfGgHhIiJjKkLlMmNnOoPpQqRrSsTtUuVvWwXxYyZz" ' strAlphabet = "0@1#2$3%4^5&6*7=8-9+ AaBbCcDdEeFfGgHhIiJjKkLlMmNnOoPpQqRrSsTtUuVvWwXxYyZz" ' strAlphabet = "0123456789AaBbCcDdEeFfGgHhIiJjKkLlMmNnOoPpQqRrSsTtUuVvWwXxYyZz" strAlphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_+-~" intCodewordChar = 8 For intMessageChar = 1 To Len(strMessage) If InStr(1, strAlphabet, Mid(strMessage, intMessageChar, 1), vbBinaryCompare) > 0 Then If InStr(1, strAlphabet, Mid(strCodeword, intCodewordChar, 1), vbBinaryCompare) > 0 Then intShiftAdjust = InStr(1, strAlphabet, Mid(strCodeword, intCodewordChar, 1), vbBinaryCompare) intHomeLocation = InStr(1, strAlphabet, Mid(strMessage, intMessageChar, 1), vbBinaryCompare) If intAction = 0 Then intShiftAdjust = intHomeLocation - intShiftAdjust If intAction = 1 Then intShiftAdjust = intHomeLocation + intShiftAdjust If intShiftAdjust > Len(strAlphabet) Then intShiftAdjust = intShiftAdjust - Len(strAlphabet) If intShiftAdjust < 1 Then intShiftAdjust = intShiftAdjust + Len(strAlphabet) Else intShiftAdjust = 1 End If ScrambleItFile = ScrambleItFile & Mid(strAlphabet, intShiftAdjust, 1) Else ScrambleItFile = ScrambleItFile & Mid(strMessage, intMessageChar, 1) End If If intCodewordChar > Len(strCodeword) Then intCodewordChar = 1 Else intCodewordChar = intCodewordChar + 1 Next End Function Function GetUserDir_MYAP(strUserID) ' This function automates finding the passed user's scrambled directory Dim strIDPad, strComboCode iUserIDPos = CLng(strUserID) iUserIDNeg = CLng(strUserID) * -1 iUserIDDbl = iUserIDPos * iUserIDPos strIDPad = Hex(iUserIDDbl) & StrReverse(strUserID) & Hex(iUserIDPos) strCodeWord = uCase(strUserID & StrReverse(request.cookies("linktext")) & strIDPad) GetUserDir_MYAP = ScrambleItDir(strCodeWord,strIDPad,0) End Function Function GetUserDir_MYAP_2(strUserID,strLinkText) ' This function automates finding the passed user's scrambled directory ' This second version is used when getting a directory when the linktext cookie is not set ' (Specifically for the VOX functionality) Dim strIDPad, strComboCode iUserIDPos = CLng(strUserID) iUserIDNeg = CLng(strUserID) * -1 iUserIDDbl = iUserIDPos * iUserIDPos strIDPad = Hex(iUserIDDbl) & StrReverse(strUserID) & Hex(iUserIDPos) strCodeWord = uCase(strUserID & StrReverse(strLinkText) & strIDPad) GetUserDir_MYAP_2 = ScrambleItDir(strCodeWord,strIDPad,0) End Function Function GetTeamDir_MYAP(strTeamID) ' This function automates finding the passed Team's scrambled directory Dim strIDPad, strComboCode iTeamIDPos = CLng(strTeamID) iTeamIDNeg = CLng(strTeamID) * -1 iTeamIDDbl = iTeamIDPos * iTeamIDPos strIDPad = Hex(iTeamIDDbl) & StrReverse(strTeamID) & Hex(iTeamIDPos) strCodeWord = uCase(strTeamID & StrReverse(request.cookies("linktext")) & strIDPad) GetTeamDir_MYAP = ScrambleItDir2(strCodeWord,strIDPad,0) End Function Function GetUserSettings(strUserID) On Error Resume Next if (right(lcase(request.servervariables("HTTP_HOST")),18) = "workoutsforyou.net") then strGetUSuPath = strSysAbsPath & "wfynet\members\" & request.cookies("trainerID") & "\uc\" & GetUserDir_MYAP(strUserID) else strGetUSuPath = strSysAbsPath & "tforcenet\members\" & request.cookies("trainerID") & "\uc\" & GetUserDir_MYAP(strUserID) end if strGetUSPath = strGetUSuPath & "\user_settings.txt" ' The values in the settings file are in the following positions: ' 1: Time zone (stored as + or - from GMT) ' 2: Unit of measure -- Pounds (0) or Kilograms (1) ' 3: Unit of measure -- Ounces (0) or Grams (1) ' The rest are placeholders for future settings set GetUSfs1 = Server.CreateObject("Scripting.FileSystemObject") if (GetUSfs1.FileExists(strGetUSPath) = true) then ' Load the settings set GetUSt1 = GetUSfs1.OpenTextFile(strGetUSPath,1) do while GetUSt1.AtEndOfStream = false GetUSDataTransfer1 = GetUSDataTransfer1 & GetUSt1.ReadLine loop GetUSt1.close strGetUSValues = GetUSDataTransfer1 else ' Need to create this user's settings file. This will only need to be done once per user ' and only if the trainer has not set their prefs in TRAINER_ADMIN-PROFILE.ASP (for existing users) ' ZZSIGNUPFORM.ASP will be where this file is created for each new user added going forward strGetUSValues = "-5.0|0|0|0|0|0|0|0|0|0|0|0|0|0|0" set GetUSfs = Server.CreateObject("Scripting.FileSystemObject") set GetUSt = GetUSfs.CreateTextFile(strGetUSPath) GetUSt.writeline(strGetUSValues) GetUSt.close set GetUSt = nothing set GetUSfs = nothing end if ' Of check for file exists On Error GoTo 0 GetUserSettings = strGetUSValues End Function ' GetUserSettings Function UpdateUserSettings(strUserID,strUSValue1,strUSValue2,strUSValue3) if (right(lcase(request.servervariables("HTTP_HOST")),18) = "workoutsforyou.net") then strUpdateUSuPath = strSysAbsPath & "wfynet\members\" & request.cookies("trainerID") & "\uc\" & GetUserDir_MYAP(strUserID) else strUpdateUSuPath = strSysAbsPath & "tforcenet\members\" & request.cookies("trainerID") & "\uc\" & GetUserDir_MYAP(strUserID) end if strUpdateUSPath = strUpdateUSuPath & "\user_settings.txt" ' The values in the settings file are in the following positions: ' 1: Time zone (stored as + or - from GMT) -- default is Eastern (-5.0) ' 2: Unit of measure -- Pounds (0) or Kilograms (1) ' 3: Unit of measure -- Ounces (0) or Grams (1) ' The rest are placeholders for future settings set UpdateUSfs1 = Server.CreateObject("Scripting.FileSystemObject") if (UpdateUSfs1.FileExists(strUpdateUSPath) = true) then ' Update the settings UpdateUSStr = strUSValue1 & "|" & strUSValue2 & "|" & strUSValue3 & "|0|0|0|0|0|0|0|0|0|0|0|0" On Error Resume Next set UpdateUSt1 = UpdateUSfs1.CreateTextFile(strUpdateUSPath) UpdateUSt1.writeline(UpdateUSStr) UpdateUSt1.close set UpdateUSt1 = nothing On Error GoTo 0 strUpdateUSValues = UpdateUSDataTransfer1 else ' No file exists. This most likely means it is being set up for the first time via ZZSIGNUPPROCESS.ASP set fsUpdateUS = Server.CreateObject("Scripting.FileSystemObject") ' Check to see if this client's unique directory even exists. If not, create it. if fsUpdateUS.FolderExists(strUpdateUSuPath) = true then ' Directory is there, just no file. The file will be added below. else ' Need to create this user's folder. set fsDirUpdateUS = Server.CreateObject("Scripting.FileSystemObject") set fDirUpdateUS = fsDirUpdateUS.CreateFolder(strUpdateUSuPath) set fDirUpdateUS = Nothing set fsDirUpdateUS = Nothing end if ' Of check for folder exists ' Now create this user's settings file. This will only need to be done once per user ' and only if the trainer has not set their prefs in TRAINER_ADMIN-PROFILE.ASP (for existing users) ' ZZSIGNUPFORM.ASP will be where this file is created for each new user added going forward UpdateUSStr = strUSValue1 & "|" & strUSValue2 & "|" & strUSValue3 & "|0|0|0|0|0|0|0|0|0|0|0|0" set UpdateUSfs = Server.CreateObject("Scripting.FileSystemObject") set UpdateUSt = UpdateUSfs.CreateTextFile(strUpdateUSPath) UpdateUSt.writeline(UpdateUSStr) UpdateUSt.close set UpdateUSt = nothing set UpdateUSfs = nothing end if ' Of check for file exists set UpdateUSfs1 = nothing UpdateUserSettings = strUpdateUSValues End Function ' UpdateUserSettings Function UserEvent_GetCount(strUserID) CONST ForReading = 1 strTextFile = "sample.txt" Set objFSO = CreateObject("Scripting.FileSystemObject") strData = objFSO.OpenTextFile(strTextFile,ForReading).ReadAll arrLines = Split(strData,vbCrLf) 'Use UBound to count the lines LineCount = UBound(arrLines) + 1 GetuserEventCount = LineCount Set objFSO = Nothing End Function Function UserEvent_GetFileName(strUserID) ' This function automates finding the passed user's scrambled event log filename Dim strIDPad, strComboCode iUserIDPos = CLng(strUserID) iUserIDNeg = CLng(strUserID) * -1 iUserIDDbl = iUserIDPos * iUserIDPos strIDPad = Hex(iUserIDDbl) & StrReverse(GetUserDir_MYAP(strUserID)) & Hex(iUserIDPos) strCodeWord = uCase(strUserID & StrReverse(request.cookies("linktext")) & strIDPad) UserEvent_GetFileName = ScrambleItFile(strCodeWord,strIDPad,0) End Function Function UserEvent_LogEvent(strDomain,strUserID,strSourceType,strSourceID,strEventType,strEventID,strMessage,strPrivacy) On Error Resume Next ' TO BE COMPLETED: ' ++++++++++++++++++++++++++++++++++++++++++ ' First thing, check to see if this very same event was just (repeat threshold?) recorded before repeating. ' This will eliminate the situations where someone might reload a page several times or go back-and-forth ' between a summary and detail page. Not wanting to record literally EVERY click, just form a stream of ' activity. ' ONE IDEA HOW TO DO THIS: Keep a text file each user's custom content dir that records the necessary info ' on the last several events that were logged. Do a quick loop thru and see if it's ' a match. If it is, don't add it. If not, include it in the list. There needs to be ' a manager function for controlling this event text file. ' ++++++++++++++++++++++++++++++++++++++++++ %> <% Dim ConnectStringEvent, connEvent, EventTrainerID, EventPath, checkreferralEvent ' The LINKTEXT is read from the trainer database (set in ZZSIGNIN.ASP) ' The trainerID cookie is set in the trainer's DEFAULT.ASP. It is not ' used to connect to the database, just to independently verify the ' user is in the right area. ' If they haven't logged in yet, then there will only be the TRAINERID cookie set if Request.Cookies("linktext") <> "" Then EventTrainerID = Request.Cookies("linktext") Else EventTrainerID = Request.Cookies("trainerID") End If ' *********************************************************************************************************** ' This code has been added to accomodate (isolated) incidents when a trainer uses FRAMES to mask the ' trainerforce.com domain in the addr bar. For some reason the cookies set in the public TF folder ' do not carry over when the signin process is kicked off. So the LOGIN.ASP page contains querystrings ' that send along the ID and dir so that once control has passed to the members area, the cookies ' can be set. ' NOTE: For this to fully work, the user will possibly have to specifically allow cookies from the TF.com ' domain to keep it from erroring out. ' Also, this section of code is only necessary during a call from the ZZSIGNIN.ASP page. ' *********************************************************************************************************** if EventTrainerID = "" then ' Check and make sure that only TF pages are calling this so that there is no way for a 3rd party to hack in checkreferralEvent = "http://www.trainerforce.net/" & request.querystring("path") & "/trainer_home.asp" if request.ServerVariables("http_referer") = checkreferralEvent then EventTrainerID = request.querystring("id") ' passed from a trainers LOGIN.ASP page Response.Cookies("trainerID") = EventTrainerID end if end if ' *********************************************************************************************************** ConnectStringEvent="DRIVER={MySQL ODBC 5.1 Driver}; SERVER=masteropt.webhost4lifemysql.com; PORT=3306;" &_ "DATABASE=tfeventdb1; USER=tfevent; PASSWORD=go4launch; OPTION=3;" Set connEvent = Server.CreateObject("ADODB.Connection") connEvent.open ConnectStringEvent %> <% ' Open the EVENT_DETAIL table and add the record. Set objRS = Server.CreateObject("ADODB.Recordset") objRS.Open "event_detail", connEvent, 3, 3 objRS.AddNew objRS.Fields("domain") = strDomain if (strUserID = "-1") OR (strUserID = "") then ' This is being called based on an event where a trainer is assigning something (workout, etc.) to a client ' and the calling function doesn't have the trainer's ID readily available. So get the trainer's ID and use it here ' NOT A GOOD LONG-TERM SOLUTION HERE, BUT... ' In situations where there is no ID being passed in (strUserID = ""), default to the trainer's ID if ( (lcase(Request.Cookies("linktext")) = "99905tm7") ) OR ( (lcase(Request.Cookies("linktext")) = "99lbv123") ) then strUserID = "33" else strUserID = "1" end if end if objRS.Fields("userID") = strUserID objRS.Fields("trainerID") = request.cookies("trainerID") objRS.Fields("daterecorded") = Now objRS.Fields("datelastupdated") = objRS.Fields("daterecorded") objRS.Fields("source_id") = strSourceID objRS.Fields("source_type") = strSourceType objRS.Fields("event_id") = strEventID objRS.Fields("event_type") = strEventType ' objRS.Fields("message") = ProcessContent_MYAP(strUserID,strMessage,0) objRS.Fields("privacy_level") = strPrivacy ' 0 = Only they view 1 = Trusted group (Trainer) 2 = Trusted cirlce(s) 3 = Public objRS.Fields("logged_ip") = request.ServerVariables("REMOTE_ADDR") objRS.Update objRS.Close set objRS = Nothing On Error GoTo 0 %> <% connEvent.Close Set connEvent = Nothing %> <% UserEvent_LogEvent = 0 End Function ' UserEvent_LogEvent function UserEvent_DateDiffToWords(d1, d2) minutes = abs(datediff("n", d1, d2)) strSuppressHM = "No" if minutes <= 0 then word = "0 minutes" else word = "" if minutes >= 24*60 then strSuppressHM = "Yes" if minutes <= 2880 then word = word & _ minutes\(24*60) & " day " else word = word & _ minutes\(24*60) & " days " end if end if if strSuppressHM = "No" then strSuppressM = "No" minutes = minutes mod (24*60) if minutes >= 60 then strSuppressM = "Yes" if minutes <= 120 then word = word & _ minutes\(60) & " hour " else word = word & _ minutes\(60) & " hours " end if end if if strSuppressM = "No" then minutes = minutes mod 60 if minutes <= 1 then word = word & minutes & " minute" else word = word & minutes & " minutes" end if end if end if end if UserEvent_DateDiffToWords = word end function Function UserEvent_ReadEvents(strCallType,strTrainerID,strUserID,strStopID,iLimit) ' On Error Resume Next ' This EVENT data resides in a master MySQL table and therefore requires ALL queries ' to be filtered based on the TRAINERID (passed). Exception for any master "firehose" queries... ' CALL TYPES: ' T - all shared events from the trainer ' T+1U - all of a trainer's stream PLUS one user's ' 1U - just one user's stream ' T+aU - all of a trainer's stream PLUS all users ' FH - firehose >> all activity for everyone in the system (only accessible by masteradmins) ' Set the trainer's id from the CUSTOMERS table. This is always "1" execpt for two old accounts, so check: if ( (lcase(Request.Cookies("linktext")) = "99905tm7") ) OR ( (lcase(Request.Cookies("linktext")) = "99lbv123") ) then strTrainerPersonalID = "33" else strTrainerPersonalID = "1" end if Set objRSReadEvent = Server.CreateObject("ADODB.Recordset") if strUserID = "0" then ' Load all records as a full "stream" of events that will be filtered by the calling page based on permissions if strCallType = "T" then ' Show to this user all shared events from their trainer if strStopID = "0" then strSQL = "SELECT * FROM event_detail WHERE (trainerid = '" & strTrainerID & "') AND (userid = '" & strTrainerPersonalID & "') AND (privacy_level = '1') ORDER BY daterecorded DESC" else strSQL = "SELECT * FROM event_detail WHERE (trainerid = '" & strTrainerID & "') AND (userid = '" & strTrainerPersonalID & "') AND (privacy_level = '1') AND (id < " & strStopID & ") ORDER BY daterecorded DESC" end if elseif strCallType = "FH" then ' Check to make sure this is only allowed by two approved trainers if ( (lcase(Request.Cookies("linktext")) = "99905tm7") ) OR ( (lcase(Request.Cookies("linktext")) = "99lbv123") ) then if strStopID = "0" then strSQL = "SELECT * FROM event_detail ORDER BY daterecorded DESC" else strSQL = "SELECT * FROM event_detail WHERE (id < " & strStopID & ") ORDER BY daterecorded DESC" end if end if elseif strCallType = "AU-T" then ' This is to list all users' streams EXCEPT the trainer. if strStopID = "0" then strSQL = "SELECT * FROM event_detail WHERE (trainerid = '" & strTrainerID & "') AND (userid <> '" & strTrainerPersonalID & "') ORDER BY daterecorded DESC" else strSQL = "SELECT * FROM event_detail WHERE (trainerid = '" & strTrainerID & "') AND (userid <> '" & strTrainerPersonalID & "') AND (id < " & strStopID & ") ORDER BY daterecorded DESC" end if else ' This is for a trainer looking at all their stream + all users. if strStopID = "0" then strSQL = "SELECT * FROM event_detail WHERE (trainerid = '" & strTrainerID & "') ORDER BY daterecorded DESC" else strSQL = "SELECT * FROM event_detail WHERE (trainerid = '" & strTrainerID & "') AND (id < " & strStopID & ") ORDER BY daterecorded DESC" end if end if ' Check for Firehose (FH) else ' The existence of a userID means that this is being called to look at either just one user's stream ' or the trainer + the user's stream if strCallType = "T+1U" then ' Load up the trainer's activity PLUS the passed user's activity if strStopID = "0" then strSQL = "SELECT * FROM event_detail WHERE (trainerid = '" & strTrainerID & "') AND (userid = '" & strUserID & "') AND (userid = '" & strTrainerPersonalID & "') ORDER BY daterecorded DESC" else strSQL = "SELECT * FROM event_detail WHERE (trainerid = '" & strTrainerID & "') AND (userid = '" & strUserID & "') AND (userid = '" & strTrainerPersonalID & "') AND (id < " & strStopID & ") ORDER BY daterecorded DESC" end if else ' Load up just the passed user's activity if strStopID = "0" then strSQL = "SELECT * FROM event_detail WHERE (trainerid = '" & strTrainerID & "') AND (userid = '" & strUserID & "') ORDER BY daterecorded DESC" else strSQL = "SELECT * FROM event_detail WHERE (trainerid = '" & strTrainerID & "') AND (userid = '" & strUserID & "') AND (id < " & strStopID & ") ORDER BY daterecorded DESC" end if end if ' Check for calltype end if ' strUserID = "0" objRSReadEvent.Open strSQL, connEvent, 0, 1 ' A passed iLimit value of 0 means grab all rows if iLimit > 0 then If Not objRSReadEvent.EOF Then arrRS = objRSReadEvent.GetRows(iLimit) else If Not objRSReadEvent.EOF Then arrRS = objRSReadEvent.GetRows() end if Set objRSReadEvent = Nothing UserEvent_ReadEvents = arrRS ' On Error GoTo 0 End Function ' UserEvent_ReadEvents Function UserEvent_GetEventPic(strUserID,strEventType,strEventID,strSrcType,strSrcID,strSrcPath) ' Set up default value. This will return two pieces -- the image path and the image title. ' When this is called, it will be split with the | character to make use of the two parts. UserEvent_GetEventPic = "0|0" ' Connect to db to grab name of friend. Right now just connecting using default trainerid, but ' in future friend could be from a different dir. if (right(lcase(request.servervariables("HTTP_HOST")),18) = "workoutsforyou.net") then trainerDBFriendPath = strSysAbsPath & "wfynet\members\" & strSrcPath & "\trainerDB.mdb" else trainerDBFriendPath = strSysAbsPath & "tforcenet\members\" & strSrcPath & "\trainerDB.mdb" end if ' ConnectStringGetEventPic = "Provider=Microsoft.Ace.OLEDB.12.0;Data Source=" & trainerDBFriendPath ' Set connGetEventPic = Server.CreateObject("ADODB.Connection") ' connGetEventPic.open ConnectStringGetEventPic ' if Len(strSrcID) > 0 then ' Set rsUsersEventPic = Server.CreateObject("ADODB.Recordset") ' sql = "SELECT * FROM customers WHERE id = " & strUserID ' rsUsersEventPic.Open sql, connGetEventPic, 0, 1 ' if not rsUsersEventPic.EOF Then ' FriendDisplayName = rsUsersEventPic.Fields("fname") & " " & rsUsersEventPic.Fields("lname") ' end if ' rsUsersEventPic.close ' set rsUsersEventPic = Nothing ' ************************************************************************************************ ' NOTE: USING THE getuserdir_myap FUNC RIGHT NOW ONLY WORKS ON THE *SAME* TRAINERID - THERE WILL ' BE CONDITIONS IN THE FUTURE WHERE EACH USER *COULD* BE IN THEIR OWN TRAINERID AREA ' ************************************************************************************************ if (right(lcase(request.servervariables("HTTP_HOST")),18) = "workoutsforyou.net") then strTempJournalImgPath = strSysAbsPath & "wfynet\members\" & strSrcPath & "\uc\" & GetUserDir_MYAP(strUserID) & "\now.gif" strTempJournalImgURL = "http://www.workoutsforyou.net/members/" & strSrcPath & "/uc/" & GetUserDir_MYAP(strUserID) & "/now.gif" else strTempJournalImgPath = strSysAbsPath & "tforcenet\members\" & strSrcPath & "\uc\" & GetUserDir_MYAP(strUserID) & "\now.gif" strTempJournalImgURL = "http://www.trainerforce.net/members/" & strSrcPath & "/uc/" & GetUserDir_MYAP(strUserID) & "/now.gif" end if ' end if ' Check for Len of strSrcID set fs = Server.CreateObject("Scripting.FileSystemObject") if (fs.FileExists(strTempJournalImgPath) = true) then if gfxSpex(strTempJournalImgPath, img_w, img_h, img_c, strImgType) = true then if (img_w > 50) OR (img_h > 50) then strTempJournalImg = "src=""" & strTempJournalImgURL & """ " & ImageResize(strTempJournalImgPath, 50, 50) strTempJournalTitle = FriendDisplayName else strTempJournalImg = "src=""" & strTempJournalImgURL & """" strTempJournalTitle = FriendDisplayName end if else strTempJournalImg = "src=""" & strTempJournalImgURL & """" strTempJournalTitle = FriendDisplayName end if else ' No img exists so just put in a placeholder strTempJournalImg = "src=""" & "img/generic_avatar-sm.png" & """" strTempJournalTitle = FriendDisplayName end if ' Check for file exists set fs = nothing UserEvent_GetEventPic = strTempJournalImg & "|" & strTempJournalTitle End Function ' UserEvent_GetEventPic Function UserEvent_GetEventLabels(strUserID,strEventType,strEventID,strSrcType,strSrcID,strSrcPath) ' Set up default value. This will return three pieces -- the name of the event's owner, the short description of the event and icon. ' When this is called, it will be split with the | character to make use of the two parts. UserEvent_GetEventLabels = " | | " ' Get Name if (right(lcase(request.servervariables("HTTP_HOST")),18) = "workoutsforyou.net") then trainerDBFriendPath = strSysAbsPath & "wfynet\members\" & strSrcPath & "\trainerDB.mdb" else trainerDBFriendPath = strSysAbsPath & "tforcenet\members\" & strSrcPath & "\trainerDB.mdb" end if ConnectStringGetEventLabels = "Provider=Microsoft.Ace.OLEDB.12.0;Data Source=" & trainerDBFriendPath Set connGetEventLabels = Server.CreateObject("ADODB.Connection") connGetEventLabels.open ConnectStringGetEventLabels Set rsUsersLabels = Server.CreateObject("ADODB.Recordset") sql = "SELECT * FROM customers WHERE id = " & strUserID rsUsersLabels.Open sql, connGetEventLabels, 0, 1 if not rsUsersLabels.EOF Then strLabelDisplayName = rsUsersLabels.Fields("fname") & " " & rsUsersLabels.Fields("lname") end if rsUsersLabels.close set rsUsersLabels = Nothing ' Get short description select case strSrcType case "0" ' Entry comes from system generated activity / basic system functions like ADD/DELETE user if strEventType = "0" then strLabelDisplayIcon = "feed-icon-home.gif" ' User logged in - determine whether via website or mobile if strSrcID = "0" then strLabelDisplayMessage = "Logged in via website" else strLabelDisplayMessage = "Logged in via mobile site" end if elseif strEventType = "1" then strLabelDisplayIcon = "feed-icon-profile.png" ' A new user was added to system strLabelDisplayMessage = "Added a new user to the system" else strLabelDisplayMessage = "System: " & strSrcID end if case "1" ' First-person actions in system strLabelDisplayIcon = "feed-icon-page.gif" if strEventType = "0" then strLabelDisplayMessage = "Viewed workout information" ' More granular info to come using EventType/EventID... elseif strEventType = "1" then strLabelDisplayMessage = "Viewed nutrition information" elseif strEventType = "2" then strLabelDisplayMessage = "Viewed FitTracker information" elseif strEventType = "3" then ' This is a view message event. Determine who sent message if strSrcID = "0" then strLabelDisplayMessage = "Viewed message from trainer" else strLabelDisplayMessage = "Viewed message to trainer" end if elseif strEventType = "4" then strLabelDisplayMessage = "Viewed log information" if strSrcID = "0" then strLabelDisplayMessage = "Viewed a workout log" elseif strSrcID = "1" then strLabelDisplayMessage = "Viewed a food log" elseif strSrcID = "2" then strLabelDisplayMessage = "Viewed a video log" else strLabelDisplayMessage = "Viewed a form log" end if elseif strEventType = "5" then strLabelDisplayMessage = "Viewed calendar information" elseif strEventType = "6" then strLabelDisplayMessage = "Assigned a workout to a user" else strLabelDisplayMessage = "UserAction: " & strSrcID end if case "2" ' First-person content creation/modification strLabelDisplayIcon = "feed-icon-add-page.gif" if strEventType = "0" then if strSrcID = "0" then strLabelDisplayMessage = "Added message to client" elseif strSrcID = "1" then strLabelDisplayMessage = "Added message to trainer" elseif strSrcID = "2" then strLabelDisplayMessage = "Added a status message to client's stream" elseif strSrcID = "3" then strLabelDisplayMessage = "Posted a message to client's Facebook account" ' NOTE: The message itself is stored in this record for display end if elseif strEventType = "1" then if strSrcID = "0" then strLabelDisplayMessage = "Added workout accountability log" elseif strSrcID = "1" then strLabelDisplayMessage = "Added food accountability log" end if elseif strEventType = "2" then strLabelDisplayMessage = "Added a journal entry" elseif strEventType = "3" then ' This content was created via the "Update Your Status" or "What's Going On?" input box ' that gets added directly to user's feed. strLabelDisplayMessage = "*+MSG+*" strLabelDisplayIcon = "feed-icon-comment.gif" elseif strEventType = "4" then if strSrcID = "0" then strLabelDisplayMessage = "Changed their profile picture" elseif strSrcID = "1" then strLabelDisplayMessage = "Changed their 'before' picture" elseif strSrcID = "2" then strLabelDisplayMessage = "Changed their profile summary" elseif strSrcID = "3" then strLabelDisplayMessage = "Changed their profile" end if elseif strEventType = "5" then strLabelDisplayMessage = "Added/Updated a FitTracker entry" elseif strEventType = "6" then strLabelDisplayMessage = "Added/Updated a FitTracker goal entry" elseif strEventType = "7" then if strSrcID = "1" then strLabelDisplayMessage = "Added an event to your calendar" else strLabelDisplayMessage = "Added an event to your client's calendar" end if else strLabelDisplayMessage = "UserContent: " & strSrcID end if case "3" ' Third-party (TRAINER) actions in system realted to this user strLabelDisplayIcon = "feed-icon-personal-space.png" if strEventType = "0" then strLabelDisplayMessage = "A workout was assigned to you" ' More granular info to come using EventType/EventID... elseif strEventType = "1" then strLabelDisplayMessage = "A nutrition plan was assigned to you" elseif strEventType = "2" then strLabelDisplayMessage = "A FitTracker chart was added for you" elseif strEventType = "3" then if strSrcID = "0" then strLabelDisplayMessage = "A message from your trainer" elseif strSrcID = "1" then strLabelDisplayMessage = "A message from a user" end if strLabelDisplayMessage = "A message from your trainer" elseif strEventType = "4" then strLabelDisplayMessage = "A FitStream message included a reference to you" elseif strEventType = "5" then strLabelDisplayMessage = "An event was added to your calendar" elseif strEventType = "6" then strLabelDisplayMessage = "Added a journal entry" elseif strEventType = "7" then strLabelDisplayMessage = "An event was added to your calendar" else strLabelDisplayMessage = "UserContent: " & strSrcID end if case "4" ' Third-part content creation related to this user case else end select UserEvent_GetEventLabels = strLabelDisplayName & "|" & strLabelDisplayMessage & "|" & strLabelDisplayIcon End Function ' UserEvent_GetEventLabels Function UserEvent_GetLocaleData(strIPAddr) ' Will return a string with two elements Pipe (|) delimited: CityState | Country Set oXML = Server.CreateObject("MSXML2.DOMDocument") oXML.async = False oxml.setProperty "ServerHTTPRequest", true strXMLURL = "http://api.hostip.info/?ip=" & strIPAddr ReturnValue = oXML.Load(strXMLURL) ' Response.write "Result of load method is =" & ReturnValue & "
" If ReturnValue = False Then Set oXMLError = oXML.ParseError Response.Write "  " & oXMLError.ErrorCode & " - " & oXMLError.Reason & " URL=" & oXMLError.URL & "
" Set oXMLError = Nothing bXMLLoadError = True Else bXMLLoadError = False End If Response.Write oxml.parseError.reason ' Now parse thru returned XML and grab two elements If Not bXMLLoadError Then Set objLst = oXML.getElementsByTagName("Hostip") For i = 0 to (objLst.length - 1) ' Loop thru all XML records (will in practice only be one) ' strTempTID = objLst.Item(i).Attributes.getNamedItem("TID").Text 'Extract the ID for this trainer from the XML node strIPLocale_CitySt = objLst.item(i).getElementsByTagName("gml:name").item(0).childNodes(0).nodeValue strIPLocale_Country = objLst.item(i).getElementsByTagName("countryAbbrev").item(0).childNodes(0).nodeValue Next ' For each i Set objLst = nothing Set oXML = nothing End If ' Check for bXMLLoadError if InStr(lcase(strIPLocale_CitySt),"unknown") = 0 then strDispCitySt = strIPLocale_CitySt else strDispCitySt = "NULL" end if if (InStr(lcase(strIPLocale_Country),"xx") = 0) AND (lcase(strIPLocale_Country) <> "us") then strDispCountry = strIPLocale_Country else strDispCountry = "NULL" end if UserEvent_GetLocaleData = strDispCitySt & "|" & strDispCountry End Function ' UserEvent_GetLocaleData Function EnDeCryptXOR( arrCode, strData ) i = 0 strTempBuild = "" For iCounter = 1 to Len(strData) i = ( i + 1 ) \ ( UBound( arrCode ) + 1 ) strTempBuild = strTempBuild & Chr( Asc( Mid(strData,iCounter,1) ) Xor arrCode(i) ) Next EnDeCryptXOR = strTempBuild End Function Function EncDecTxtFile( myFileIn, myFileOut, arrCode ) ' This function provides a simple (ASCII) text encoder/decoder using XOR. ' Because it uses XOR, both encoding and decoding can be performed by the ' same function, with the same key. ' ' Arguments: ' myFileIn [string] input text file (file to be encoded) ' myFileOut [string] output file (encoded text) ' arrCode [array of int] "key", consisting of any number of integers ' from 1 to 255; avoid 0, though it can be used, ' it doesn't encode anything. ' Use any number of elements in the "key" array, ' each element multiplies the number of possible ' keys by 255 (not 256 since 0 is avoided). ' If only a single element is used, it may be ' passed either as an array or as a single integer. ' ' Return code: ' 0 if all went well, otherwise the appropriate error number. ' ' Written by Rob van der Woude ' http://www.robvanderwoude.com ' Standard housekeeping Dim i, objFSO, objFileIn, objFileOut, objStreamIn Const ForAppending = 8 Const ForReading = 1 Const ForWriting = 2 Const TristateFalse = 0 Const TristateMixed = -2 Const TristateTrue = -1 Const TristateUseDefault = -2 ' Use custom error handling On Error Resume Next ' If the "key" is a single digit, convert it to an array If Not IsArray( arrCode ) Then arrCode = Array( arrCode ) End If ' Check if a valid "key" array is used For i = 0 To UBound( arrCode ) If Not IsNumeric( arrCode(i) ) Then ' 1032 Invalid character EncDecTxtFile = 1032 Exit Function End If If arrCode(i) < 0 Or arrCode(i) > 255 Then ' 1031 Invalid number EncDecTxtFile = 1031 Exit Function End If Next ' Open a file system object Set objFSO = CreateObject( "Scripting.FileSystemObject" ) ' Open the input file if it exists If objFSO.FileExists( myFileIn ) Then Set objFileIn = objFSO.GetFile( myFileIn ) Set objStreamIn = objFileIn.OpenAsTextStream( ForReading, TriStateFalse ) Else ' Error 53: File not found EncDecTxtFile = 53 ' Close input file and release objects objStreamIn.Close Set objStreamIn = Nothing Set objFileIn = Nothing Set objFSO = Nothing ' Abort Exit Function End If ' Create the output file, overwriting existing file (if it exists) Set objFileOut = objFSO.CreateTextFile( myFileOut ) ' Encode the text from the input file and write it to the output file i = 0 Do Until objStreamIn.AtEndOfStream i = ( i + 1 ) \ ( UBound( arrCode ) + 1 ) objFileOut.Write Chr( Asc( objStreamIn.Read( 1 ) ) Xor arrCode(i) ) Loop ' Close files and release objects objFileOut.Close objStreamIn.Close Set objStreamIn = Nothing Set objFileIn = Nothing Set objFileOut = Nothing Set objFSO = Nothing ' Return the error number as status information EncDecTxtFile = Err.Number ' Done Err.Clear On Error Goto 0 End Function Function GetKey( myPassPhrase ) ' This function converts a password or passphrase ' into a "key" array for the EncDecTxtFile function. Dim i, arrCode( ) ReDim arrCode( Len( myPassPhrase ) - 1 ) For i = 0 To UBound( arrCode ) arrCode(i) = Asc( Mid( myPassPhrase, i + 1, 1 ) ) Next GetKey = arrCode End Function Function FlowPlayer_ShowControl(mode,container,videopath,w,h) ' Write out the script code response.write "
" & VbCrLf response.write "" & VbCrLf End Function Function Userplane_ShowControl(mode,container,usercontentdir,videoid,videouserid,w,h) response.write "No video" End Function '::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: '::: ::: '::: This routine will attempt to identify any filespec passed ::: '::: as a graphic file (regardless of the extension). This will ::: '::: work with BMP, GIF, JPG and PNG files. ::: '::: ::: '::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: '::: Based on ideas presented by David Crowell ::: '::: (credit where due) ::: '::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: '::: blah blah Copyright *c* MM, Mike Shaffer blah blah ::: '::: blah blah ALL RIGHTS RESERVED WORLDWIDE blah blah ::: '::: blah blah Permission is granted to use this code blah blah ::: '::: blah blah in your projects, as long as this blah blah ::: '::: blah blah copyright notice is included blah blah ::: '::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: '::: ::: '::: This function gets a specified number of bytes from any ::: '::: file, starting at the offset (base 1) ::: '::: ::: '::: Passed: ::: '::: flnm => Filespec of file to read ::: '::: offset => Offset at which to start reading ::: '::: bytes => How many bytes to read ::: '::: ::: '::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: function GetBytes(flnm, offset, bytes) Dim objFSO Dim objFTemp Dim objTextStream Dim lngSize on error resume next Set objFSO = CreateObject("Scripting.FileSystemObject") ' First, we get the filesize Set objFTemp = objFSO.GetFile(flnm) lngSize = objFTemp.Size set objFTemp = nothing fsoForReading = 1 Set objTextStream = objFSO.OpenTextFile(flnm, fsoForReading) if offset > 0 then strBuff = objTextStream.Read(offset - 1) end if if bytes = -1 then ' Get All! GetBytes = objTextStream.Read(lngSize) 'ReadAll else GetBytes = objTextStream.Read(bytes) end if objTextStream.Close set objTextStream = nothing set objFSO = nothing end function '::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: '::: ::: '::: Functions to convert two bytes to a numeric value (long) ::: '::: (both little-endian and big-endian) ::: '::: ::: '::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: function lngConvert(strTemp) lngConvert = clng(asc(left(strTemp, 1)) + ((asc(right(strTemp, 1)) * 256))) end function function lngConvert2(strTemp) lngConvert2 = clng(asc(right(strTemp, 1)) + ((asc(left(strTemp, 1)) * 256))) end function '::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: '::: ::: '::: This function does most of the real work. It will attempt ::: '::: to read any file, regardless of the extension, and will ::: '::: identify if it is a graphical image. ::: '::: ::: '::: Passed: ::: '::: flnm => Filespec of file to read ::: '::: width => width of image ::: '::: height => height of image ::: '::: depth => color depth (in number of colors) ::: '::: strImageType=> type of image (e.g. GIF, BMP, etc.) ::: '::: ::: '::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: function gfxSpex(flnm, width, height, depth, strImageType) dim strPNG dim strGIF dim strBMP dim strType strType = "" strImageType = "(unknown)" gfxSpex = False strPNG = chr(137) & chr(80) & chr(78) strGIF = "GIF" strBMP = chr(66) & chr(77) strType = GetBytes(flnm, 0, 3) if strType = strGIF then ' is GIF strImageType = "GIF" Width = lngConvert(GetBytes(flnm, 7, 2)) Height = lngConvert(GetBytes(flnm, 9, 2)) Depth = 2 ^ ((asc(GetBytes(flnm, 11, 1)) and 7) + 1) gfxSpex = True elseif left(strType, 2) = strBMP then ' is BMP strImageType = "BMP" Width = lngConvert(GetBytes(flnm, 19, 2)) Height = lngConvert(GetBytes(flnm, 23, 2)) Depth = 2 ^ (asc(GetBytes(flnm, 29, 1))) gfxSpex = True elseif strType = strPNG then ' Is PNG strImageType = "PNG" Width = lngConvert2(GetBytes(flnm, 19, 2)) Height = lngConvert2(GetBytes(flnm, 23, 2)) Depth = getBytes(flnm, 25, 2) select case asc(right(Depth,1)) case 0 Depth = 2 ^ (asc(left(Depth, 1))) gfxSpex = True case 2 Depth = 2 ^ (asc(left(Depth, 1)) * 3) gfxSpex = True case 3 Depth = 2 ^ (asc(left(Depth, 1))) '8 gfxSpex = True case 4 Depth = 2 ^ (asc(left(Depth, 1)) * 2) gfxSpex = True case 6 Depth = 2 ^ (asc(left(Depth, 1)) * 4) gfxSpex = True case else Depth = -1 end select else strBuff = GetBytes(flnm, 0, -1) ' Get all bytes from file lngSize = len(strBuff) flgFound = 0 strTarget = chr(255) & chr(216) & chr(255) flgFound = instr(strBuff, strTarget) if flgFound = 0 then exit function end if strImageType = "JPG" lngPos = flgFound + 2 ExitLoop = false do while ExitLoop = False and lngPos < lngSize do while asc(mid(strBuff, lngPos, 1)) = 255 and lngPos < lngSize lngPos = lngPos + 1 loop if asc(mid(strBuff, lngPos, 1)) < 192 or asc(mid(strBuff, lngPos, 1)) > 195 then lngMarkerSize = lngConvert2(mid(strBuff, lngPos + 1, 2)) lngPos = lngPos + lngMarkerSize + 1 else ExitLoop = True end if loop ' if ExitLoop = False then Width = -1 Height = -1 Depth = -1 else Height = lngConvert2(mid(strBuff, lngPos + 4, 2)) Width = lngConvert2(mid(strBuff, lngPos + 6, 2)) Depth = 2 ^ (asc(mid(strBuff, lngPos + 8, 1)) * 8) gfxSpex = True end if end if end function function ImageResize(strImageName, intDesiredWidth, intDesiredHeight) dim TargetRatio dim CurrentRatio dim strResize dim w, h, c, strType if gfxSpex(strImageName, w, h, c, strType) = true then TargetRatio = intDesiredWidth / intDesiredHeight CurrentRatio = w / h if CurrentRatio > TargetRatio then ' We'll scale height strResize = "width=""" & intDesiredWidth & """" else strResize = "height=""" & intDesiredHeight & """" ' We'll scale width end if else strResize = "" end if ImageResize = strResize end Function function ImageResize2(currHeight, currWidth, intDesiredHeight, intDesiredWidth) ' NOTE: This is a modified version of ImageResize function above because of need to ' have an alternative to that in new MYACTIVE_HOME.ASP code. Notes are there. TargetRatio = intDesiredWidth / intDesiredHeight CurrentRatio = currWidth / currHeight if CurrentRatio > TargetRatio then ' We'll scale height strResize = "width=""" & intDesiredWidth & """" else strResize = "height=""" & intDesiredHeight & """" ' We'll scale width end if ImageResize2 = strResize end Function %> <% Dim mailObjLogCorp, logRedirect, logAdvancedLevelUser, pagesettings_path, fs_loguser, t_loguser Dim strLogUserArray, strLogUserBodyBackground, logPremiumLevelUser, logNutriUser ' ************************************************************************************ ' This code to be run for each page added in this directory to validate membership ' ************************************************************************************ if Request.Cookies("username") = "" then ' Check to see if a mobile user is allowed here. The below variable is set in each ' page that needs to allow the page to run in mobile mode. if strLogAllowMobile = "Yes" then ' They want mobile here, so confirm the mobile cookie is set if Request.Cookies("mobile_username") = "" then Response.Redirect("zznologin_mobile.asp") end if else Response.Redirect("zznologin.asp") end if end if logPremiumLevelUser = "No" ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ' Variable set to define absolute path. Used in many pages ' Set in both ZZLOGUSER.ASP and ZZLOGADMIN.ASP ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ' strSysAbsPath = "d:\hosting\member\masteropt\" strSysAbsPath = "\\boswinfs03\home\users\web\b538\whl.masteropt\" ' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ' ' CHECK for OPTA: See if this is a trainer that is coming from OPTA. If so, send them away, unless ' this page has been tagged as acceptable, by the variable set below via the file ' ZZLOGADMIN_LITE.ASP included in any page to exempt from redirect if lcase(Request.Cookies("trainerdir")) = "opta1" then ' Check to see if variable has been set if strLogAdminAllowOPTA = "Yes" then ' They can be here else response.redirect("/members/admin_o.asp") end if end if ' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! if (right(lcase(request.servervariables("HTTP_HOST")),18) = "workoutsforyou.net") then pagesettings_path = strSysAbsPath & "wfynet\members\" & request.cookies("trainerID") & "\page_settings.txt" logPremiumLevelUser = "Yes" else pagesettings_path = strSysAbsPath & "tforcenet\members\" & request.cookies("trainerID") & "\page_settings.txt" end if if (right(lcase(request.servervariables("HTTP_HOST")),18) = "wellnessengine.com") then logPremiumLevelUser = "Yes" end if logNutriUser = "No" if (left(lcase(request.cookies("linktext")),2) = "nt") then ' This is a Nutrition System User logNutriUser = "Yes" end if ' ******************************************************************* ' Verify this USERNAME is supposed to be ' assigned to this TRAINER. LINKTEXT cookie is set in ZZSIGNIN.ASP ' TRAINERID cookie is set in MEMBERS_HOME.ASP ' ******************************************************************* if Request.Cookies("trainerID") <> Request.Cookies("linktext") then Response.Redirect("zznologin.asp") end if ' **************************************************************************** ' Check for Starter, Pro or Club level. If an advanced level, set variable ' for pontential use in page this is included in. Right now just checking for Pro logAdvancedLevelUser = "No" if (request.cookies("TFLevel") = "Pro") OR (request.cookies("TFLevel") = "Premium") then logAdvancedLevelUser = "Yes" end if ' **************************************************************************** ' ************************************************************************************ ' Check the referring page. If this page is being loaded by the MYACTIVE_HOME.ASP ' page then set the logShowMAP variable to Yes. ' This determines if each page is displayed in "Classic" style with full header and ' leftnav or as a Ajax-based popup for My Active Profile ' ************************************************************************************ logShowMAP = "No" if instr(request.servervariables("http_referer"),"myactive_home.asp") <> 0 then ' Currently the GreyBox Ajax code is being used to load up all content ' from MYACTIVE_HOME.ASP. GreyBox invokes the LOADER_FRAME.HTML page to ' render the shadowbox popup. This page is located in the Javascript subdirectory logShowMAP = "Yes" end if ' ------------------------------------------------------------------------------------ ' if lcase(Request.Cookies("trainerID")) = "99lbv123" then ' SEND EMAIL LOG USING ASPEMAIL COMPONENT ' Set mailObjLogCorp = Server.CreateObject("Persits.MailSender") ' mailObjLogCorp.Host = "localhost" ' mailObjLogCorp.Host = "mail.wellnessengine.com" ' mailObjLogCorp.From = "noreply@workoutsforyou.com" ' mailObjLogCorp.FromName = "WFY CLIENT TRACKER" ' mailObjLogCorp.AddAddress "log@workoutsforyou.com" ' mailObjLogCorp.Subject = "User: " & request.cookies("username") ' mailObjLogCorp.Body = "Page: " & request.ServerVariables("script_name") & " @ " & request.ServerVariables("REMOTE_ADDR") ' mailObjLogCorp.IsHTML = False ' mailObjLogCorp.Username = "noreply@trainerforce.net" ' mailObjLogCorp.Password = "tfnoreply123" ' mailObjLogCorp.Send ' Set mailObjLogCorp = Nothing ' end if ' **************************************************************************** ' Load the text file PAGE_SETTINGS.TXT ' We only care about the Members Pages Background field below. This file will ' be re-read in the HEADER.ASP section ' PAGE SECTION: ' (0) bgcolorpublic , (1) bgcolormember ' HEADER SECTION: ' (2) title , (3) title2 , (4) bggraphic , (5) textfont , (6) textcolor , (7) textsize1 , ' (8) textsize2, (9) textposition, (10) textpadding, (11) navbarbgcolor (12) navbartextcolor, ' (13) navbartextfont ' LEFTNAV SECTION: ' (14) bgcolor, (15) leftnavfont, (16) grouptextcolor, (17) individualtextcolor, ' (18) fittipbgcolor, (19) fittiptextcolor ' ************************************************************************************************* set fs_loguser = Server.CreateObject("Scripting.FileSystemObject") if (fs_loguser.FileExists(pagesettings_path) = true) then ' We have a customization settings file so load up set t_loguser = fs_loguser.OpenTextFile(pagesettings_path,1) On Error Resume Next do while t_loguser.AtEndOfStream = false DataTransfer = DataTransfer & t_loguser.ReadLine loop On Error GoTo 0 t_loguser.close strLogUserArray = Split(DataTransfer, ",") strLogUserBodyBackground = strLogUserArray(1) else strLogUserBodyBackground = "FFFFFF" end if set t_loguser = nothing set fs_loguser = nothing Response.addHeader "Cache-Control", "no-cache, no-store, must-revalidate" ' HTTP 1.1. Response.addHeader "Pragma", "no-cache" ' HTTP 1.0. Response.addHeader "Expires", "0" ' Proxies. %> Fitness Tips
Use your browser's print button to print a copy of this Workout Log.  To return to the previous page, click here.

Week One

 

Day One

Day Two

Day Three

Day Four 

Day Five 

Day Six

Day Seven

 

Level of Difficulty

 

Too Hard 

Too Easy

Just Right

Cardio Exercise

 

 

 

 

 

 

 

 

 

 

 

Upper Body Strength Exercises

 

 

 

 

 

 

 

 

 

 

 

Lower Body Strength Exercises

 

 

 

 

 

 

 

 

 

 

 

Abdominal Exercises

 

 

 

 

 

 

 

 

 

 

 

Stretches

 

 

 

 

 

 

 

 

 

 

 

What I liked about this week's program:

 

Was there anything that  I didn't like about this week's program:

 

 

 Week Two

 

Day One

Day Two

Day Three

Day Four 

Day Five 

Day Six

Day Seven

 

Level of Difficulty

 

Too Hard 

Too Easy

Just Right

Cardio Exercise

 

 

 

 

 

 

 

 

 

 

 

Upper Body Strength Exercises

 

 

 

 

 

 

 

 

 

 

 

Lower Body Strength Exercises

 

 

 

 

 

 

 

 

 

 

 

Abdominal Exercises

 

 

 

 

 

 

 

 

 

 

 

Stretches

 

 

 

 

 

 

 

 

 

 

 

What I liked about this week's program:

 

Was there anything that  I didn't like about this week's program:

 

  

Week Three

 

Day One

Day Two

Day Three

Day Four 

Day Five 

Day Six

Day Seven

 

Level of Difficulty

 

Too Hard 

Too Easy

Just Right

Cardio Exercise

 

 

 

 

 

 

 

 

 

 

 

Upper Body Strength Exercises

 

 

 

 

 

 

 

 

 

 

 

Lower Body Strength Exercises

 

 

 

 

 

 

 

 

 

 

 

Abdominal Exercises

 

 

 

 

 

 

 

 

 

 

 

Stretches

 

 

 

 

 

 

 

 

 

 

 

What I liked about this week's program:

 

Was there anything that  I didn't like about this week's program:

 

 

 Week Four

 

Day One

Day Two

Day Three

Day Four 

Day Five 

Day Six

Day Seven

 

Level of Difficulty

 

Too Hard 

Too Easy

Just Right

Cardio Exercise

 

 

 

 

 

 

 

 

 

 

 

Upper Body Strength Exercises

 

 

 

 

 

 

 

 

 

 

 

Lower Body Strength Exercises

 

 

 

 

 

 

 

 

 

 

 

Abdominal Exercises

 

 

 

 

 

 

 

 

 

 

 

Stretches

 

 

 

 

 

 

 

 

 

 

 

What I liked about this week's program:

 

Was there anything that  I didn't like about this week's program: