f:\inetpub\wwwreg2\includes\functions.asp
0001:
<%
0002:
'$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
0003:
'Purpose:
0004:
' This file is to store all standard and public variables, constants, functions and procedures
0005:
'
0006:
'Constants and Variables:
0007:
'
0008:
' g_blnDebug - switch for page debug information
0009:
' g_strApplicationVersion - application version
0010:
' g_strConnectionString - Current global database connection string
0011:
' g_strPageName - The redirection and form page submission variable
0012:
'
0013:
'Procedures and Functions:
0014:
'
0015:
'
0016:
' showRequiredQStoForm - Writes 5 Questions form querystring values to the page as hidden form variables
0017:
' fGetrefiQueryStrings - Function: Returns all querystrings EXCEPT "action" to be written to url (no ? preceeds)
0018:
' showQStoForm - Writes all querystrings to the page as hidden form variables
0019:
' rw - Response.write shortcut procedure
0020:
' rwb - Response.write shortcut procedure with end of page
0021:
' ShowErrorPage - Writes and error page from a template and inserts an error message
0022:
' ShowError - Writes ONLY the current error string to the page
0023:
' ShowOops - Captures and displays program logic error messages
0024:
' fValidateData - Function : Inputs array, checks for blank data input and retuns error message
0025:
' showFormVars - Writes all current form variables to the page as hidden form variables
0026:
' showAffiliateFormVars - Writes Affiliate related form variables to the page as hidden form variables
0027:
' showIndexPageQStoForm - Writes inital (index page) querystrings to form variables
0028:
' fCalcLTV - Used by fBadLTV to calculate the Loan to Value - Requires array input
0029:
' fBadLTV - Check if Loan to value is BAD - Requires array input
0030:
' fLowRate - Check if Interest rate is too low- Requires array input
0031:
' fSelectState - Returns the State value of the highest priority of two state inputs.
0032:
' Input variables are from lowest to highest. IE. fSelectState(Lowpriority, HighPriority)
0033:
' ShowSelected - used to return a inputed string only when 2 other input variables match
0034:
' ShowStateSelect - Writes a Form select box with the States of the USA: Form Name is State
0035:
' showDebtStateSelect - Writes a Form select box with the States of the USA: Form Name is State, modified for debt page MI, ID, WI excluded.
0036:
' showLoanAmountDesiredSelect
0037:
' showPropertyTypeSelect
0038:
' showProductDesiredSelect
0039:
'
0040:
'$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
0041:
0042:
'Declare constants and variables
0043:
0044:
dim g_strConnectionString
0045:
dim g_strPageName
0046:
dim g_strApplicationVersion
0047:
dim g_blnDebug
0048:
0049:
g_strConnectionString= Application("moneynest_connection")
0050:
0051:
'$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
0052:
sub showError(strData)
0053:
Response.Clear
0054:
Response.Write "Make Pretty Error function Here!<br>"
0055:
response.write strData
0056:
Response.End
0057:
end sub
0058:
'$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
0059:
sub showOops(strData)
0060:
Response.Write strData
0061:
end sub
0062:
'$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
0063:
sub rw(strData)
0064:
Response.Write strData
0065:
end sub
0066:
'$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
0067:
sub rwb(strData)
0068:
response.write strData
0069:
response.end
0070:
end sub
0071:
'$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
0072:
Sub showFormVars()
0073:
Dim FormField_name, FormField_value,x
0074:
0075:
for each FormField_name in request.form
0076:
FormField_value=request.form(FormField_name)
0077:
Response.Write("<input type='hidden' name='"& FormField_name &"' value='"& FormField_value &"'>"&vbCrLf)
0078:
next
0079:
End Sub
0080:
'$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
0081:
Sub showAffiliateFormVars()
0082:
Dim FormField_name, FormField_value,x
0083:
if Request.Form="" then
0084:
Call showIndexPageQStoForm
0085:
else
0086:
for each FormField_name in request.form
0087:
FormField_value=request.form(FormField_name)
0088:
if (Lcase(FormField_name)="source_id" or Lcase(FormField_name)="completeflag" or Lcase(FormField_name)="source_url" or Lcase(FormField_name)="affiliate" or Lcase(FormField_name)="completeflag" or Lcase(FormField_name)="queryurl") then
0089:
Response.Write("<input type='hidden' name='"& FormField_name &"' value='"& FormField_value &"'>"&vbCrLf)
0090:
end if
0091:
next
0092:
end if
0093:
End Sub
0094:
'$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
0095:
Sub ShowErrorPage(byval ErrorMsg)
0096:
'Write an error message
0097:
0098:
Dim line ,fs, ts
0099:
Set fs = server.CreateObject("Scripting.FileSystemObject")
0100:
Set ts = fs.OpenTextFile(Server.MapPath("\Templates\Errordebt.html"))
0101:
0102:
Do While Not ts.AtEndOfStream
0103:
line = ts.ReadLine
0104:
'INSERT ERROR MESSAGE TO TEMPLATE FILE
0105:
if InStr(line, "
<!-- //-->
") then
0106:
Response.write(vbCrLf & ErrorMsg & vbCrLf)
0107:
else
0108:
response.Write vbCrLf & line
0109:
end if
0110:
Loop
0111:
set fs=nothing
0112:
0113:
End Sub
0114:
'$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
0115:
0116:
Function fValidateData(ByRef FieldsArray())
0117:
dim arraysize, vMessage
0118:
vMessage=""
0119:
'GET NUMBER OF FIELDS TO VALIDATE
0120:
arraysize= Ubound(FieldsArray,1)
0121:
'VALIDATE EACH FIELD
0122:
for i = 0 to arraysize-1
0123:
if FieldsArray(i,1)="" then
0124:
vMessage=vMessage &"<br>"& FieldsArray(i,0) & " must be provided."
0125:
end if
0126:
next
0127:
if vMessage<>"" then
0128:
vMessage="<b>The following fields must be completed before you can submit this form</b><br>"& vMessage &vbCrLf &"<br>"
0129:
end if
0130:
0131:
fValidateData= vMessage
0132:
End Function
0133:
'$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
0134:
Sub showQStoForm
0135:
Dim x
0136:
if Request.ServerVariables("QUERY_STRING")<>"" then
0137:
For Each X in Request.QueryString
0138:
response.write("<input type='hidden' name='"& Request.QueryString.Key(x) &"' value='" &Request.QueryString.Item(x)&"'>"&vbCrLf)
0139:
Next
0140:
end if
0141:
End Sub
0142:
'$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
0143:
Sub showRequiredQStoForm
0144:
if Request.ServerVariables("QUERY_STRING")<>"" then
0145:
response.write("<input type='hidden' name='Home_Owner' value='" & Request.QueryString("Home_Owner")&"'>"&vbCrLf)
0146:
response.write("<input type='hidden' name='State' value='" & Request.QueryString("State") &"'>"&vbCrLf)
0147:
response.write("<input type='hidden' name='Type_of_Loan_Desired' value='" & Request.QueryString("Type_of_Loan_Desired") &"'>"&vbCrLf)
0148:
response.write("<input type='hidden' name='Property_Type' value='" & Request.QueryString("Property_Type") &"'>"&vbCrLf)
0149:
response.write("<input type='hidden' name='Loan_Amount_desired' value='" & Request.QueryString("Loan_Amount_desired") &"'>"&vbCrLf)
0150:
response.write("<input type='hidden' name='Source_ID' value='" & Request.QueryString("Source_ID") &"'>"&vbCrLf)
0151:
response.write("<input type='hidden' name='Affiliate' value='" & Request.QueryString("Affiliate") &"'>"&vbCrLf)
0152:
response.write("<input type='hidden' name='Source_Url' value='" & Request.QueryString("Source_Url") &"'>"&vbCrLf)
0153:
end if
0154:
End Sub
0155:
'$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
0156:
Function fGetrefiQueryStrings
0157:
dim tempqs, X
0158:
tempqs=""
0159:
if Request.ServerVariables("QUERY_STRING")<>"" then
0160:
For Each X in Request.QueryString
0161:
if cstr(Request.QueryString.Key(x))<>"action" then
0162:
tempqs = tempqs & Request.QueryString.Key(x) &"=" &Request.QueryString.Item(x) &"&"
0163:
end if
0164:
Next
0165:
end if
0166:
fGetRefiQueryStrings=tempqs
0167:
End Function
0168:
Sub showIndexPageQStoForm
0169:
if Request.ServerVariables("QUERY_STRING")<>"" then
0170:
Response.write("<input type='hidden' name='Source_id' value='"& Request.QueryString.Item(1) &"'> "&vbCrLf)
0171:
Response.write("<input type='hidden' name='affiliate' value='"& Request.QueryString.Key(1)& "'> "&vbCrLf)
0172:
If Request.Form("Source_url")="" then
0173:
Response.write("<input type='hidden' name='Source_url' value='"& Request.ServerVariables("HTTP_REFERER")& "'> "&vbCrLf)
0174:
else
0175:
Response.write("<input type='hidden' name='Source_url' value='"& Request.Form("Source_url")& "'> "&vbCrLf)
0176:
end if
0177:
Response.write("<input type='hidden' name='QueryURL' value='"& Request.ServerVariables("QUERY_STRING")&"'> "&vbCrLf)
0178:
Response.write("<input type='hidden' name='CompleteFlag' value='Incomplete'>"&vbCrLf)
0179:
End if
0180:
End Sub
0181:
0182:
'********************************************************************
0183:
Function fCalcLTV(ArrFormData)
0184:
dim FirstMort, SecondMort, PresentValue
0185:
0186:
'STRIP ALL NON NUMERICS OUT
0187:
ArrFormData(13)=fMakeNumeric(ArrFormData(13))
0188:
ArrFormData(17)=fMakeNumeric(ArrFormData(17))
0189:
ArrFormData(12)=fMakeNumeric(ArrFormData(12))
0190:
0191:
'CONVERT DATA INTO DOUBLE PRECISION DATA AND ASSIGN TO VARIABLES
0192:
FirstMort=CDbl(ArrFormData(13))
0193:
SecondMort=CDbl(ArrFormData(17))
0194:
PresentValue=CDbl(ArrFormData(12))
0195:
0196:
'(FIRST MORT BALANCE+SECOND MORT BALANCE) / PROPERTY VALUE
0197:
fCalcLTV=((FirstMort+SecondMort)/PresentValue)*100
0198:
If Err.number<>0 Then
0199:
'ASSIGN VALUE OF -1 TO RAISE ERROR
0200:
fCalcLTV=-1
0201:
End if
0202:
0203:
End Function
0204:
'********************************************************************
0205:
Function fBadLTV(ArrFormData)
0206:
dim LTV
0207:
'CALCULATE LTV
0208:
LTV=fCalcLTV(ArrFormData)
0209:
0210:
'IF ERROR SEND TO ERROR PAGE (ERROR VALUE = -1)
0211:
If LTV= -1 Then
0212:
fBadLTV=true
0213:
Exit Function
0214:
End If
0215:
0216:
'IF LTV CALCULATION IS >= 111%
0217:
If LTV >=111 Then
0218:
fBadLTV=true
0219:
0220:
Exit Function
0221:
Elseif LTV >=91 Then
0222:
'IF LTV CALCULATION IS >= 91%
0223:
If ArrFormData(26)="Refinance" or ArrFormData(26)="Refinance - FHA" _
0224:
or ArrFormData(26)="Refinance - VA" or ArrFormData(26)="Refinance with Cash Out" Then
0225:
'LOAN TYPE IS REFI
0226:
fBadLTV=true
0227:
0228:
Exit Function
0229:
End if
0230:
If ArrFormData(26)="Second Mortgage" or ArrFormData(26)="Debt Consolidation" _
0231:
or ArrFormData(26)="Home Improvement" or ArrFormData(26)="Equity Loan" Then
0232:
'LOAN TYPE IS
0233:
If ArrFormData(24)="Fair" or ArrFormData(24)="Poor" Then
0234:
'CREDIT GRADE IS POOR OR FAIR
0235:
fBadLTV=true
0236:
Exit Function
0237:
End if
0238:
End if
0239:
Else
0240:
'EVERYTHING OK SO SEND BACK VALUE FOR OK
0241:
fBadLTV=false
0242:
0243:
End if
0244:
'response.write("fBadLTV value="&fBadLTV&"<br> ")
0245:
End Function
0246:
'********************************************************************
0247:
Function fLowRate(ArrFormData)
0248:
dim Rate
0249:
0250:
'CHECK ONLY IF REFINANCE TYPE LOAN THAT IS NOT CASH OUT
0251:
'Response.Write "'" & ArrFormData(26) & "'<br>"
0252:
If ArrFormData(26)="Refinance" or ArrFormData(26)="Refinance - FHA" _
0253:
or ArrFormData(26)="Refinance - VA" Then
0254:
0255:
'STRIP ALL NON NUMERICS OUT
0256:
ArrFormData(14)=fMakeNumeric(ArrFormData(14))
0257:
0258:
'STANDARDIZE PERCENTAGES
0259:
ArrFormData(14)=fStandardizePercent(ArrFormData(14))
0260:
0261:
'CONVERT DATA INTO DOUBLE PRECISION DATA AND ASSIGN TO VARIABLES
0262:
Rate=CDbl(ArrFormData(14))
0263:
0264:
'CHECK TO SEE IF fLowRate
0265:
If Rate < 0 Then
0266:
fLowRate=True
0267:
End if
0268:
Else
0269:
fLowRate=False
0270:
End if
0271:
0272:
If Err.number<>0 Then
0273:
fLowRate=True
0274:
End if
0275:
End Function
0276:
0277:
'********************************************************************
0278:
' procedure: showSelected
0279:
' purpose: returns sParam when sData1 and sData2 match
0280:
' 20030803 added lcase to make string match when different case
0281:
'********************************************************************
0282:
function showSelected(sData1,sData2,sParam)
0283:
if trim(lcase(sData1) & "") = trim(lcase(sData2) & "") then
0284:
showSelected = sParam
0285:
else
0286:
showSelected = ""
0287:
end if
0288:
end function
0289:
0290:
'********************************************************************
0291:
function fSelectState(State1, State2)
0292:
fSelectState=""
0293:
if (State1<>"Select" and State1<>"") then fSelectState=State1
0294:
if (State2<>"Select" and State2<>"") then fSelectState=State2
0295:
end function
0296:
0297:
'********************************************************************
0298:
0299:
'********************************************************************
0300:
0301:
sub showStateSelect(strName, strSelected, strAttributes)
0302:
'********************************************************************
0303:
' no table, use array
0304:
dim arrValues(50)
0305:
dim i
0306:
0307:
arrValues(0) = "AK"
0308:
arrValues(1) = "AL"
0309:
arrValues(2) = "AR"
0310:
arrValues(3) = "AZ"
0311:
arrValues(4) = "CA"
0312:
arrValues(5) = "CO"
0313:
arrValues(6) = "CT"
0314:
arrValues(7) = "DC"
0315:
arrValues(8) = "DE"
0316:
arrValues(9) = "FL"
0317:
arrValues(10) = "GA"
0318:
arrValues(11) = "HI"
0319:
arrValues(12) = "IA"
0320:
arrValues(13) = "ID"
0321:
arrValues(14) = "IL"
0322:
arrValues(15) = "IN"
0323:
arrValues(16) = "KS"
0324:
arrValues(17) = "KY"
0325:
arrValues(18) = "LA"
0326:
arrValues(19) = "MA"
0327:
arrValues(20) = "MD"
0328:
arrValues(21) = "ME"
0329:
arrValues(22) = "MI"
0330:
arrValues(23) = "MN"
0331:
arrValues(24) = "MO"
0332:
arrValues(25) = "MS"
0333:
arrValues(26) = "MT"
0334:
arrValues(27) = "NC"
0335:
arrValues(28) = "ND"
0336:
arrValues(29) = "NE"
0337:
arrValues(30) = "NH"
0338:
arrValues(31) = "NJ"
0339:
arrValues(32) = "NM"
0340:
arrValues(33) = "NV"
0341:
arrValues(34) = "NY"
0342:
arrValues(35) = "OH"
0343:
arrValues(36) = "OK"
0344:
arrValues(37) = "OR"
0345:
arrValues(38) = "PA"
0346:
arrValues(39) = "RI"
0347:
arrValues(40) = "SC"
0348:
arrValues(41) = "SD"
0349:
arrValues(42) = "TN"
0350:
arrValues(43) = "TX"
0351:
arrValues(44) = "UT"
0352:
arrValues(45) = "VA"
0353:
arrValues(46) = "VT"
0354:
arrValues(47) = "WA"
0355:
arrValues(48) = "WI"
0356:
arrValues(49) = "WV"
0357:
arrValues(50) = "WY"
0358:
0359:
if isArray(arrValues) then
0360:
response.write "<select " & strAttributes & " name="& chr(34) & strName & chr(34) & ">"
0361:
response.write "<option value="& chr(34) & chr(34) &">Please Select</option>"
0362:
For i = 0 to uBound(arrValues)
0363:
response.write "<option value="& chr(34) & arrValues(i) & chr(34) &" "& showSelected(strSelected,arrValues(i),"selected") & ">" & arrValues(i) & "</option>"
0364:
Next
0365:
response.write "</select>"
0366:
else
0367:
response.write "(no data found)"
0368:
response.write "<input type='hidden' name="& chr(34) & strName & chr(34) & " value="& chr(34) & chr(34) &">"
0369:
end if
0370:
end sub
0371:
'********************************************************************
0372:
sub showDebtStateSelect(strName, strSelected, strAttributes)
0373:
'********************************************************************
0374:
' no table, use array
0375:
dim arrValues(47)
0376:
dim i
0377:
0378:
arrValues(0) = "AK"
0379:
arrValues(1) = "AL"
0380:
arrValues(2) = "AR"
0381:
arrValues(3) = "AZ"
0382:
arrValues(4) = "CA"
0383:
arrValues(5) = "CO"
0384:
arrValues(6) = "CT"
0385:
arrValues(7) = "DC"
0386:
arrValues(8) = "DE"
0387:
arrValues(9) = "FL"
0388:
arrValues(10) = "GA"
0389:
arrValues(11) = "HI"
0390:
arrValues(12) = "IA"
0391:
arrValues(13) = "IL"
0392:
arrValues(14) = "IN"
0393:
arrValues(15) = "KS"
0394:
arrValues(16) = "KY"
0395:
arrValues(17) = "LA"
0396:
arrValues(18) = "MA"
0397:
arrValues(19) = "MD"
0398:
arrValues(20) = "ME"
0399:
arrValues(21) = "MN"
0400:
arrValues(22) = "MO"
0401:
arrValues(23) = "MS"
0402:
arrValues(24) = "MT"
0403:
arrValues(25) = "NC"
0404:
arrValues(26) = "ND"
0405:
arrValues(27) = "NE"
0406:
arrValues(28) = "NH"
0407:
arrValues(29) = "NJ"
0408:
arrValues(30) = "NM"
0409:
arrValues(31) = "NV"
0410:
arrValues(32) = "NY"
0411:
arrValues(33) = "OH"
0412:
arrValues(34) = "OK"
0413:
arrValues(35) = "OR"
0414:
arrValues(36) = "PA"
0415:
arrValues(37) = "RI"
0416:
arrValues(38) = "SC"
0417:
arrValues(39) = "SD"
0418:
arrValues(40) = "TN"
0419:
arrValues(41) = "TX"
0420:
arrValues(42) = "UT"
0421:
arrValues(43) = "VA"
0422:
arrValues(44) = "VT"
0423:
arrValues(45) = "WA"
0424:
arrValues(46) = "WV"
0425:
arrValues(47) = "WY"
0426:
0427:
if isArray(arrValues) then
0428:
response.write "<select " & strAttributes & " name="& chr(34) & strName & chr(34) & " size="& chr(34) &"1"& chr(34) &">"
0429:
response.write "<option value="& chr(34) & chr(34) &">Please Select</option>"
0430:
For i = 0 to uBound(arrValues)
0431:
response.write "<option value="& chr(34) & arrValues(i) & chr(34) &" "& showSelected(strSelected,arrValues(i),"selected") & ">" & arrValues(i) & "</option>"
0432:
Next
0433:
response.write "</select>"
0434:
else
0435:
response.write "(no data found)"
0436:
response.write "<input type='hidden' name="& chr(34) & strName & chr(34) & " value="& chr(34) & chr(34) &">"
0437:
end if
0438:
end sub
0439:
'********************************************************************
0440:
0441:
sub showProductDesiredSelect(strName, strSelected, strAttributes)
0442:
'********************************************************************
0443:
' no table, use array
0444:
dim arrValues(1,10)
0445:
dim i
0446:
0447:
arrValues(0,0) = "Debt Management"
0448:
arrValues(1,0) = "Debt Mgmt (Credit Counseling)"
0449:
0450:
arrValues(0,1) = "Debt Consolidation"
0451:
arrValues(1,1) = "Debt Consolidation Loan"
0452:
0453:
arrValues(0,2) = "Refinance"
0454:
arrValues(1,2) = "Refinance"
0455:
0456:
arrValues(0,3) = "Refinance - FHA"
0457:
arrValues(1,3) = "Refinance - FHA"
0458:
0459:
arrValues(0,4) = "Refinance - VA"
0460:
arrValues(1,4) = "Refinance - VA"
0461:
0462:
arrValues(0,5) = "Home Improvement"
0463:
arrValues(1,5) = "Home Improvement"
0464:
0465:
arrValues(0,6) = "Home Equity Line of Credit"
0466:
arrValues(1,6) = "Home Equity Line of Credit"
0467:
0468:
arrValues(0,7) = "Refinance with Cash Out"
0469:
arrValues(1,7) = "Refinance with Cash Out"
0470:
0471:
arrValues(0,8) = "Purchase Loan"
0472:
arrValues(1,8) = "Purchase Loan"
0473:
0474:
arrValues(0,9) = "Second Mortgage"
0475:
arrValues(1,9) = "Second Mortgage"
0476:
0477:
arrValues(0,10) = "Equity Loan"
0478:
arrValues(1,10) = "Equity Loan"
0479:
0480:
if isArray(arrValues) then
0481:
response.write "<select " & strAttributes & " name='" & strName & "'>"
0482:
response.write "<option value=''>Please Select</option>"
0483:
0484:
For i = 0 to uBound(arrValues,2)
0485:
response.write "<option value='"& arrValues(0,i) & "' " & showSelected(strSelected,arrValues(0,i),"selected") & ">" & arrValues(1,i) & "</option>&vbCrLf"
0486:
Next
0487:
response.write "</select>"
0488:
else
0489:
response.write "(no data found)"
0490:
response.write "<input type='hidden' name='" & strName & "' value=''>"
0491:
end if
0492:
end sub
0493:
0494:
'********************************************************************
0495:
sub showPropertyTypeSelect(strName, strSelected, strAttributes)
0496:
'********************************************************************
0497:
' NOTE:
0498:
' default selection of first item when no value selected
0499:
0500:
' no table, use array
0501:
dim arrValues(8)
0502:
dim i
0503:
0504:
arrValues(0) = "Single Family Residence"
0505:
arrValues(1) = "Condominiums"
0506:
arrValues(2) = "Town House"
0507:
arrValues(3) = "Investment Property"
0508:
arrValues(4) = "Mobile Home"
0509:
arrValues(5) = "Cooperative"
0510:
arrValues(6) = "Multi-Family"
0511:
arrValues(7) = "Manufactured"
0512:
arrValues(8) = "Do Not Own"
0513:
0514:
if isArray(arrValues) then
0515:
response.write "<select " & strAttributes & " name='" & strName & "'>"
0516:
'response.write "<option value='Select'>Please Select</option>"
0517:
For i = 0 to uBound(arrValues)
0518:
response.write "<option value='"& arrValues(i) & "' " & showSelected(strSelected,arrValues(i),"selected") & ">" & arrValues(i) & "</option>&vbCrLf"
0519:
Next
0520:
response.write "</select>"
0521:
else
0522:
response.write "(no data found)"
0523:
response.write "<input type='hidden' name='" & strName & "' value=''>"
0524:
end if
0525:
end sub
0526:
0527:
'********************************************************************
0528:
sub showLoanAmountDesiredSelect(strName, strSelected, strAttributes)
0529:
'********************************************************************
0530:
' NOTE:
0531:
' default selection of first item when no value selected
0532:
0533:
' no table, use array
0534:
dim arrValues(13)
0535:
dim i
0536:
0537:
arrValues(0) = "None (debt management)"
0538:
arrValues(1) = "$0 - $10,000"
0539:
arrValues(2) = "$10,000 - $20,000"
0540:
arrValues(3) = "$20,000 - $35,000"
0541:
arrValues(4) = "$35,000 - $50,000"
0542:
arrValues(5) = "$50,000 - $75,000"
0543:
arrValues(6) = "$75,000 - $100,000"
0544:
arrValues(7) = "$100,000 - $150,000"
0545:
arrValues(8) = "$150,000 - $200,000"
0546:
arrValues(9) = "$200,000 - $300,000"
0547:
arrValues(10) = "$300,000 - $400,000"
0548:
arrValues(11) = "$400,000 - $500,000"
0549:
arrValues(12) = "$500,000 - $750,000"
0550:
arrValues(13) = "$750,000 - $10,000,000"
0551:
0552:
if isArray(arrValues) then
0553:
response.write "<select " & strAttributes & " name='" & strName & "'>"
0554:
response.write "<option value=''>Please Choose Loan Amount</option>"
0555:
For i = 0 to uBound(arrValues)
0556:
response.write "<option value='"& arrValues(i) & "' " & showSelected(strSelected,arrValues(i),"selected") & ">" & arrValues(i) & "</option>"&vbCrLf
0557:
Next
0558:
response.write "</select>"
0559:
else
0560:
response.write "(no data found)"
0561:
response.write "<input type='hidden' name='" & strName & "' value=''>"
0562:
end if
0563:
end sub
0564:
0565:
sub showColorSelect(strName, strSelected, strAttributes)
0566:
'********************************************************************
0567:
' NOTE:
0568:
' default selection of first item when no value selected
0569:
0570:
dim RS
0571:
dim Cn
0572:
dim SqlText
0573:
dim i
0574:
Set cn = Server.CreateObject("ADODB.Connection")
0575:
Cn.Open application("SFC_ConnectionString")
0576:
SqlText="Select * from Colors order by Color"
0577:
0578:
Set rs = Cn.Execute(SqlText)
0579:
0580:
response.write "<select " & strAttributes & " name='" & strName & "'>"
0581:
response.write "<option value=''>Please Select Color</option>"
0582:
0583:
if not rs.EOF then
0584:
rs.movefirst
0585:
do while not rs.EOF
0586:
response.write "<option value='"& rs("ColorHex") & "' " & showSelected(strSelected,rs("ColorHex"),"selected") & ">" & rs("Color") & "</option>"&vbCrLf
0587:
rs.movenext
0588:
loop
0589:
response.write "</select>"
0590:
else
0591:
response.write "(no data found)"
0592:
response.write "</select>"
0593:
'response.write "<input type='hidden' name='" & strName & "' value=''>"
0594:
end if
0595:
Cn.Close
0596:
set Cn=nothing
0597:
set rs=nothing
0598:
end sub
0599:
sub showLeagueSelect(strName, strSelected, strAttributes)
0600:
'********************************************************************
0601:
' NOTE:
0602:
' default selection of first item when no value selected
0603:
0604:
dim RS, CN
0605:
dim SqlText
0606:
dim i
0607:
dim LID
0608:
SqlText="Select LeagueID, Name from League"
0609:
0610:
Set cn = Server.CreateObject("ADODB.Connection")
0611:
Cn.Open application("SFC_ConnectionString")
0612:
Set rs = Cn.Execute(SqlText)
0613:
0614:
response.write "<select " & strAttributes & " name='" & strName & "'>"
0615:
response.write "<option value=''>Please Select Mod</option>"
0616:
0617:
if not rs.EOF then
0618:
rs.movefirst
0619:
do while not rs.EOF
0620:
LID=rs("LeagueID")
0621:
response.write "<option value='"& LID & "' " & showSelected(strSelected,LID,"selected") & ">" & rs("Name") & "</option>" &vbCrLf
0622:
rs.movenext
0623:
loop
0624:
response.write "</select>"
0625:
else
0626:
response.write "(no data found)"
0627:
response.write "</select>"
0628:
'response.write "<input type='hidden' name='" & strName & "' value=''>"
0629:
end if
0630:
Cn.Close
0631:
set Cn=nothing
0632:
set rs=nothing
0633:
end sub
0634:
'********************************************************************
0635:
sub showRaceSelect(strRace, strSelected, strAttributes,LID)
0636:
'********************************************************************
0637:
' NOTE:
0638:
' default selection of first item when no value selected
0639:
0640:
dim RS,Cn
0641:
dim SqlText
0642:
dim i, RID
0643:
0644:
SqlText="Select * from Race"
0645:
if LID<>0 then
0646:
SqlText = SqlText & " where RaceID in (select RaceID from LeagueRace where leagueID=" &LID &")"
0647:
end if
0648:
Set cn = Server.CreateObject("ADODB.Connection")
0649:
Cn.Open application("SFC_ConnectionString")
0650:
Set rs = Cn.Execute(SqlText)
0651:
0652:
response.write "<select " & strAttributes & " name='" & strRace & "'>"
0653:
response.write "<option value=''>Please Select Race</option>"
0654:
0655:
if not rs.EOF then
0656:
rs.movefirst
0657:
0658:
do while not rs.EOF
0659:
RID=rs("RaceID")
0660:
response.write "<option value='"& RID & "' " & showSelected(strSelected,RID,"selected") & ">" & rs("Name") & "</option>" &vbCrLf
0661:
rs.movenext
0662:
loop
0663:
response.write "</select>"
0664:
else
0665:
response.write "(no data found)"
0666:
response.write "</select>"
0667:
'response.write "<input type='hidden' name='" & strRace & "' value=''>"
0668:
end if
0669:
set rs=nothing
0670:
Cn.Close
0671:
set Cn=nothing
0672:
end sub
0673:
'********************************************************************
0674:
sub showRankSelect(strRank, strSelected, strAttributes)
0675:
'********************************************************************
0676:
' NOTE:
0677:
' default selection of first item when no value selected
0678:
0679:
dim RS
0680:
dim SqlText
0681:
dim i, RID
0682:
0683:
SqlText="Select * from Ranks "
0684:
if session("Security")=2 then
0685:
SqlText = SqlText & "where rankid >1"
0686:
elseif session("Security")>3 then
0687:
SqlText = SqlText & "where rankid >2"
0688:
end if
0689:
Set rs = Cn.Execute(SqlText)
0690:
0691:
response.write "<select " & strAttributes & " name='" & strRank & "'>"
0692:
response.write "<option value=''>Please Select Rank</option>"
0693:
0694:
if not rs.EOF then
0695:
rs.movefirst
0696:
0697:
do while not rs.EOF
0698:
RID=rs("RankID")
0699:
response.write "<option value='"& RID & "' " & showSelected(strSelected,RID,"selected") & ">" & rs("Rank") & "</option>" &vbCrLf
0700:
rs.movenext
0701:
loop
0702:
response.write "</select>"
0703:
else
0704:
response.write "(no data found)"
0705:
response.write "</select>"
0706:
'response.write "<input type='hidden' name='" & strRace & "' value=''>"
0707:
end if
0708:
0709:
set rs=nothing
0710:
end sub
0711:
'********************************************************************
0712:
sub showRaceRegisterSelect(strRace, strSelected, strAttributes,LID,GAP)
0713:
'********************************************************************
0714:
' NOTE:
0715:
' default selection of first item when no value selected
0716:
0717:
dim RS
0718:
dim Cn
0719:
dim SqlText
0720:
dim i, RID
0721:
Set cn = Server.CreateObject("ADODB.Connection")
0722:
Cn.Open application("SFC_ConnectionString")
0723:
SqlText="Select * from Race"
0724:
if LID<>0 then
0725:
SqlText = "select * from race " & _
0726:
"where (RaceID in (select RaceID from playercount where (playercount<= (select min(playercount)+"&GAP&" from playercount where leagueid="&LID&") " & _
0727:
"or playercount<=10) and leagueID="&LID&") or " & _
0728:
"RaceID in (select raceID from LeagueRace where leagueid="&LID&" and raceid not in (Select raceid from playercount where leagueid="&LID&")))"
0729:
'Response.Write(sqltext)
0730:
end if
0731:
Set rs = Cn.Execute(SqlText)
0732:
0733:
response.write "<select " & strAttributes & " name='" & strRace & "'>"
0734:
response.write "<option value=''>Please Select Race</option>"
0735:
0736:
if not rs.EOF then
0737:
rs.movefirst
0738:
0739:
do while not rs.EOF
0740:
RID=rs("RaceID")
0741:
response.write "<option value='"& RID & "' " & showSelected(strSelected,RID,"selected") & ">" & rs("Name") & "</option>" &vbCrLf
0742:
rs.movenext
0743:
loop
0744:
response.write "</select>"
0745:
else
0746:
response.write "(no data found)"
0747:
response.write "</select>"
0748:
'response.write "<input type='hidden' name='" & strRace & "' value=''>"
0749:
end if
0750:
Cn.Close
0751:
set Cn=nothing
0752:
set rs=nothing
0753:
end sub
0754:
'********************************************************************
0755:
sub showPlayerArraySelect(strPlayer, strSelected, strAttributes ,LID ,byref arrPlayers(),RID)
0756:
'********************************************************************
0757:
' NOTE:
0758:
' default selection of first item when no value selected
0759:
dim i, PID
0760:
0761:
0762:
0763:
response.write "<select " & strAttributes & " name='" & strPlayer & "'>"
0764:
response.write "<option value=''>Please Select Player</option>"
0765:
0766:
0767:
if ubound(arrPlayers)> 1 then
0768:
for i = 1 to ubound(arrPlayers)-1
0769:
If cstr(arrPlayers(i,2))=cstr(RID) or RID ="" then
0770:
PID=arrPlayers(i,0)
0771:
response.write "<option value='"& PID & "' " & showSelected(strSelected,PID,"selected") & ">" & arrPlayers(i,1) & "</option>"&vbCrLf
0772:
end if
0773:
next
0774:
response.write "</select>"
0775:
else
0776:
response.write "(no data found)"
0777:
response.write "</select>"
0778:
'response.write "<input type='hidden' name='" & strPlayer & "' value=''>"
0779:
end if
0780:
0781:
end sub
0782:
'********************************************************************
0783:
sub getPlayersArray(byref arrPlayers(), LID)
0784:
dim RS
0785:
dim Cn
0786:
dim SqlText, vCount
0787:
dim i, RID
0788:
Set cn = Server.CreateObject("ADODB.Connection")
0789:
Cn.Open application("SFC_ConnectionString")
0790:
SqlText="Select count(playerid) as pCount from players where leagueid="& LID
0791:
Set rs = Cn.Execute(SqlText)
0792:
vCount=cint(rs("pCount"))
0793:
redim arrPlayers(vCount+1,2)
0794:
SqlText="Select playerid, name, RaceID from players where leagueid="& LID &" Order by RaceID,RankID,Name"
0795:
Set rs = Cn.Execute(SqlText)
0796:
if not rs.EOF then
0797:
i=1
0798:
rs.movefirst
0799:
do while not rs.EOF
0800:
arrPlayers(i,0)=rs("PlayerID")
0801:
arrPlayers(i,1)=rs("Name")
0802:
arrPlayers(i,2)=rs("RaceID")
0803:
rs.movenext
0804:
i=i+1
0805:
loop
0806:
end if
0807:
Cn.Close
0808:
set Cn=nothing
0809:
set rs=nothing
0810:
end sub
0811:
0812:
'********************************************************************
0813:
sub showPlayerSelect(strPlayer, strSelected, strAttributes,LID)
0814:
'********************************************************************
0815:
' NOTE:
0816:
' default selection of first item when no value selected
0817:
0818:
dim RS
0819:
dim Cn
0820:
dim SqlText
0821:
dim i, PID
0822:
Set cn = Server.CreateObject("ADODB.Connection")
0823:
Cn.Open application("SFC_ConnectionString")
0824:
SqlText="Select * from Players where LeagueID="&LID&" order by Name"
0825:
0826:
Set rs = Cn.Execute(SqlText)
0827:
0828:
response.write "<select " & strAttributes & " name='" & strPlayer & "'>"
0829:
response.write "<option value=''>Please Select Player</option>"
0830:
0831:
if not rs.EOF then
0832:
rs.movefirst
0833:
0834:
do while not rs.EOF
0835:
PID=rs("PlayerID")
0836:
response.write "<option value='"& PID & "' " & showSelected(strSelected,PID,"selected") & ">" & rs("Name") & "</option>"&vbCrLf
0837:
rs.movenext
0838:
loop
0839:
response.write "</select>"
0840:
else
0841:
response.write "(no data found)"
0842:
response.write "</select>"
0843:
'response.write "<input type='hidden' name='" & strPlayer & "' value=''>"
0844:
end if
0845:
Cn.Close
0846:
set Cn=nothing
0847:
set rs=nothing
0848:
end sub
0849:
'********************************************************************
0850:
sub showShipCondition(strName, strSelected, strAttributes)
0851:
'********************************************************************
0852:
Dim vClass
0853:
Set cn = Server.CreateObject("ADODB.Connection")
0854:
Cn.Open application("SFC_ConnectionString")
0855:
qry="select * from Condition order by ConditionValue "
0856:
set rs= Cn.Execute(qry)
0857:
if not rs.eof then
0858:
rs.Movefirst
0859:
response.write "<select " & strAttributes & " name='" & strName & "'>"
0860:
do while not rs.eof
0861:
vClass= rs("ConditionValue")
0862:
response.write "<option value='"&vClass & "' " & showSelected(strSelected, vClass,"selected") & ">" & rs("Condition") & "</option>&vbCrLf"
0863:
rs.Movenext
0864:
loop
0865:
response.write "</select>"
0866:
else
0867:
response.write "(no data found)"
0868:
response.write "</select>"
0869:
'response.write "<input type='hidden' name='" & strName & "' value=''>"
0870:
end if
0871:
0872:
Cn.Close
0873:
set cn=nothing
0874:
end sub
0875:
0876:
0877:
0878:
'********************************************************************
0879:
' procedure: funFormatDateTimeWrap
0880:
' purpose: this function uses the vbs formatDateTime(), but handles
0881:
' empty and null string values
0882:
'********************************************************************
0883:
function funFormatDateTimeWrap(vDate,vNamedFormat)
0884:
on error resume next
0885:
0886:
if isDate(vDate) then
0887:
funFormatDateTimeWrap = formatDateTime(vDate,vNamedFormat)
0888:
else
0889:
funFormatDateTimeWrap = ""
0890:
end if
0891:
0892:
if Err.number <> 0 then
0893:
formatDataTimeWrap = ""
0894:
end if
0895:
0896:
' reset error handler
0897:
on error goto 0
0898:
end function
0899:
0900:
0901:
'********************************************************************
0902:
' procedure: formatCurrencyWrap
0903:
' purpose: this function uses the vbs formatCurrency(), but handles
0904:
' empty and null string values
0905:
'********************************************************************
0906:
0907:
function funFormatCurrencyWrap(vData, sOptions,vReturn)
0908:
on error resume next
0909:
' *** ARGUMENTS ***
0910:
' vData: data to format, expression sent to formatCurrency()
0911:
' Valid values = numeric values
0912:
' sOptions: contains array of options normally sent to formatNumber()
0913:
' sOptions(0) expression
0914:
' Valid values = positive values
0915:
' sOptions([1-3]) TristateContstants
0916:
' Valid values = -1, 0, -2 (true, false, use regional settings)
0917:
' vReturn: value to return when vData is empty/null string/errors
0918:
' Valid values = variant
0919:
0920:
' formatNumber() options
0921:
dim NumDigitsAfterDecimal ' -1 use regional settings
0922:
dim IncludeLeadingDigit ' TristateConstant
0923:
dim UseParensForNegativeNumbers ' TristateConstant
0924:
dim GroupDigits ' TristateConstant
0925:
0926:
dim rayOptions
0927:
0928:
' build array for formatNumber() options
0929:
rayOptions = split(sOptions,",")
0930:
0931:
if ( isArray(rayOptions) )then
0932:
select case uBound(rayOptions)
0933:
case 0
0934:
NumDigitsAfterDecimal = rayOptions(0)
0935:
IncludeLeadingDigit = -2
0936:
UseParensForNegativeNumbers = -2
0937:
GroupDigits = -2
0938:
case 1
0939:
NumDigitsAfterDecimal = rayOptions(0)
0940:
IncludeLeadingDigit = rayOptions(1)
0941:
UseParensForNegativeNumbers = -2
0942:
GroupDigits = -2
0943:
case 2
0944:
NumDigitsAfterDecimal = rayOptions(0)
0945:
IncludeLeadingDigit = rayOptions(1)
0946:
UseParensForNegativeNumbers = rayOptions(2)
0947:
GroupDigits = -2
0948:
case 3
0949:
NumDigitsAfterDecimal = rayOptions(0)
0950:
IncludeLeadingDigit = rayOptions(1)
0951:
UseParensForNegativeNumbers = rayOptions(2)
0952:
GroupDigits = rayOptions(3)
0953:
case else
0954:
NumDigitsAfterDecimal = -1
0955:
IncludeLeadingDigit = -2
0956:
UseParensForNegativeNumbers = -2
0957:
GroupDigits = -2
0958:
end select
0959:
else
0960:
NumDigitsAfterDecimal = -1
0961:
IncludeLeadingDigit = -2
0962:
UseParensForNegativeNumbers = -2
0963:
GroupDigits = -2
0964:
end if
0965:
0966:
' concatenation of null string prevents the existence of empty
0967:
' variables which isNumeric() evaluates as true
0968:
if (isNumeric(vData & "")) then
0969:
funFormatCurrencyWrap = formatCurrency(cStr(vData),NumDigitsAfterDecimal,IncludeLeadingDigit,UseParensForNegativeNumbers,GroupDigits)
0970:
else
0971:
funFormatCurrencyWrap = vReturn
0972:
end if
0973:
0974:
' true: error occurred, return vReturn
0975:
if Err.number <> 0 then
0976:
funFormatCurrencyWrap = vReturn
0977:
end if
0978:
0979:
' reset error handler
0980:
on error goto 0
0981:
end function
0982:
0983:
'********************************************************************
0984:
' procedure: funFormatNumberWrap
0985:
' purpose: this function uses the vbs formatNumber(), but handles
0986:
' empty and null string values
0987:
'********************************************************************
0988:
function funFormatNumberWrap(vData, sOptions,vReturn)
0989:
on error resume next
0990:
' *** ARGUMENTS ***
0991:
' vData: data to format, expression sent to formatNumber()
0992:
' Valid values = numeric values
0993:
' sOptions: contains array of options normally sent to formatNumber()
0994:
' sOptions(0) expression
0995:
' Valid values = positive values
0996:
' sOptions([1-3]) TristateContstants
0997:
' Valid values = -1, 0, -2 (true, false, use regional settings)
0998:
' vReturn: value to return when vData is empty/null string/errors
0999:
' Valid values = variant
1000:
1001:
' formatNumber() options
1002:
dim NumDigitsAfterDecimal ' -1 use regional settings
1003:
dim IncludeLeadingDigit ' TristateConstant
1004:
dim UseParensForNegativeNumbers ' TristateConstant
1005:
dim GroupDigits ' TristateConstant
1006:
1007:
dim rayOptions
1008:
1009:
' build array for formatNumber() options
1010:
rayOptions = split(sOptions,",")
1011:
1012:
if ( isArray(rayOptions) )then
1013:
select case uBound(rayOptions)
1014:
case 0
1015:
NumDigitsAfterDecimal = rayOptions(0)
1016:
IncludeLeadingDigit = -2
1017:
UseParensForNegativeNumbers = -2
1018:
GroupDigits = -2
1019:
case 1
1020:
NumDigitsAfterDecimal = rayOptions(0)
1021:
IncludeLeadingDigit = rayOptions(1)
1022:
UseParensForNegativeNumbers = -2
1023:
GroupDigits = -2
1024:
case 2
1025:
NumDigitsAfterDecimal = rayOptions(0)
1026:
IncludeLeadingDigit = rayOptions(1)
1027:
UseParensForNegativeNumbers = rayOptions(2)
1028:
GroupDigits = -2
1029:
case 3
1030:
NumDigitsAfterDecimal = rayOptions(0)
1031:
IncludeLeadingDigit = rayOptions(1)
1032:
UseParensForNegativeNumbers = rayOptions(2)
1033:
GroupDigits = rayOptions(3)
1034:
case else
1035:
NumDigitsAfterDecimal = -1
1036:
IncludeLeadingDigit = -2
1037:
UseParensForNegativeNumbers = -2
1038:
GroupDigits = -2
1039:
end select
1040:
else
1041:
NumDigitsAfterDecimal = -1
1042:
IncludeLeadingDigit = -2
1043:
UseParensForNegativeNumbers = -2
1044:
GroupDigits = -2
1045:
end if
1046:
1047:
' concatenation of null string prevents the existence of empty
1048:
' variables which isNumeric() evaluates as true
1049:
if (isNumeric(vData & "")) then
1050:
funFormatNumberWrap = formatNumber(cStr(vData),NumDigitsAfterDecimal,IncludeLeadingDigit,UseParensForNegativeNumbers,GroupDigits)
1051:
else
1052:
funFormatNumberWrap = vReturn
1053:
end if
1054:
1055:
' true: error occurred, return vReturn
1056:
if Err.number <> 0 then
1057:
funFormatNumberWrap = vReturn
1058:
end if
1059:
1060:
' reset error handler
1061:
on error goto 0
1062:
end function
1063:
1064:
'********************************************************************
1065:
' procedure: funFormatPercentWrap
1066:
' purpose: this function uses the vbs formatPercent(), but handles
1067:
' empty and null string values
1068:
'********************************************************************
1069:
function funFormatPercentWrap(vData, sOptions,vReturn)
1070:
'on error resume next
1071:
' *** ARGUMENTS ***
1072:
' vData: data to format, expression sent to formatNumber()
1073:
' Valid values = numeric values
1074:
' sOptions: contains array of options normally sent to formatNumber()
1075:
' sOptions(0) expression
1076:
' Valid values = positive values
1077:
' sOptions([1-3]) TristateContstants
1078:
' Valid values = -1, 0, -2 (true, false, use regional settings)
1079:
' vReturn: value to return when vData is empty/null string/errors
1080:
' Valid values = variant
1081:
1082:
' formatNumber() options
1083:
dim NumDigitsAfterDecimal ' -1 use regional settings
1084:
dim IncludeLeadingDigit ' TristateConstant
1085:
dim UseParensForNegativeNumbers ' TristateConstant
1086:
dim GroupDigits ' TristateConstant
1087:
1088:
dim rayOptions
1089:
1090:
' build array for formatNumber() options
1091:
rayOptions = split(sOptions,",")
1092:
1093:
if ( isArray(rayOptions) )then
1094:
select case uBound(rayOptions)
1095:
case 0
1096:
NumDigitsAfterDecimal = rayOptions(0)
1097:
IncludeLeadingDigit = -2
1098:
UseParensForNegativeNumbers = -2
1099:
GroupDigits = -2
1100:
case 1
1101:
NumDigitsAfterDecimal = rayOptions(0)
1102:
IncludeLeadingDigit = rayOptions(1)
1103:
UseParensForNegativeNumbers = -2
1104:
GroupDigits = -2
1105:
case 2
1106:
NumDigitsAfterDecimal = rayOptions(0)
1107:
IncludeLeadingDigit = rayOptions(1)
1108:
UseParensForNegativeNumbers = rayOptions(2)
1109:
GroupDigits = -2
1110:
case 3
1111:
NumDigitsAfterDecimal = rayOptions(0)
1112:
IncludeLeadingDigit = rayOptions(1)
1113:
UseParensForNegativeNumbers = rayOptions(2)
1114:
GroupDigits = rayOptions(3)
1115:
case else
1116:
NumDigitsAfterDecimal = -1
1117:
IncludeLeadingDigit = -2
1118:
UseParensForNegativeNumbers = -2
1119:
GroupDigits = -2
1120:
end select
1121:
else
1122:
NumDigitsAfterDecimal = -1
1123:
IncludeLeadingDigit = -2
1124:
UseParensForNegativeNumbers = -2
1125:
GroupDigits = -2
1126:
end if
1127:
1128:
' concatenation of null string prevents the existence of empty
1129:
' variables which isNumeric() evaluates as true
1130:
if (isNumeric(vData & "")) then
1131:
funFormatPercentWrap = formatPercent(cStr(vData),NumDigitsAfterDecimal,IncludeLeadingDigit,UseParensForNegativeNumbers,GroupDigits)
1132:
else
1133:
funFormatPercentWrap = vReturn
1134:
end if
1135:
1136:
' true: error occurred, return vReturn
1137:
if Err.number <> 0 then
1138:
funFormatPercentWrap = vReturn
1139:
end if
1140:
1141:
' reset error handler
1142:
on error goto 0
1143:
end function
1144:
'********************************************************************
1145:
' procedure: funReturnSQLData
1146:
' purpose: returns data formated to pass to stored procedure
1147:
'
1148:
'********************************************************************
1149:
'constants used for funReturnSQLData
1150:
CONST RETURN_NULL = 0
1151:
CONST RETURN_EMPTY_STRING = 1
1152:
CONST RETURN_QUOTED_STRING = 2
1153:
CONST RETURN_NULL_LITERAL = 3
1154:
CONST RETURN_ZERO = 4
1155:
1156:
function funReturnSQLData(vData, intVarType, intReturnDefault)
1157:
if not(blnShowError) then on error resume next end if
1158:
1159:
'TO DO
1160:
' FIX DATA TYPES = vbLong, vbSingle, vbDouble
1161:
' "," and "." pass isNumeric test for vbInteger below consider
1162:
' removing "," and failing on "."
1163:
1164:
' *** ARGUMENTS ***
1165:
' vData: data to format
1166:
' Valid values = varint
1167:
' intVarType: subtype of variable returned by vbs function varType()
1168:
' Valid values = vbConstant
1169:
' intReturnDefault: value to return when vData is empty/null string or errors occur
1170:
' Valid values = constants (RETURN_NULL_LITERAL, RETURN_ZERO)
1171:
dim vReturnData ' hold actual data function will return
1172:
dim vReturnDefault ' hold return when vData is empty/null string or errors occur
1173:
1174:
' set strReturn
1175:
select case intReturnDefault
1176:
case RETURN_NULL
1177:
vReturnDefault= NULL
1178:
case RETURN_EMPTY_STRING
1179:
vReturnDefault = ""
1180:
case RETURN_QUOTED_STRING
1181:
vReturnDefault = "''"
1182:
Case RETURN_NULL_LITERAL
1183:
vReturnDefault = "NULL"
1184:
case RETURN_ZERO
1185:
vReturnDefault = 0
1186:
case else
1187:
vReturnDefault = "''"
1188:
end select
1189:
1190:
select case intVarType
1191:
case vbInteger '2
1192:
' concatenation of null string prevents the existence of empty
1193:
' variables which isNumeric() evaluates as true
1194:
if (isNumeric(vData & "")) then
1195:
1196:
vReturnData = vData
1197:
else
1198:
vReturnData = vReturnDefault
1199:
end if
1200:
case vbLong '3
1201:
vReturnData = vData
1202:
case vbSingle '4
1203:
vReturnData = vData
1204:
case vbDouble '5
1205:
vReturnData = vData
1206:
case vbDate '7
1207:
if isDate(vData & "") then
1208:
vReturnData = "'" & _
1209:
funFormatDateTimeWrap(vData,vbGeneralDate) & _
1210:
"'"
1211:
else
1212:
vReturnData = vReturnDefault
1213:
end if
1214:
case vbString '8
1215:
' wrap data in quotes to pass through sp
1216:
if (trim(vData & "") = "") then
1217:
vReturnData = vReturnDefault
1218:
else
1219:
vReturnData = "'" & funReplaceSingleQuotes(vData) & "'"
1220:
end if
1221:
case vbBoolean '11
1222:
'boolean is handled as bit( true/false = 1/0), no boolean in sql
1223:
vReturnData = funHandleBit(vData,0,0)
1224:
case else
1225:
vReturnData = vReturnDefault
1226:
end select
1227:
1228:
if Err.number <> 0 then
1229:
funReturnSQLData = vReturnDefault
1230:
else
1231:
funReturnSQLData = vReturnData
1232:
end if
1233:
1234:
' reset error handler
1235:
on error goto 0
1236:
end function
1237:
'********************************************************************
1238:
' procedure: funReplaceSingleQuotes
1239:
' purpose: replaces sigle quotes with chr(96)
1240:
'********************************************************************
1241:
function funReplaceSingleQuotes(sData)
1242:
If Not (sData & "") = "" Then
1243:
funReplaceSingleQuotes = Replace(sData, "'", Chr(96))
1244:
End If
1245:
End Function
1246:
'********************************************************************
1247:
' procedure: funHandleBit
1248:
' purpose: handle bit at the page level
1249:
'
1250:
' vData = variable to be testd
1251:
' vBitTextFlg = identifies return: bit (0 = 0/1) or text (1 = Yes/No)
1252:
' vReturnEmptyString = itdentifies returns for an empty/null
1253:
' vReturnEmptyString = 1 empty/null returns emtpy string
1254:
' vReturnEmptyString = 0 empty/null requested returnType
1255:
'********************************************************************
1256:
function funHandleBit(vData,vBitTextFlg, vReturnEmptyString)
1257:
if ((trim(vData) = "") or (isNull(vData)))then
1258:
if (vReturnEmptyString) then
1259:
funHandleBit = ""
1260:
else
1261:
if(vBitTextFlg) then
1262:
funHandleBit = "No"
1263:
else
1264:
funHandleBit = 0
1265:
end if
1266:
end if
1267:
else
1268:
if(vData) then
1269:
if(vBitTextFlg) then
1270:
funHandleBit = "Yes"
1271:
else
1272:
funHandleBit = 1
1273:
end if
1274:
else
1275:
if(vBitTextFlg) then
1276:
funHandleBit = "No"
1277:
else
1278:
funHandleBit = 0
1279:
end if
1280:
end if
1281:
end if
1282:
end function
1283:
'********************************************************************
1284:
function getRaceName(RID)
1285:
dim CnRn, Rs, qry, tmp
1286:
Set CnRn = Server.CreateObject("ADODB.Connection")
1287:
CnRn.Open application("SFC_ConnectionString")
1288:
tmp=""
1289:
if RID<>"" then
1290:
qry="select name from race where raceid="&RID
1291:
set rs= CnRn.Execute(qry)
1292:
tmp = rs("Name")
1293:
end if
1294:
getRaceName=tmp
1295:
set rs = nothing
1296:
set CnRn=nothing
1297:
end function
1298:
'********************************************************************
1299:
function getPlayerName(PID)
1300:
dim CnP, Rs, qry, tmp
1301:
Set CnP = Server.CreateObject("ADODB.Connection")
1302:
CnP.Open application("SFC_ConnectionString")
1303:
tmp=""
1304:
if PID<>"" and PID<>"0" then
1305:
qry="select name from Players where Playerid="&PID
1306:
set rs= CnP.Execute(qry)
1307:
if not rs.eof then
1308:
tmp = rs("Name")
1309:
else
1310:
tmp=PID
1311:
end if
1312:
end if
1313:
getPlayerName=tmp
1314:
set rs = nothing
1315:
set CnP=nothing
1316:
end function
1317:
'********************************************************************
1318:
1319:
function getPlayerEmail(PID)
1320:
dim CnP, Rs, qry, tmp
1321:
Set CnP = Server.CreateObject("ADODB.Connection")
1322:
CnP.Open application("SFC_ConnectionString")
1323:
tmp=""
1324:
if PID<>"" and PID<>"0" then
1325:
qry="select email from Players where Playerid="&PID
1326:
set rs= CnP.Execute(qry)
1327:
tmp = rs("email")
1328:
end if
1329:
getPlayerEmail=tmp
1330:
set rs = nothing
1331:
set CnP=nothing
1332:
end function
1333:
'********************************************************************
1334:
function getShipClassName(SID)
1335:
dim Cnsc, Rs, qry, tmp
1336:
Set Cnsc = Server.CreateObject("ADODB.Connection")
1337:
Cnsc.Open application("SFC_ConnectionString")
1338:
tmp=""
1339:
if SID<>"" and SID<>"0" then
1340:
qry="select class from class where ShipClassID="&SID
1341:
set rs= Cnsc.Execute(qry)
1342:
tmp = rs("class")
1343:
end if
1344:
getShipClassName=tmp
1345:
set rs = nothing
1346:
set Cssc = nothing
1347:
end function
1348:
'********************************************************************
1349:
function getConditionName(CID)
1350:
dim CnC, Rs, qry, tmp
1351:
Set CnC = Server.CreateObject("ADODB.Connection")
1352:
CnC.Open application("SFC_ConnectionString")
1353:
tmp=""
1354:
if CID<>"" and CID<>"0" then
1355:
qry="select Condition from condition where conditionvalue="&CID
1356:
set rs= CnC.Execute(qry)
1357:
tmp = rs("condition")
1358:
end if
1359:
getConditionName=tmp
1360:
set rs = nothing
1361:
set CnC=nothing
1362:
end function
1363:
1364:
'********************************************************************
1365:
function getRank(RID)
1366:
dim CnC, Rs, qry, tmp
1367:
Set CnC = Server.CreateObject("ADODB.Connection")
1368:
CnC.Open application("SFC_ConnectionString")
1369:
tmp=""
1370:
if RID<>"" and RID<>"0" then
1371:
qry="select Rank from Ranks where RankID="&RID
1372:
set rs= CnC.Execute(qry)
1373:
tmp = rs("Rank")
1374:
end if
1375:
getRank=tmp
1376:
set rs = nothing
1377:
set CnC=nothing
1378:
end function
1379:
'********************************************************************
1380:
function getLeague(LID)
1381:
dim Cnsc, Rs, qry, tmp
1382:
Set Cnsc = Server.CreateObject("ADODB.Connection")
1383:
Cnsc.Open application("SFC_ConnectionString")
1384:
tmp=""
1385:
if LID<>"" and LID<>"0" then
1386:
qry="select Name from League where LeagueID="&LID
1387:
set rs= Cnsc.Execute(qry)
1388:
tmp = rs("Name")
1389:
end if
1390:
getLeague=tmp
1391:
set rs = nothing
1392:
set Cssc = nothing
1393:
end function
1394:
'********************************************************************
1395:
sub Email(Vfrom,Vto,Vsubj,Vtitle,Vbody, vresponse)
1396:
'Response.Write("<p>"& Vfrom&" </p><p>"&vTo &"</p><p> "&Vtitle &"</p><p> "&Vbody&"</p>")
1397:
Dim MyCDONTSMail2
1398:
Dim HTML
1399:
Set MyCDONTSMail2 = CreateObject("CDONTS.NewMail")
1400:
HTML = "<!DOCTYPE HTML PUBLIC""-//IETF//DTD HTML//EN"">"
1401:
HTML = HTML & "<html>"
1402:
HTML = HTML & "<head>"
1403:
HTML = HTML & "<title>" & Vtitle & "</title>"
1404:
HTML = HTML & "</head>"
1405:
HTML = HTML & Vbody
1406:
HTML = HTML & "</html>"
1407:
MyCDONTSMail2.From= Vfrom
1408:
'MyCDONTSMail2.CC=Vfrom
1409:
MyCDONTSMail2.To=Vto
1410:
MyCDONTSMail2.Subject= Vsubj
1411:
MyCDONTSMail2.BodyFormat=0
1412:
MyCDONTSMail2.MailFormat=0
1413:
MyCDONTSMail2.Body=HTML
1414:
MyCDONTSMail2.Send
1415:
set MyCDONTSMail2=nothing
1416:
Response.Write(vresponse)
1417:
End sub
1418:
function getplayers()
1419:
dim cn, rs, temp, qry
1420:
set rs = Server.CreateObject("ADODB.recordset")
1421:
Set cn = Server.CreateObject("ADODB.Connection")
1422:
Cn.Open "MREG"
1423:
qry = "select LoginName,signinTime, SessionID from logins"
1424:
set rs=Cn.Execute(qry)
1425:
if not rs.eof then
1426:
rs.MoveFirst
1427:
do while not rs.EOF
1428:
temp=temp & rs("LoginName")&" since "& rs("signinTime") &"<br>"
1429:
rs.MoveNext
1430:
loop
1431:
end if
1432:
Cn.Close
1433:
set rs = nothing
1434:
set Cn=nothing
1435:
getplayers="<br><font size=1>"&temp&"</font>"
1436:
end function
1437:
%
>
1438: