Advertisement

09.16.2008 at 05:02PM PDT, ID: 23737097 | Points: 500
[x]
Attachment Details

How do I get my email page feature to send?

Asked by twersk in Active Server Pages (ASP), Web Development

Tags: , ,

I am getting the following error:

CDO.Message.1 error '80040213'

The transport failed to connect to the server.

/includes/core.asp, line 700

---------------------------------
Somewhere, around line 700 of the attached snippet, I need to program something that will allow my email page to SEND. When it opens, you can fill it, but it leads to the above error when you try to SEND.  Link is on every page except index.

What do I do please?Start Free Trial
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:
327:
328:
329:
330:
331:
332:
333:
334:
335:
336:
337:
338:
339:
340:
341:
342:
343:
344:
345:
346:
347:
348:
349:
350:
351:
352:
353:
354:
355:
356:
357:
358:
359:
360:
361:
362:
363:
364:
365:
366:
367:
368:
369:
370:
371:
372:
373:
374:
375:
376:
377:
378:
379:
380:
381:
382:
383:
384:
385:
386:
387:
388:
389:
390:
391:
392:
393:
394:
395:
396:
397:
398:
399:
400:
401:
402:
403:
404:
405:
406:
407:
408:
409:
410:
411:
412:
413:
414:
415:
416:
417:
418:
419:
420:
421:
422:
423:
424:
425:
426:
427:
428:
429:
430:
431:
432:
433:
434:
435:
436:
437:
438:
439:
440:
441:
442:
443:
444:
445:
446:
447:
448:
449:
450:
451:
452:
453:
454:
455:
456:
457:
458:
459:
460:
461:
462:
463:
464:
465:
466:
467:
468:
469:
470:
471:
472:
473:
474:
475:
476:
477:
478:
479:
480:
481:
482:
483:
484:
485:
486:
487:
488:
489:
490:
491:
492:
493:
494:
495:
496:
497:
498:
499:
500:
501:
502:
503:
504:
505:
506:
507:
508:
509:
510:
511:
512:
513:
514:
515:
516:
517:
518:
519:
520:
521:
522:
523:
524:
525:
526:
527:
528:
529:
530:
531:
532:
533:
534:
535:
536:
537:
538:
539:
540:
541:
542:
543:
544:
545:
546:
547:
548:
549:
550:
551:
552:
553:
554:
555:
556:
557:
558:
559:
560:
561:
562:
563:
564:
565:
566:
567:
568:
569:
570:
571:
572:
573:
574:
575:
576:
577:
578:
579:
580:
581:
582:
583:
584:
585:
586:
587:
588:
589:
590:
591:
592:
593:
594:
595:
596:
597:
598:
599:
600:
601:
602:
603:
604:
605:
606:
607:
608:
609:
610:
611:
612:
613:
614:
615:
616:
617:
618:
619:
620:
621:
622:
623:
624:
625:
626:
627:
628:
629:
630:
631:
632:
633:
634:
635:
636:
637:
638:
639:
640:
641:
642:
643:
644:
645:
646:
647:
648:
649:
650:
651:
652:
653:
654:
655:
656:
657:
658:
659:
660:
661:
662:
663:
664:
665:
666:
667:
668:
669:
670:
671:
672:
673:
674:
675:
676:
677:
678:
679:
680:
681:
682:
683:
684:
685:
686:
687:
688:
689:
690:
691:
692:
693:
694:
695:
696:
697:
698:
699:
700:
701:
702:
703:
704:
705:
706:
707:
708:
709:
710:
711:
712:
713:
714:
715:
716:
717:
718:
719:
720:
721:
722:
723:
724:
725:
726:
727:
728:
729:
730:
731:
732:
733:
734:
735:
736:
737:
738:
739:
740:
741:
742:
743:
744:
745:
746:
747:
748:
749:
750:
751:
752:
753:
754:
755:
756:
757:
758:
759:
760:
761:
762:
763:
764:
765:
766:
767:
768:
769:
770:
771:
772:
773:
774:
775:
776:
777:
778:
779:
780:
781:
782:
783:
784:
785:
786:
787:
788:
789:
790:
791:
792:
793:
794:
795:
796:
797:
798:
799:
800:
801:
802:
803:
804:
805:
806:
807:
808:
809:
810:
811:
812:
813:
814:
815:
816:
817:
818:
819:
820:
821:
822:
823:
824:
825:
826:
827:
828:
829:
830:
831:
832:
833:
834:
835:
836:
837:
838:
839:
840:
841:
842:
843:
844:
845:
846:
847:
848:
849:
850:
851:
852:
853:
854:
855:
856:
857:
858:
859:
860:
861:
862:
863:
864:
865:
866:
867:
868:
869:
870:
871:
872:
873:
874:
875:
876:
877:
878:
879:
880:
881:
882:
883:
884:
885:
886:
887:
888:
889:
890:
891:
892:
893:
894:
895:
896:
897:
898:
899:
900:
901:
902:
903:
904:
905:
906:
907:
908:
909:
910:
911:
912:
913:
914:
915:
916:
917:
918:
919:
920:
921:
922:
923:
924:
925:
926:
927:
928:
929:
930:
931:
932:
933:
934:
935:
936:
937:
938:
939:
940:
941:
942:
943:
944:
945:
946:
947:
948:
949:
950:
951:
952:
953:
954:
955:
956:
957:
958:
959:
960:
961:
962:
963:
964:
965:
966:
967:
968:
969:
970:
971:
972:
973:
974:
975:
976:
977:
978:
979:
980:
981:
982:
983:
984:
985:
986:
987:
988:
989:
990:
991:
992:
993:
994:
995:
996:
997:
998:
999:
1000:
1001:
1002:
1003:
1004:
1005:
1006:
1007:
1008:
1009:
1010:
1011:
1012:
1013:
1014:
1015:
1016:
1017:
1018:
1019:
1020:
1021:
1022:
1023:
1024:
1025:
1026:
1027:
1028:
1029:
1030:
1031:
1032:
1033:
1034:
1035:
1036:
1037:
1038:
1039:
1040:
1041:
1042:
1043:
1044:
1045:
1046:
1047:
1048:
1049:
1050:
1051:
1052:
1053:
1054:
1055:
1056:
1057:
1058:
1059:
1060:
1061:
1062:
1063:
1064:
1065:
1066:
1067:
1068:
1069:
1070:
1071:
1072:
1073:
1074:
1075:
1076:
1077:
1078:
1079:
1080:
1081:
1082:
1083:
1084:
1085:
1086:
1087:
1088:
1089:
1090:
1091:
1092:
1093:
1094:
1095:
1096:
1097:
1098:
1099:
1100:
1101:
1102:
1103:
1104:
1105:
1106:
1107:
1108:
1109:
1110:
1111:
1112:
1113:
1114:
1115:
1116:
1117:
1118:
1119:
1120:
1121:
1122:
1123:
1124:
1125:
1126:
1127:
1128:
1129:
1130:
1131:
1132:
1133:
1134:
1135:
1136:
1137:
1138:
1139:
1140:
1141:
1142:
1143:
1144:
1145:
1146:
1147:
1148:
1149:
1150:
1151:
1152:
1153:
1154:
1155:
1156:
1157:
1158:
1159:
1160:
1161:
1162:
1163:
1164:
1165:
1166:
1167:
1168:
1169:
1170:
1171:
1172:
1173:
1174:
1175:
1176:
1177:
1178:
1179:
1180:
1181:
1182:
1183:
1184:
1185:
1186:
1187:
1188:
1189:
1190:
1191:
1192:
1193:
1194:
1195:
1196:
1197:
1198:
1199:
1200:
1201:
1202:
1203:
1204:
1205:
1206:
1207:
1208:
1209:
1210:
1211:
1212:
1213:
1214:
1215:
1216:
1217:
1218:
1219:
1220:
1221:
1222:
1223:
1224:
1225:
1226:
1227:
1228:
1229:
1230:
1231:
1232:
1233:
1234:
1235:
1236:
1237:
1238:
1239:
1240:
1241:
1242:
1243:
1244:
1245:
1246:
1247:
1248:
1249:
1250:
1251:
1252:
1253:
1254:
1255:
1256:
1257:
1258:
1259:
1260:
1261:
1262:
1263:
1264:
1265:
1266:
1267:
1268:
1269:
1270:
1271:
1272:
1273:
1274:
1275:
1276:
1277:
1278:
1279:
1280:
1281:
1282:
1283:
1284:
1285:
1286:
1287:
1288:
1289:
1290:
1291:
1292:
1293:
1294:
1295:
1296:
1297:
1298:
1299:
1300:
1301:
1302:
1303:
1304:
1305:
1306:
1307:
1308:
1309:
1310:
1311:
1312:
1313:
1314:
1315:
1316:
1317:
1318:
1319:
1320:
1321:
1322:
1323:
1324:
1325:
1326:
1327:
1328:
1329:
1330:
1331:
1332:
1333:
1334:
1335:
1336:
1337:
1338:
1339:
1340:
1341:
1342:
1343:
1344:
1345:
1346:
1347:
1348:
1349:
1350:
1351:
1352:
1353:
1354:
1355:
1356:
1357:
1358:
1359:
1360:
1361:
1362:
1363:
1364:
1365:
1366:
1367:
1368:
1369:
1370:
1371:
1372:
1373:
1374:
1375:
1376:
1377:
1378:
1379:
1380:
1381:
1382:
1383:
1384:
1385:
1386:
1387:
1388:
1389:
1390:
1391:
1392:
1393:
1394:
1395:
1396:
1397:
1398:
1399:
1400:
1401:
1402:
1403:
1404:
1405:
1406:
1407:
1408:
1409:
1410:
1411:
1412:
1413:
1414:
1415:
1416:
1417:
1418:
1419:
1420:
1421:
1422:
1423:
1424:
1425:
1426:
1427:
1428:
1429:
1430:
1431:
1432:
1433:
1434:
1435:
1436:
1437:
1438:
1439:
1440:
1441:
1442:
1443:
1444:
1445:
1446:
1447:
1448:
1449:
1450:
1451:
1452:
1453:
1454:
1455:
1456:
1457:
1458:
1459:
1460:
1461:
1462:
1463:
1464:
1465:
1466:
1467:
1468:
1469:
1470:
1471:
1472:
1473:
1474:
1475:
1476:
1477:
1478:
1479:
1480:
1481:
1482:
1483:
1484:
1485:
1486:
1487:
1488:
1489:
1490:
1491:
1492:
1493:
1494:
1495:
1496:
1497:
1498:
1499:
1500:
1501:
1502:
1503:
1504:
1505:
1506:
1507:
1508:
1509:
1510:
1511:
1512:
1513:
1514:
1515:
1516:
1517:
1518:
1519:
1520:
1521:
1522:
1523:
1524:
1525:
1526:
1527:
1528:
1529:
1530:
1531:
1532:
1533:
1534:
1535:
1536:
1537:
1538:
1539:
1540:
1541:
1542:
1543:
1544:
1545:
1546:
1547:
1548:
1549:
1550:
1551:
1552:
1553:
1554:
1555:
1556:
1557:
1558:
1559:
1560:
1561:
1562:
1563:
1564:
1565:
1566:
1567:
1568:
1569:
1570:
1571:
1572:
1573:
1574:
1575:
1576:
1577:
1578:
1579:
1580:
1581:
1582:
1583:
1584:
1585:
1586:
1587:
1588:
1589:
1590:
1591:
1592:
1593:
1594:
1595:
1596:
1597:
1598:
1599:
1600:
1601:
1602:
1603:
1604:
1605:
1606:
1607:
1608:
1609:
1610:
1611:
1612:
1613:
1614:
1615:
1616:
1617:
1618:
1619:
1620:
1621:
1622:
1623:
1624:
1625:
1626:
1627:
1628:
1629:
1630:
1631:
1632:
1633:
1634:
1635:
1636:
1637:
1638:
1639:
1640:
1641:
1642:
1643:
1644:
1645:
1646:
1647:
1648:
1649:
1650:
1651:
1652:
1653:
1654:
1655:
1656:
1657:
1658:
1659:
1660:
1661:
1662:
1663:
1664:
1665:
1666:
1667:
1668:
1669:
1670:
1671:
1672:
1673:
1674:
1675:
1676:
1677:
1678:
1679:
1680:
1681:
1682:
1683:
1684:
1685:
1686:
1687:
1688:
1689:
1690:
1691:
1692:
1693:
1694:
1695:
1696:
1697:
1698:
1699:
1700:
1701:
1702:
1703:
1704:
1705:
1706:
1707:
<!-- #include virtual="/includes/global.asp" -->
<!-- #include virtual="/includes/error.asp" -->
<!-- #include virtual="/includes/validate.asp" -->
<!-- #include virtual="/includes/controls.asp" -->
<%
'VERIFY CONNECTION STRING
VerifyConnectionString()
 
' LOAD SYSTEM PARAMETERS
 
 
Function GenerateFileID()
	Dim sResult
 
	sResult = Server.Createobject("scriptlet.typelib").guid
	sResult = Replace(sResult, "{", "")
	sResult = Replace(sResult, "}", "")
	sResult = Replace(sResult, "-", "")
 
	GenerateFileID = Left(sResult,32)
End Function
 
Function QuoteCSV(sInput)
	Dim bDblQuote
 
	If Instr(sInput, ",") > 0 then
		bDblQuote = true
	end if
	If Instr(sInput, """") > 0 then
		bDblQuote = true
	end if
	If Instr(sInput, vbCrLf) > 0 then
		bDblQuote = true
	end if
 
	if bDblQuote then
		QuoteCSV = DblQuote(sInput)
	else
		QuoteCSV = sInput
	end if
End Function
 
Function DblQuote(s)
	Dim t
 
	If IsEmpty(s) Then
		DblQuote = ""
	Else
		t = Replace(s,"""","""""")
		t = Replace(t,vbCrLf," ")
		t = Trim(t)
		DblQuote = """" & t & """"
	End If
End Function
 
Sub VerifyConnectionString()
	Dim iLoop, bIsDesignDB, bIsDesignServer
	Dim sServerName
 
	'aAddresses = Split(GLOBAL_DESIGN_DB_SERVERS, ",")
	'bIsDesignDB = false
	'For iLoop = LBound(aAddresses) to UBound(aAddresses)
		'if Instr(UCase(GLOBAL_CONNECTION_STRING), aAddresses(iLoop)) > 0 then
		'	bIsDesignDB = true
		'	Exit For
		'end if
'	Next
 
	'sServerName = GetServerName()
	'aAddresses = Split(GLOBAL_DESIGN_SERVERS, ",")
	'bIsDesignServer = false
	'For iLoop = LBound(aAddresses) to UBound(aAddresses)
	'	if UCase(sServerName) = UCase(aAddresses(iLoop)) then
	'		bIsDesignServer = true
	'		Exit For
	'	end if
	'Next
 
	'VERIFY CONNECTION STRING AND SERVER
	If (bIsDesignServer and not bIsDesignDB) or (not bIsDesignServer and bIsDesignDB) then
		Response.Write "CONFIGURATION ERROR! Please change the database connection string"
		Response.End
	end if
End Sub
 
Function GetServerName()
	Dim oWshNetwork, sResult
	Set oWshNetwork = Server.CreateObject("WScript.Network")
 
	sResult = oWshNetwork.ComputerName
 
	set oWshNetwork = nothing
 
	GetServerName = sResult
End Function
 
Function FolderExists(folderspec)
	Dim fso
 
	FolderExists = false
 
	If Not IsEmpty(folderspec) Then
   		set fso = CreateObject("Scripting.FileSystemObject")
   		if not (fso.FolderExists(Server.MapPath(folderspec))) then
	   		set fso = nothing
		   	Exit Function
   		end if
   		set fso = nothing
  	End If
	FolderExists = true
End Function
 
Function FileExists(sFile)
	Dim oFSO
	Set oFSO = CreateObject("Scripting.FileSystemObject")
	FileExists = oFSO.FileExists(Server.MapPath(sFile))
	Set oFSO = Nothing
End Function
 
'we keep that function for backward compatibility
Function file_exists(sFile)
	Dim oFSO
	Set oFSO = CreateObject("Scripting.FileSystemObject")
	file_exists = oFSO.FileExists(Server.MapPath(sFile))
	Set oFSO = Nothing
End Function
 
Function QuoteMultiple(sMultiple)
	Dim aMultiple, iItem
	If IsEmpty(sMultiple) Then
		QuoteMultiple = "(NULL)"
		Exit Function
	End If
	aMultiple = Split(sMultiple, ",")
	For iItem = LBound(aMultiple) To UBound(aMultiple)
		aMultiple(iItem) = Quote(aMultiple(iItem))
	Next
	QuoteMultiple = "(" & Join(aMultiple, ",") & ")"
End Function
 
Function NumberMultiple(sMultiple)
	Dim aMultiple, iItem
	If IsEmpty(sMultiple) Then
		NumberMultiple = "(NULL)"
		Exit Function
	End If
	aMultiple = Split(sMultiple, ",")
	For iItem = LBound(aMultiple) To UBound(aMultiple)
		aMultiple(iItem) = Number(aMultiple(iItem))
	Next
	NumberMultiple = "(" & Join(aMultiple, ",") & ")"
End Function
 
Function ProtectParam(sInput)
	If IsEmpty(sInput) Then
		ProtectParam = ""
		Exit Function
	End If
	ProtectParam = Replace(sInput, ";","")
End Function
 
Function ChangeSortOrder(sKeyField, sTable, sSortField, sWhere, iKeyValue, sAction)
    Dim sSQL
    Dim res, NEXT_SORT_ORDER, NEXT_ID
    Dim iRowsAffected
 
    ChangeSortOrder = false
 
    sSQL = "SELECT top 1 " & sKeyField & "," & sSortField & " FROM " & sTable
    if sAction = "UP" then sSQL = sSQL & " WHERE " & sSortField & " < " else sSQL = sSQL & " WHERE " & sSortField & " > "
    sSQL = sSQL & "(SELECT " & sSortField & " FROM " & sTable & " WHERE " & sKeyField & "=" & Number(iKeyValue) & ")"
    if not IsEmpty(sWhere) then
        sSQL = sSQL & " AND " & sWhere
    end if
    sSQL = sSQL & " ORDER BY " & sSortField
    if sAction = "UP" then sSQL = sSQL & " DESC " else  sSQL = sSQL & " ASC "
    Response.Write sSQL & "<BR>"
 
    Trace(sSQL)
    set res = DB.Execute(sSQL)
    if not res.eof then
        NEXT_ID = res(sKeyField)
        NEXT_SORT_ORDER = res(sSortField)
    end if
    res.close
    set res = nothing
 
    if isEmpty(NEXT_ID) then Exit Function
 
    sSQL = "UPDATE " & sTable & " SET " & sSortField & "=(SELECT " & sSortField & " FROM " & sTable & " WHERE " & sKeyField & "=" & Number(iKeyValue) & ") WHERE " & sKeyField & "=" & Number(NEXT_ID)
    iRowsAffected = ExecuteSQL(sSQL)
    if DBErrors Or iRowsAffected = 0 then
        Exit Function
    End if
 
    sSQL = "UPDATE " & sTable & " SET " & sSortField & "=" & Number(NEXT_SORT_ORDER) & " WHERE " & sKeyField & "=" & Number(iKeyValue)
    iRowsAffected = ExecuteSQL(sSQL)
    if DBErrors Or iRowsAffected = 0 then
        Exit Function
    End if
 
    ChangeSortOrder = true
End Function
 
Function GetFilterFields()
	Dim obj, dctFields, sIterator, dct
 
	set dct = Server.CreateObject("Scripting.Dictionary")
 
	If InStr(1, Request.ServerVariables( "HTTP_CONTENT_TYPE" ), "multipart/form-data", 0 ) > 0 Then
		if not isObject(dGLOBAL_UPLOAD_OBJECT) then
			set dGLOBAL_UPLOAD_OBJECT = Server.CreateObject("SoftArtisans.FileUp")
		end if
		set obj = dGLOBAL_UPLOAD_OBJECT
	Else
		set obj = Request
	End If
 
	for each sIterator in obj.Form
		if UCase(Left(sIterator, 2)) = "F_" then dct(sIterator) = obj.Form(sIterator)
	next
	for each sIterator in Request.QueryString
		if UCase(Left(sIterator, 2)) = "F_" then dct(sIterator) = Request.QueryString(sIterator)
	next
	set GetFilterFields = dct
End Function
 
Function PassFilterFieldsForm(sExceptionList)
	Dim dct, sIterator, aException
 
	aException = Split(sExceptionList, "|")
	set dct = GetFilterFields()
	for each sIterator in dct
		if not IsInArray(aException, sIterator) then
		%><input type=hidden name="<%=sIterator%>" value="<%=HTMLEncode(dct(sIterator))%>"><%=vbCrLf%><%
		end if
	next
End Function
 
Function PassFilterFieldsURL(sExceptionList)
	Dim dct, sIterator, aException
	Dim sResult, sConn
 
	aException = Split(sExceptionList, "|")
	set dct = GetFilterFields()
	for each sIterator in dct
		if not IsInArray(aException, sIterator) then
			sResult = sResult & sConn & sIterator & "=" & URLEncode(dct(sIterator))
			sConn = "&"
		end if
	next
	PassFilterFieldsURL = sResult
End Function
 
Function iif(bCond, sTrue, sFalse)
	if bCond then
		iif = sTrue
	else
		iif = sFalse
	end if
End Function
 
Function Escape(s)
	Dim t
 
	If IsEmpty(s) Then
		Escape = "NULL"
	Else
		t = Replace(s,"'","\'")
		t = Trim(t)
		Escape = "'" & t & "'"
	End If
End Function
 
Function DeleteFile(FULL_FILE_NAME)
	Dim fso
 
	DeleteFile = false
	set fso = Server.CreateObject("Scripting.FileSystemObject")
	if fso.FileExists(Server.MapPath(FULL_FILE_NAME)) then fso.DeleteFile(Server.MapPath(FULL_FILE_NAME))
	set fso = nothing
 
	DeleteFile = true
End Function
 
Function GenerateFileName(FIELD_NAME)
	Dim sFullName, sExt
 
	GenerateFileName = ""
 
	sExt = GetFileExtension(dGLOBAL_UPLOAD_OBJECT.Form(FIELD_NAME).UserFileName)
 
	sFullName = getGuid
	if not IsEmpty(sExt) then sFullName = sFullName & "." & sExt
 
	GenerateFileName = sFullName
End Function
 
Function UploadFile(FILENAME_GUID, OLD_FILENAME_GUID, FIELD_NAME,  FILE_PATH)
	Dim sPath
 
	UploadFile = false
 
	if dGLOBAL_UPLOAD_OBJECT.Form(FIELD_NAME).TotalBytes = 0 then
		Session("ERROR_DESC") = "WRONG UPLOAD FILE NAME"
		Exit Function
	end if
 
	sPath = FILE_PATH
	if Right(sPath,1) <> "/" then sPath = sPath & "/"
	On Error Resume Next
	dGLOBAL_UPLOAD_OBJECT.Form(FIELD_NAME).SaveAs(Server.mappath(sPath & FILENAME_GUID))
	If Err then
		Session("ERROR_DESC") = "WRONG UPLOAD FILE NAME"
		Exit Function
	End if
	call DeleteFile(sPath & OLD_FILENAME_GUID)
 
	UploadFile = true
End Function
 
Function GetGUID()
	Dim sResult
 
	sResult = Server.Createobject("scriptlet.typelib").guid
	sResult = Replace(sResult, "{", "")
	sResult = Replace(sResult, "}", "")
	sResult = Replace(sResult, "-", "")
 
	GetGUID = Left(sResult,32)
End Function
 
Function MergeArrays(aArray1, aArray2)
	Dim iArrayIndex
	For iArrayIndex = LBound(aArray2) To UBound(aArray2)
		ReDim Preserve aArray1(UBound(aArray1) + 1)
		aArray1(UBound(aArray1)) = aArray2(iArrayIndex)
	Next
	MergeArrays = aArray1
End Function
 
Function DisplayOrdinal(n)
	Dim sAppend
 
    sAppend = "th"
    If isNumeric(n) then
	    if right(cstr(n),1)="1" then
            if right(cstr(n),2) <> "11" then
                sAppend = "st"
            end if
        elseif right(cstr(n),1)="2" then
            if right(cstr(n),2)<>"12" then
                sAppend = "nd"
            end if
        elseif right(cstr(n),1)="3" then
            if right(cstr(n),2)<>"13" then
                sAppend = "rd"
            end if
        end if
        DisplayOrdinal = cstr(n) & sAppend
    End if
End Function
 
 
 
 
' **
' Signature:
'		GetParam(sSysParamName)
' Type :
'		Function
' Parameters :
'		- sSysParamName : name of the parameter value to be returned. Key of the dictionary.
' Returns :
'		- System parameter value.
'	Assumptions:
'		- Existing dGLOBAL_SYSTEM_PARAMETERS dictionary with system parameters.
' **
Function GetParam(sSysParamName)
	Dim sSQL, rsSysparams
 
	Trace(sSysParamName & " = " & dGLOBAL_SYSTEM_PARAMETERS(sSysParamName))
 
	GetParam = dGLOBAL_SYSTEM_PARAMETERS(sSysParamName)
End Function
 
' **
' Signature:
'		YesNo(sInput)
' Type :
'		Function
' Parameters :
'		- sInput : string or null to be tested.
' Returns :
'		- "Yes" when string is not null or not empty.
'		- "No" when string is null or empty.
'	Assumptions:
'		- Existing dGLOBAL_SYSTEM_PARAMETERS dictionary with system parameters.
' **
Function YesNo(sInput)
    if not isEmpty(sInput) then
        if IsNumeric(sInput) then
            if CLng(sInput) > 0 then
                YesNo = "<B><FONT color=green>YES</FONT></B>"
            else
                YesNo = "<B><FONT color=red>NO</FONT></B>"
            end if
        else
            YesNo = "<B><FONT color=green>YES</FONT></B>"
        end if
    else
        YesNo = "<B><FONT color=red>NO</FONT></B>"
    end if
End Function
 
' **
' Signature:
'		URLDecode(sURL)
' Type :
'		Function
' Parameters :
'		- sInput : string to be url decoded (removed url special characters).
' Returns :
'		- decoded string
'	Assumptions:
'		- {nothing}
' **
Function URLDecode(sInput)
	Dim x, sResult
 
	if len(sInput) > 0 then
		sInput = replace (sInput, "+", " ")
	end if
 
	x = InStr(sInput,"%")
	Do While x > 0
		sResult = sResult & Mid(sInput,1,x-1)
		If LCase(Mid(sInput,x+1,1)) = "u" Then
			sResult = sResult & ChrW(CLng("&H" & Mid(sInput,x+2,4)))
			sInput = Mid(sInput,x+6)
		Else
			sResult = sResult & Chr(CLng("&H" & Mid(sInput,x+1,2)))
			sInput = Mid(sInput,x+3)
		End If
		x = InStr(sInput,"%")
	Loop
 
	URLDecode = sResult & sInput
End Function
 
' **
' Signature:
'		Str2URL(sURL)
' Type :
'		Function
' Parameters :
'		- sURL : string, url to be sufixed with "http://" for use in URLs
' Returns :
'		- http:// + sURL
'	Assumptions:
'		- {nothing}
' **
Function Str2URL(sURL)
	Str2URL = ""
	If IsEmpty(sURL) then
		Exit Function
	End if
 
	if Ucase(Left(sURL,7)) = "HTTP://" then
		Str2URL = sURL
		Exit Function
	end if
 
	if Ucase(Left(sURL,8)) = "HTTPS://" then
		Str2URL = sURL
		Exit Function
	end if
 
	Str2URL = "http://" & sURL
End Function
 
' **
' Signature:
'		Write(sString)
' Type :
'		Function
' Parameters :
'		- sString : string to be responded to the current device (usually HTML).
' Returns :
'		- {nothing}
' Output :
'		- string
'	Assumptions:
'		- {nothing}
' **
Function Write(sString)
	Response.Write sString
End Function
 
 
' **
' Signature:
'		Write(sString)
' Type :
'		Function
' Parameters :
'		- sString : string to be responded to the current device (usually HTML).
' Returns :
'		- {nothing}
' Output :
'		- string and carriege return.
'	Assumptions:
'		- {nothing}
' **
Function WriteLn(sString)
	Response.Write sString & vbCrLf
End Function
 
' **
' Signature:
'		GetArraySize(aArray)
' Type :
'		Function
' Parameters :
'		- aArray : one dimentional array
' Returns :
'		- integer >=0, length of the array
'		- integer -1, error
' Output :
'		- {nothing}
'	Assumptions:
'		- {nothing}
' **
Function GetArraySize(aArray)
	Dim SIZE
	On Error Resume Next
 
	SIZE = UBound(aArray)
	if Err then
		GetArraySize = -1
	Else
		GetArraySize = SIZE
	End if
End Function
 
' **
' Signature:
'		DateTimeStart(sDate)
' Type :
'		Function
' Parameters :
'		- sDate : short date expression (no time)
' Returns :
'		- date and time expression; time is set to start of the day. Usefull when comparing date ranges in SQL operations.
' Output :
'		- {nothing}
'	Assumptions:
'		- the input must be a valid date expression formated like mm/dd/yy with two or four digits for the year.
' **
Function DateTimeStart(sDate)
	Dim ArrayDATE
	Dim y, t
 
	If IsEmpty(sDate) Then
		DateTimeStart = "NULL"
	Else
		ArrayDATE = Split(sDate,"/")
 
		t = ArrayDATE(0) & "/" & ArrayDATE(1) & "/" & ConvertYear(ArrayDate(2))
		DateTimeStart = quote(t & " 00:00:00")
	End If
End Function
 
 
' **
' Signature:
'		DateTimeStop(sDate)
' Type :
'		Function
' Parameters :
'		- sDate : short date expression (no time)
' Returns :
'		- date and time expression; time is set to start of the day. Usefull when comparing date ranges in SQL operations.
' Output :
'		- {nothing}
'	Assumptions:
'		- input must be a valid date expression formated like mm/dd/yy with two or four digits for the year.
' **
Function DateTimeStop(sDate)
	Dim ArrayDATE
	Dim y, t
 
	If IsEmpty(sDate) Then
		DateTimeStop = "NULL"
	Else
		ArrayDATE = Split(sDate,"/")
 
		t = ArrayDATE(0) & "/" & ArrayDATE(1) & "/" & ConvertYear(ArrayDate(2))
		DateTimeStop = quote(t & " 23:59:59")
	End If
End Function
 
' **
' Signature:
'		Trim(sString)
' Type :
'		Function
' Parameters :
'		- sString : string
' Returns :
'		- string with no trailing spaces on the left and on the right. If null, empty string will be returned
' Output :
'		- {nothing}
'	Assumptions:
'		- {nothing}
' **
Function Trim(sString)
	Dim sTmp
 
	sTmp = sString
	sTmp = RTrim(sTmp)
	sTmp = LTrim(sTmp)
 
	if IsNull(sTmp) then
		sTmp = ""
	end if
	Trim = sTmp
End Function
 
' **
' Signature:
'		SendSimpleMail(FROM_USER_MAIL, FROM_USER_NAME, TO_USER_MAIL, TO_USER_NAME, SUBJECT, MESSAGE)
' Type :
'		Function
' Parameters :
'		- FROM_USER_MAIL : string, sender email
'		- FROM_USER_NAME : string, sender name
'		- TO_USER_MAIL : string, recipient email
'		- TO_USER_NAME : string, recipient name
'		- SUBJECT : string, email subject
'		- MESSAGE : string, email body
' Returns :
'		- true for success, false otherwise
' Output :
'		- email
'	Assumptions:
'		- SMTPsvg.Mailer object registered on the server
' **
Function SendSimpleMail(FROM_USER_MAIL, FROM_USER_NAME, TO_USER_MAIL, TO_USER_NAME, SUBJECT, MESSAGE)
	Dim SEND_DATE, FOLDER_ID
	Dim SQL, res, nRowsAffected
	Dim Mailer,myMail, MSG
	Dim ADMIN_EMAIL
 
	SendSimpleMail = false
 
	ADMIN_EMAIL = GetParam("ADMIN_EMAIL")
 
	'' SEND NOTIFICATION MESSAGE
	'set Mailer = Server.CreateObject("SMTPsvg.Mailer")
	'Mailer.RemoteHost  = "smtprelay-01.americaneagle.com;smtprelay-02.americaneagle.com"
	'Mailer.FromName    = FROM_USER_NAME
	'Mailer.FromAddress = FROM_USER_MAIL
 
	'If not IsEmpty(TO_USER_MAIL) then
	'	Mailer.AddRecipient TO_USER_NAME , TO_USER_MAIL
	'end if
 
	'' SUBJECT
	'Mailer.Subject  = SUBJECT
 
	'' BODY
	'Mailer.BodyText = MESSAGE
 
	'' SEND MAIL
	'Mailer.SendMail
 
	'' RELEASE MEMORY
	'set Mailer = nothing
 
	
 
 
	'''''CODED By QUALITY CLIX 
 
	Set myMail=CreateObject("CDO.Message")
	myMail.Subject=SUBJECT
	myMail.From=FROM_USER_MAIL
	myMail.To=TO_USER_MAIL
 
	myMail.TextBody=MESSAGE
 
	myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing")=2
	'Name or IP of remote SMTP server
	myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") ="209.173.244.54"
	'Server port
	myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport")=25 
	myMail.Configuration.Fields.Update
 
	myMail.Send
	set myMail=nothing
 
	SendSimpleMail = true
 
End Function
 
 
Function SendSimpleHTMLMail(FROM_USER_MAIL, FROM_USER_NAME, TO_USER_MAIL, TO_USER_NAME, SUBJECT, MESSAGE)
	Dim SEND_DATE, FOLDER_ID
	Dim SQL, res, nRowsAffected
	Dim Mailer, MSG
	Dim ADMIN_EMAIL
 
	SendSimpleHTMLMail = false
 
	ADMIN_EMAIL = GetParam("ADMIN_EMAIL")
 
	' SEND NOTIFICATION MESSAGE
	set Mailer = Server.CreateObject("SMTPsvg.Mailer")
	Mailer.RemoteHost  = "smtprelay-01.americaneagle.com;smtprelay-02.americaneagle.com"
	Mailer.FromName    = FROM_USER_NAME
	Mailer.FromAddress = FROM_USER_MAIL
 
	If not IsEmpty(TO_USER_MAIL) then
		Mailer.AddRecipient TO_USER_NAME , TO_USER_MAIL
	end if
 
	Mailer.ContentType = "text/html"
 
	' SUBJECT
	Mailer.Subject  = SUBJECT
 
	' BODY
	Mailer.BodyText = MESSAGE
 
	' SEND MAIL
	Mailer.SendMail
 
	' RELEASE MEMORY
	set Mailer = nothing
 
	SendSimpleHTMLMail = true
End Function
 
 
' **
' SendMail function (more flexible thatn sendsimplemail)
'
' Parameters:
'
'	sFromAddress	Sender email address
'	sRecipients		Email recipients
'					This can be an email address of list of email addresses separated by comma
'	sCC				Carbon copy recipients
'					This can be an email address of list of email addresses separated by comma
'	sBCC			Hidden Carbon Copy recipients
'					This can be an email address of list of email addresses separated by comma
'	sSubject		Subject for the message
'	sMsg			Message body
'	bIsHTML			HTML email = true, Plain Text email = false
'	bUseQMail		Using QMail functionality = true, regular email = false
' ***
Function SendMail(sFromAddress, sRecipients, sCC, sBCC, sSubject, sMsg, bIsHTML, bUseQMail)
	Dim aRecipients, aCC, aBCC, iLoop
	Dim Mailer
 
	SendMail = ""
 
	' GET ARRAY OF RECIPIENTS
	aRecipients = Split(sRecipients, ",")
	if GetArraySize(aRecipients) = -1 then
		Redim Preserve aRecipients(0)
		aRecipients(0) = sRecipients
	End if
 
	' GET ARRAY OF CC
	aCC = Split(sCC, ",")
	if GetArraySize(aCC) = -1 then
		Redim Preserve aCC(0)
		aCC(0) = sCC
	End if
 
	' GET ARRAY OF BCC
	aBCC = Split(sBCC, ",")
	if GetArraySize(aBCC) = -1 then
		Redim Preserve aBCC(0)
		aBCC(0) = sBCC
	End if
 
	' SEND NOTIFICATION MESSAGE
	set Mailer = Server.CreateObject("SMTPsvg.Mailer")
	Mailer.RemoteHost  = "smtprelay-01.americaneagle.com;smtprelay-02.americaneagle.com"
	Mailer.FromName    = sFromAddress
	Mailer.FromAddress = sFromAddress
 
	' IS THIS QMAIL?
	if bUseQMail then
		Mailer.QMessage = true
	end if
 
	' IS THIS HTML EMAIL?
	if bIsHTML then
		Mailer.ContentType = "text/html"
	end if
 
	' SET TIMOEUT FOR 18 SECONDS
	Mailer.Timeout = 18
 
	' ADD REGULAR RECIPIENTS
	For iLoop=Lbound(aRecipients) to Ubound(aRecipients)
		if not IsEmpty(aRecipients(iLoop)) then
			Mailer.AddRecipient aRecipients(iLoop) , aRecipients(iLoop)
		end if
	Next
 
	' ADD CC RECIPIENTS
	For iLoop=Lbound(aCC) to Ubound(aCC)
		if not IsEmpty(aCC(iLoop)) then
			Mailer.AddCC aCC(iLoop) , aCC(iLoop)
		end if
	Next
 
	' ADD BCC RECIPIENTS
	For iLoop=Lbound(aBCC) to Ubound(aBCC)
		if not IsEmpty(aBCC(iLoop)) then
			Mailer.AddBCC aBCC(iLoop) , aBCC(iLoop)
		end if
	Next
 
	'SUBJECT
	Mailer.Subject  = sSubject
 
	' BODY
	Mailer.BodyText = sMsg
 
	'SEND MAIL
	Mailer.SendMail
 
	' RELEASE MEMORY
	set Mailer = nothing
End Function
 
' **
' Signature:
'		getValue(sField)
' Type :
'		Function
' Parameters :
'		- sField : string, name of value to be requested
'		- GFS : session string, when "Y" the value is requested from the session collection.
' Returns :
'		- string, value corresponding to the field name in sField
' Output :
'		- {nothing}
'	Assumptions:
'		- {nothing}
' **
Function GetValue(sField)
    Dim sTemp
 
    if Instr(Request.ServerVariables("CONTENT_TYPE"), "multipart/form-data") <> 0 then
        if not isObject (dGLOBAL_UPLOAD_OBJECT) then
            set dGLOBAL_UPLOAD_OBJECT = Server.CreateObject("SoftArtisans.FileUp")
        end if
        If not IsEmpty(request.querystring("GFS")) then
            sTemp = trim(Session(sField))
        elseif isObject(dGLOBAL_UPLOAD_OBJECT.form(sField)) then
            set sTemp = dGLOBAL_UPLOAD_OBJECT.form(sField)
        else
            sTemp = trim(dGLOBAL_UPLOAD_OBJECT.form(sField))
        end if
    else
        If not IsEmpty(request.queryString("GFS")) then
            sTemp = trim(Session(sField))
            If IsEmpty(sTemp) Then sTemp = trim(request.form(sField))
            If IsEmpty(sTemp) Then sTemp = trim(request.queryString(sField))
        else
            sTemp   = trim(request.form(sField))
            if isEmpty(sTemp) then sTemp = trim(request.queryString(sField))
        end if
    end if
    if isObject(sTemp) then
        set getValue = sTemp
    else
        getValue = sTemp
    end if
End Function
 
Function GetWysiwygValue(sField)
	Dim returnVal
 
	returnVal = GetValue(sField)
	If IsEmpty(returnVal) Then returnVal = ""
	returnVal = Replace(returnVal, GLOBAL_REFERER_NAME, "")
	returnVal = Replace(returnVal, "http://" & Request.ServerVariables("HTTP_HOST"), "")
	returnVal = Replace(returnVal, "https://" & Request.ServerVariables("HTTP_HOST"), "")
 
	GetWysiwygValue = returnVal
End Function
 
Function RequestTime(TIME_FIELD)
	RequestTime = GetValue(TIME_FIELD&"_HOUR") & ":" & GetValue(TIME_FIELD&"_MINUTE") & " " & GetValue(TIME_FIELD&"_AMPM")
 
	If IsEmpty(GetValue(TIME_FIELD&"_HOUR")) OR IsEmpty(GetValue(TIME_FIELD&"_MINUTE")) OR IsEmpty(GetValue(TIME_FIELD&"_AMPM")) Then
		RequestTime = ""
	End If
End function
 
Function RequestDate(DATE_FIELD)
	dim sTemp, sYear
	RequestDate = null
	sYear= convertYear(GetValue(DATE_FIELD&"_YEAR"))
	sTemp = GetValue(DATE_FIELD&"_MONTH")&"/"&GetValue(DATE_FIELD&"_DAY")&"/"& sYear
	if isDate(sTemp) then
		RequestDate = sTemp
	else
		if isEmpty(sTemp) then
			RequestDate = GetValue(DATE_FIELD)
		end if
	end if
End function
 
Function RequestExpDate(DATE_FIELD)
	RequestExpDate = GetValue(DATE_FIELD & "_MONTH") & "/1/" & GetValue(DATE_FIELD & "_YEAR")
	if (RequestExpDate = "//") then RequestExpDate = ""
	if not IsDate(RequestExpDate) then RequestExpDate = ""
End function
 
' **
' Signature:
'		GetField(sField, sSQL)
' Type :
'		Function
' Parameters :
'		- sField : string, column name to be returned
'		- sSQL : string, SQL statement with the column specified in sField included.
' Returns :
'		- string, value of the requested column.
' Output :
'		- {nothing}
'	Assumptions:
'		- Open Database
' **
Function GetField(sField,sSQL)
	Dim res, result
 
	Trace(sSQL)
 
	set res = DB.execute(sSQL)
	if not res.EOF then
		result = res(sField)
	else
		result = NULL
	end if
	res.Close
	set res = nothing
 
	TRACE(sField & " = " & result)
	GetField = result
End Function
 
' **
' Signature:
'		HTMLEncode(sString)
' Type :
'		Function
' Parameters :
'		- sString : string to be HTML encoded (added special characters to out put html tags as strings).
' Returns :
'		- string, HTML encoded string.
' Output :
'		- {nothing}
'	Assumptions:
' **
Function HTMLEncode(sString)
	If IsEmpty(sString) then
		HTMLEncode = sString
	else
		HTMLEncode = Server.HtmlEncode(sString)
	end if
End Function
 
' **
' Signature:
'		HTMLEncode(sString)
' Type :
'		Function
' Parameters :
'		- sString : string to be url encoded (added special characters to pass strings of values by the query string).
' Returns :
'		- string, URL encoded string.
' Output :
'		- {nothing}
'	Assumptions:
Function URLEncode(sString)
	If IsEmpty(sString) then
		URLEncode = sString
	else
		URLEncode = Server.URLEncode(sString)
	end if
End Function
 
Function GetFileExtension(FILE_NAME)
	Dim POSITION
 
	GetFileExtension = ""
	POSITION = InstrRev(FILE_NAME, ".")
	If POSITION <> 0 then
		GetFileExtension = Mid(FILE_NAME, POSITION+1 , len(FILE_NAME)-POSITION)
		Exit Function
	End if
End Function
 
Function GetFileName(FILE_NAME)
	Dim POSITION
 
	GetFileName = ""
	POSITION = InstrRev(FILE_NAME, "%2")
	If POSITION <> 0 then
		GetFileName = Mid(FILE_NAME, POSITION+2 , len(FILE_NAME)-POSITION)
		Exit Function
	End if
 
	POSITION = InstrRev(FILE_NAME, "\")
	If POSITION <> 0 then
		GetFileName = Mid(FILE_NAME, POSITION+1 , len(FILE_NAME)-POSITION)
		Exit Function
	End if
 
	POSITION = InstrRev(FILE_NAME, "/")
	If POSITION <> 0 then
		GetFileName = Mid(FILE_NAME, POSITION+1 , len(FILE_NAME)-POSITION)
		Exit Function
	End if
 
	GetFileName = FILE_NAME
End Function
 
Function Display(str)
	If IsEmpty(str) then
		Display = "&#160;"
	else
		Display = str
	End If
End Function
 
Function GetDate(FULL_DATE, MONTH_DATE, DAY_DATE, YEAR_DATE)
	Dim ArrayDATE, aDate
 
	GetDate = false
 
	MONTH_DATE = ""
	DAY_DATE = ""
	YEAR_DATE = ""
 
	TRACE("FULL_DATE=" & FULL_DATE)
	If IsEmpty(FULL_DATE) then
		Exit Function
	End if
	aDate = Split(Trim(FULL_DATE), " ")
 
	If not IsEmpty(FULL_DATE) then
		ArrayDATE = split(aDate(0),"/")
		MONTH_DATE = trim(ArrayDATE(0))
		DAY_DATE = trim(ArrayDATE(1))
		YEAR_DATE = trim(ArrayDATE(2))
	end if
 
	GetDate = true
End Function
 
Function GetTime(FULL_TIME, HOUR_TIME, MINUTE_TIME, AM_PM_TIME)
	Dim ArrayTMP
	Dim ArrayTIME
 
	HOUR_TIME = ""
	MINUTE_TIME = ""
	AM_PM_TIME = ""
 
	If not IsEmpty(FULL_TIME) then
		ArrayTMP = split(FULL_TIME," ")
		AM_PM_TIME = trim(ArrayTMP(1))
 
		ArrayTIME = split(ArrayTMP(0),":")
		HOUR_TIME = trim(ArrayTIME(0))
		MINUTE_TIME = trim(ArrayTIME(1))
	end if
End Function
 
Function FormatTime(IN_TIME)
  Dim HOURS
  Dim MINUTES
  Dim SECONDS
  Dim AMPM
 
  HOURS = Hour(IN_TIME)
  MINUTES = Minute(IN_TIME)
  SECONDS = Second(IN_TIME)
 
  AMPM = "AM"
  If HOURS >= 12 Then
    AMPM = "PM"
    HOURS = HOURS - 12
  End If
  If HOURS = 0 Then HOURS = HOURS + 12
 
  If MINUTES < 10 Then MINUTES = "0" & MINUTES
  If SECONDS < 10 Then SECONDS = "0" & SECONDS
 
  FormatTime = HOURS & ":" & MINUTES & " " & AMPM
End Function
 
Function ConvertYear(byVal y)
	Dim dTmp
 
	If IsEmpty(y) then
		Exit Function
	elseif Not IsNumeric(y) then
		Exit Function
	End if
 
	dTmp = CDate("1/1/" & y)
	y = Year(dTmp)
 
	ConvertYear = y
End Function
 
Function FormatDate(str)
	Dim s, ArrayDATE
	Dim MonthString, MonthArray
	Dim y
 
	if IsEmpty(str) then
		Exit function
	end if
 
	s = str
	MonthString = "January,February,March,April,May,June,July,August,September,October,November,December"
	MonthARRAY = split(MonthString,",")
 
	if IsEmpty(s) then
		FormatDate = ""
		Exit Function
	end if
 
	If not IsDate(s) then
		FormatDate = ""
		Exit Function
	End if
	s = FormatDateTime(s,2)
 
	ArrayDATE = Split(s,"/")
 
	y = ArrayDate(2)
	y = ConvertYear(y)
 
	FormatDate = MonthArray(ArrayDATE(0)-1) & " " & ArrayDATE(1) & ", " & y
End Function
 
Function BuildPhone(PHONE1, PHONE2, PHONE3)
	if IsEmpty(PHONE1) then
		Exit Function
	end if
	if IsEmpty(PHONE2) then
		Exit Function
	end if
	if IsEmpty(PHONE3) then
		Exit Function
	end if
	BuildPhone = PHONE1 & "-" & PHONE2 & "-" & PHONE3
End Function
 
Function BuildTime(hh,mm, ampm)
	if IsEmpty(hh) then
		Exit Function
	end if
	if IsEmpty(mm) then
		Exit Function
	end if
	if IsEmpty(ampm) then
		Exit Function
	end if
 
	BuildTime = hh & ":" & mm & " " & ampm
End Function
 
Function BuildDate(m,d,y)
	Dim dayString, monthString
 
	BuildDate = ""
 
	if IsEmpty(m) then
		Exit Function
	End if
	if IsEmpty(d) then
		Exit Function
	End if
	if IsEmpty(y) then
		Exit Function
	End if
 
	if Not IsNumeric(m) then
		Exit Function
	End if
	if Not IsNumeric(d) then
		Exit Function
	End if
	if Not IsNumeric(y) then
		Exit Function
	End if
 
	d = CInt(d)
	m = CInt(m)
	y = CInt(y)
 
	y = ConvertYear(y)
 
	if d < 10 then
		dayString = "0" & d
	else
		dayString = d
	end if
	if m < 10 then
		monthString = "0" & m
	else
		monthString = m
	end if
	BuildDate = monthString & "/" & dayString & "/" & y
End Function
 
Function GetIndexInArray(arrayNAME, VALUE)
	Dim i
 
	GetIndexInArray = -1
 
	if GetArraySize(arrayNAME) = -1 then
		Exit function
	end if
 
	for i=LBound(arrayNAME) to Ubound(arrayNAME)
		if UCase(trim(arrayNAME(i))) = UCase(trim(VALUE)) then
			GetIndexInArray = i
			Exit Function
		end if
	next
End Function
 
Function GetElement(arrayNAME, index)
	Dim sResult
 
	GetElement = ""
	On Error Resume Next
	sResult = arrayNAME(index)
	If not Err then
		GetElement = sResult
	End if
End Function
 
Function IsInList(sList, sValue)
      IsInList = IsInArray(Split(Replace(sList, ", ", ","), ","), sValue)
End Function
 
Function IsInArray(arrayNAME, VALUE)
	Dim i
 
	IsInArray = false
 
	if GetArraySize(arrayNAME) = -1 then
		Exit function
	end if
 
	for i=LBound(arrayNAME) to Ubound(arrayNAME)
		if UCase(trim(arrayNAME(i))) = UCase(trim(VALUE)) then
			IsInArray = true
			Exit Function
		end if
	next
End Function
 
Function AutoInsertSQL(SQL)
	Dim NEW_ID, rsResults
 
	' STORE SQL STATEMENT FOR FUTURE USE
	Session("ERROR_SQL") = SQL
 
	On Error Resume Next
	Trace(SQL)
 
	set rsResults = DB.Execute(SQL & "; SELECT @@identity AS new_id").nextrecordset
	NEW_ID = rsResults.Fields("NEW_ID").value
	rsResults.close
 
	AutoInsertSQL = NEW_ID
End Function
 
Function InsertSQL(SQL)
	Dim NEW_ID, rsResults
 
	' STORE SQL STATEMENT FOR FUTURE USE
	Session("ERROR_SQL") = SQL
 
	On Error Resume Next
	Trace(SQL)
 
	set rsResults = DB.Execute(SQL)
	NEW_ID = rsResults.Fields("NEW_ID").value
	rsResults.close
 
	InsertSQL = NEW_ID
End Function
 
Function ExecuteSQL(SQL)
	Dim nRowsAffected
 
    nRowsAffected = 0
 
	' STORE SQL STATEMENT FOR FUTURE USE
	Session("ERROR_SQL") = SQL
 
	On Error Resume Next
	Trace(SQL)
 
	DB.execute SQL, nRowsAffected, &H00000080
	ExecuteSQL = nRowsAffected
End Function
 
Sub OpenDatabase()
	Dim SQL
 
	If TypeName(DB) = "Connection" then
		Exit Sub
	end if
 
	Trace("OPEN DATABASE")
	Set DB = Server.CreateObject("ADODB.Connection")
 
	' SET TIMEOT TO CONNECTION
    DB.ConnectionTimeout = GLOBAL_CONNECTION_TIMEOUT
	
 
	Db.Errors.Clear
End Sub
 
Sub CloseDatabase()
	If Not TypeName(DB) = "Connection" then
		Exit Sub
	end if
	Trace("CLOSE DATABASE")
 
	DB.close
	Set DB = nothing
End Sub
 
Sub Trace(str)
	'RAY
	'Response.Write vbCrLf & "<!-- TRACE: " & str & " //-->"	& vbCrLf
End Sub
 
Function IsEmpty(s)
	If IsNull(s) Then
		IsEmpty = True
	Else
		If len(Trim(s)) = 0 Then
			IsEmpty = True
		Elseif Trim(s) = "NULL" Then
			IsEmpty = True
		Else
			IsEmpty = False
		End If
	End If
End Function
 
Function chk2str(chk)
	Dim value
 
	value = chk
	if not IsEmpty(value) then value = "Y"
	chk2str = quote(value)
End Function
 
Function DateTime(s)
	DateTime = Quote(s)
End Function
 
Function Time(s)
	Dim ArrayTIME
	Dim t
 
	t=s
	If not IsEmpty(t) Then
		TRACE("TIME=" & t)
		ArrayTIME = Split(t,":")
		t = ArrayTIME(0) & ":" & ArrayTIME(1)
	End If
	Time = quote(t)
End Function
 
Function Number(n)
	Dim t
 
	If IsEmpty(n) Then
		Number = "NULL"
	Else
		On Error Resume Next
		t = CDbl(n)
		if Err then
			Number = "NULL"
		else
			Number = t
		end if
	End If
End Function
 
Function FilterQuote(s)
	Dim t
 
	If IsEmpty(s) Then
		FilterQuote = "NULL"
	Else
		t = Replace(s,"'","''")
		t = Trim(t)
		FilterQuote = "'%" & t & "%'"
	End If
End Function
 
Function Quote(s)
	Dim t
 
	If IsEmpty(s) Then
		Quote = "NULL"
	Else
		t = Replace(s,"'","''")
		t = Trim(t)
		Quote = "'" & t & "'"
	End If
End Function
 
Function GetText(FIELD)
  Dim TEMP
  GetText = ""
  TEMP = FIELD.GetChunk(256)
  While Not IsEmpty(TEMP)
    GetText = GetText & TEMP
    TEMP = FIELD.GetChunk(256)
  Wend
End Function
 
Function Max(a,b)
	If a - b < 0 then
		Max = b
	Else
		Max = a
	End if
End Function
 
Function Min(a,b)
	If a - b < 0 then
		Min = a
	Else
		Min = b
	End if
End Function
 
Function IsLeap (sYear)
    If IsDate("02/29/" & sYear) Then
        IsLeap = True
    Else
        IsLeap = False
    End If
End Function
 
Function GetNumOfDays(DATE_MONTH, DATE_YEAR)
	Dim StringArray, MonthArray
 
	MonthArray = Array(31,28,31,30,31,30,31,31,30,31,30,31)
	DATE_YEAR = ConvertYear(DATE_YEAR)
 
	If DATE_MONTH - 1 < 0 Or DATE_MONTH - 12 > 0 then
		Exit Function
	End if
 
	If IsLeap(DATE_YEAR) then
		MonthArray(1) = MonthArray(1) + 1
	End if
 
	GetNumOfDays = MonthArray(DATE_MONTH - 1)
End Function
 
Function Str2HTML(sText)
	Str2HTML = ""
	If IsEmpty(sText) then
		Exit Function
	End if
 
	Str2HTML = Replace(sText, vbCrLf, "<br>")
End Function
 
Function trimWYSIWYG(sStr)
	if not isEmptyWYSIWYG(sStr) then
		if left(sStr,3)="<P>" then
			sStr=Right(sStr,len(sSTr)-3)
		end if
		if Right(sStr,4)="</P>" then
			sStr=Left(sStr, len(sStr)-4)
		end if
	end if
	trimWYSIWYG=sStr
End function
 
Function IsEmptyWYSIWYG(byVal sString)
	IsEmptyWYSIWYG = false
 
	sString = trim(sString)
	if instr(uCase(sString ), "<IMG") = 0 then
		sString = stripHTML(sString)
		sString = replace(sString, vbCrlf, "")
	end if
 
	sString = replace(sString, "&nbsp;", "")
 
	if isEmpty(sString) then
	 	IsEmptyWYSIWYG = true
	end if
End function
 
' Strips the HTML tags from strHTML
Function stripHTML(ByVal strHTML)
	strHTML = trim(strHTML)
 
  	Dim objRegExp, strOutput
  	Set objRegExp = New Regexp
 
  	objRegExp.IgnoreCase = True
  	objRegExp.Global = True
  	objRegExp.Pattern = "<(.|\n)+?>"
 
  	'Replace all HTML tag matches with the empty string
  	strOutput = objRegExp.Replace(strHTML, " ")
 
  	'Replace all < and > with &lt; and &gt;
  	strOutput = Replace(strOutput, "<", "&lt;")
  	strOutput = Replace(strOutput, ">", "&gt;")
  	strOutput = Replace(strOutput, "&#160;", " ")
 
  	stripHTML = strOutput    'Return the value of strOutput
 
  	Set objRegExp = Nothing
End Function
 
Function CopyFile(strFileSource, strFileDestination, byRef strError)
	Dim fso, f2
 
	if IsEmpty(strFileSource) OR IsEmpty(strFileDestination) then
		strError = "Error - You must supply both a source and a destination"
		exit function
	end if
 
	set fso = Server.CreateObject("Scripting.FileSystemObject")
	if Not fso.FileExists(strFileSource) then
		strError = "Error - Source file does not exist"
		exit function
	end if
 
	if IsEmpty(strError) then
		Set f2 = fso.GetFile(strFileSource)
		f2.Copy(strFileDestination)
		Set f2 = nothing
	end if
	Set fso = nothing
End Function
 
function aspinfotext()
	Dim ServerVariablesArray
    Dim i, v, ELEMENTS_ARRAY
    ELEMENTS_ARRAY = array("Request.Form", "Request.QueryString", "Application.Contents", "Session.Contents", "Request.Cookies", "Request.ClientCertificate", "Request.ServerVariables")
 
    ServerVariablesArray = ""
    for i = 0 to ubound(ELEMENTS_ARRAY)
		for each v in eval(ELEMENTS_ARRAY(i))
			ServerVariablesArray = ServerVariablesArray & v
			On Error Resume Next
			ServerVariablesArray = ServerVariablesArray & " " & eval(ELEMENTS_ARRAY(i) & "(""" & v & """)") & vbCrlf
			If Err then
				ServerVariablesArray = ServerVariablesArray & " N/A" & vbCrlf
			end if
			On Error Goto 0
		next
    next
    aspinfotext = ServerVariablesArray
end function
 
function aspinfo()
	Dim ServerVariablesArray
    Dim i, v, ELEMENTS_ARRAY
    ELEMENTS_ARRAY = array("Request.Form", "Request.QueryString", "Application.Contents", "Session.Contents", "Request.Cookies", "Request.ClientCertificate", "Request.ServerVariables")
 
    ServerVariablesArray = ""
    for i = 0 to ubound(ELEMENTS_ARRAY)
		ServerVariablesArray = ServerVariablesArray & "<P><TABLE width=600 cellpadding=0 cellspacing=0 border=0 align=center><TR bgcolor=000000><TD>" & vbCrlf
		ServerVariablesArray = ServerVariablesArray & "<TABLE width=100% cellpadding=2 cellspacing=1 border=0 align=center>" & vbCrlf
		ServerVariablesArray = ServerVariablesArray & "<TR bgcolor=9999CC><TH colspan=2 width=""100%"">" & ELEMENTS_ARRAY(i) & "</TH></TR>" & vbCrlf
		for each v in eval(ELEMENTS_ARRAY(i))
			ServerVariablesArray = ServerVariablesArray & "<TR valign=top><TD bgcolor=CCCCFF width=""25%"">" & v & "</TD>" & vbCrlf
			On Error Resume Next
			ServerVariablesArray = ServerVariablesArray & "<TD bgcolor=CCCCCC>" & eval(ELEMENTS_ARRAY(i) & "(""" & v & """)") & "</TD></TR>" & vbCrlf
			If Err then
				ServerVariablesArray = ServerVariablesArray & "<TD bgcolor=CCCCCC>N/A</TD></TR>" & vbCrlf
			end if
			On Error Goto 0
		next
		ServerVariablesArray = ServerVariablesArray & "</TABLE>" & vbCrlf
		ServerVariablesArray = ServerVariablesArray & "</TD></TR></TABLE></P>" & vbCrlf
    next
    aspinfo = ServerVariablesArray
end function
 
Function REReplace(sStringToSearch, sPattern, sReplacement)
	Dim oRegExp
	Set oRegExp = New RegExp
	oRegExp.Pattern = sPattern
	oRegExp.Global = True
	oRegExp.IgnoreCase = False
	REReplace = oRegExp.Replace(sStringToSearch, sReplacement)
End Function
 
Function REReplaceNoCase(sStringToSearch, sPattern, sReplacement)
	Dim oRegExp
	Set oRegExp = New RegExp
	oRegExp.Pattern = sPattern
	oRegExp.Global = True
	oRegExp.IgnoreCase = True
	REReplaceNoCase = oRegExp.Replace(sStringToSearch, sReplacement)
End Function
 
' **
' Signature:
'  	HttpXmlGet (sMethod, sUrl, sUserName, sPassword, sSendType, sSendData)
' Type :
'  	Function
' Parameters :
'  	- sMethod: required; string; "post" or "get" (not case sensitive)
'  	- sUrl: required; string; Address you are posting/getting and later reading
'  	- sUserName/sPassword: optional; string.
'  	- sSendType: required; string; type of data you are sending, only XML and
'         VALUEPAIRS have been implemented here, so far.
'  	- sSendData: optional; string; XML to pass, value pairs built like a query string
'         or check Microsoft documentation for other types.
' Returns : string with response from the URL of the type requested on sSendType
' Assumptions:
'  	- MSXML2.XMLHTTP component present (Microsfot XMLHTTP V.3 or later)
' **
function HttpXmlGet(sMethod, sUrl, sUserName, sPassword, sSendType, sSendData)
	dim oHttpXml, bASync
	dim sResult
	bASync = false  'wait for the full response to be back (check documentation)
 
 
	set oHttpXml = server.createObject("MSXML2.XMLHTTP")
	oHttpXml.open sMethod, sUrl, bASync, sUserName, sPassword
 
	select case sSendType
	case "XML"
		oHttpXml.setRequestHeader "Content-Type", "text/xml"
		oHttpXml.send(sSendData)
		sResult = oHttpXml.responseXML.xml
 
	case "VALUEPAIRS"
  		oHttpXml.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
  		oHttpXml.send(sSendData)
  		sResult = oHttpXml.responseText
 	end select
 	set oHttpXml = nothing
 
 	HttpXmlGet = trim(sResult)
end function
 
Function UCFirst(strWord)
	strWord = trim(strWord & "")
 
	if len(strWord) > 0 then
		ucFirst = uCase(left(strWord, 1)) & _
		lcase(right(strWord, len(strWord) - 1))
	end if
End Function
 
Function TitleCase(strWords)
	Dim arWords, i, strFormatted
	
	strWords = trim(strWords & "")
	strFormatted = ""
	
	if len(strWords) > 0 then
		arWords = split(strWords, " ")
		for i = 0 to uBound(arWords)
			strFormatted = strFormatted & " " & ucFirst(arWords(i))
		next
	end if
	ucWords = strFormatted
End Function
 
Function GenerateImage(sOriginalPath, sSavePath, HEIGHT, WIDTH)
  Dim jpeg
  Set jpeg = Server.CreateObject("ImageResize.ImageResize")
  Call jpeg.ResizeImage(Server.MapPath(sOriginalPath), Server.MapPath(sSavePath), Height, Width)
  Set jpeg = Nothing
End Function
%>
Attachments:
 
the link
the link
 
[+][-]09.17.2008 at 05:16AM PDT, ID: 22497555

At Experts Exchange, members can ask their questions to thousands of technology professionals, also known as Experts. Experts compete and collaborate to answer those questions by leaving comments like this one.

Start your 7-day free trial to view this Expert Comment or ask the Experts your question.

 
[+][-]09.17.2008 at 01:29PM PDT, ID: 22503307

Often, when Experts are collaborating with members who have asked questions, they will request additional information about the problem. Askers respond with an author comment like this one.

Start your 7-day free trial to view this Author Comment or ask the Experts your question.

 
 
Loading Advertisement...
20080716-EE-VQP-32 / EE_QW_2_20070628