<%
'----------------------------------------------------------------------------------------'
'iLanguage values: '
'1033 = English '
'1037 = Hebrew '
'1040 = Italian '
'1034 = Spanish
'1025 = Arabic
'----------------------------------------------------------------------------------------'
'----------------------------------------------------------------------------------------'
'Do not translate application variable "$ErrorMessage" '
'----------------------------------------------------------------------------------------'
Const LanguageEnglish = 1033
Const LanguageSpanish = 1034
Const LanguageHebrew = 1037
Const LanguageItalian = 1040
Const LanguageArabic = 1025
Dim iLanguage, sLanguageString(57)
iLanguage = LanguageEnglish
If iLanguage = LanguageEnglish Then
sLanguageString(0) = "Created and managed with SmartLite WebQuiz XP"
sLanguageString(1) = "Password:"
sLanguageString(2) = " Unable to continue: you cannot submit your answers more than one time."
sLanguageString(3) = "User Name:"
sLanguageString(4) = "Password:"
sLanguageString(5) = "Unable to continue: you cannot access the test more than one time."
sLanguageString(6) = "Unable to load questions. Database cannot be found or connection to database cannot be opened. Error message: $ErrorMessage"
sLanguageString(7) = "Unable to get the quiz ID. Error message: $ErrorMessage"
sLanguageString(8) = "Unable to get the quiz ID. The record cannot be found."
sLanguageString(9) = "Unable to load questions. The database may be read-only. Please check that you have write permissions in the database folder. Error message: $ErrorMessage"
sLanguageString(10) = "Unable to load questions. The database may be locked. Please wait a few moments and then retry. Error message: $ErrorMessage"
sLanguageString(11) = "Unable to save answers. The database may be locked. Please wait a few moments and then retry. Error message: $ErrorMessage"
sLanguageString(12) = "Unable to continue: your answers have already been submitted."
sLanguageString(13) = "Unable to save answers. The database may be locked or the administrator may have deleted you. Please wait a few moments and then retry. Error message: $ErrorMessage"
sLanguageString(14) = "Unable to save answers. The database may be locked or the administrator may have deleted you. Error message: $ErrorMessage"
sLanguageString(15) = "Unable to save answers. The database may be locked or the administrator may have deleted you. Error message: $ErrorMessage"
sLanguageString(16) = "Unable to load questions. The database may be locked. Please wait a few moments and then retry. Error message: $ErrorMessage"
sLanguageString(17) = "Score:"
sLanguageString(18) = "Date:"
sLanguageString(19) = "IP:"
sLanguageString(20) = "Score:"
sLanguageString(21) = "Score: "
sLanguageString(22) = "Evaluation:"
sLanguageString(23) = "Evaluation: "
sLanguageString(24) = "Unable to save answers. The database may be locked or the administrator may have deleted you. Error message: $ErrorMessage"
sLanguageString(25) = "Unable to load questions. The database may be locked. Please wait a few moments and then retry. Error message: $ErrorMessage"
sLanguageString(26) = "Unable to load questions. No questions have been found."
sLanguageString(27) = "Question "
sLanguageString(28) = "Given Answer"
sLanguageString(29) = "Correct Answer"
sLanguageString(30) = "Answers from quiz: "
sLanguageString(31) = "Print"
sLanguageString(32) = "Begin"
sLanguageString(33) = "Reset"
sLanguageString(34) = "< Back"
sLanguageString(35) = "Submit"
sLanguageString(36) = "Next >"
sLanguageString(37) = "Submit"
sLanguageString(38) = "Reset"
sLanguageString(39) = "Please enter a value for "
sLanguageString(40) = "Please enter a valid e-mail."
sLanguageString(41) = "Please choose a value for question "
sLanguageString(42) = "Please choose at least one value for question "
sLanguageString(43) = "Please enter a value for question "
sLanguageString(44) = "Right"
sLanguageString(45) = "Wrong"
sLanguageString(46) = "ISO-8859-1"
sLanguageString(47) = "Please enter letters and spaces only in the selected text box."
sLanguageString(48) = "Please enter numbers only in the selected text box."
sLanguageString(49) = "Please enter a valid number in the selected text box."
sLanguageString(50) = "Time has elapsed. Please press Ok to continue."
sLanguageString(51) = "This test is time limited: "
sLanguageString(52) = "\n\nYou can check the remaining time on your status bar at the bottom of the screen."
sLanguageString(53) = "Windows-1252"
sLanguageString(54) = 1252
sLanguageString(55) = "Print certificate"
sLanguageString(56) = "ltr"
sLanguageString(57) = "Close"
ElseIf iLanguage = LanguageItalian Then
sLanguageString(0) = "Creato e gestito con SmartLite WebQuiz XP"
sLanguageString(1) = "Password:"
sLanguageString(2) = "Impossibile continuare: le risposte possono essere inviate una sola volta."
sLanguageString(3) = "Utente:"
sLanguageString(4) = "Password:"
sLanguageString(5) = "Impossibile continuare: il test puע essere svolto una sola volta."
sLanguageString(6) = "Impossibile caricare le domande. Il database non ט stato trovato oppure la connessione al database non ט riuscita. Messaggio di errore: $ErrorMessage"
sLanguageString(7) = "Impossibile ottenere l'ID del quiz. Messaggio di errore: $ErrorMessage"
sLanguageString(8) = "Impossibile ottenere l'ID del quiz. Il record non ט stato trovato."
sLanguageString(9) = "Impossibile caricare le domande. Il database potrebbe essere di sola lettura. Assicurarsi di avere i permessi di scrittura nella cartella del database. Messaggio di errore: $ErrorMessage"
sLanguageString(10) = "Impossibile caricare le domande. Il database potrebbe essere bloccato. Attendere alcuni minuti e riprovare. Messaggio di errore: $ErrorMessage"
sLanguageString(11) = "Impossibile salvare le risposte. Il database potrebbe essere bloccato. Attendere alcuni minuti e riprovare. Messaggio di errore: $ErrorMessage"
sLanguageString(12) = "Impossibile continuare: le risposte sono giא state inviate."
sLanguageString(13) = "Impossibile salvare le risposte. Il database potrebbe essere bloccato oppure l'amministratore potrebbe avere cancellato la tua utenza. Attendere alcuni minuti e riprovare. Messaggio di errore: $ErrorMessage"
sLanguageString(14) = "Impossibile salvare le risposte. Il database potrebbe essere bloccato oppure l'amministratore potrebbe avere cancellato la tua utenza. Messaggio di errore: $ErrorMessage"
sLanguageString(15) = "Impossibile salvare le risposte. Il database potrebbe essere bloccato oppure l'amministratore potrebbe avere cancellato la tua utenza. Messaggio di errore: $ErrorMessage"
sLanguageString(16) = "Impossibile caricare le domande. Il database potrebbe essere bloccato. Attendere alcuni minuti e riprovare. Messaggio di errore: $ErrorMessage"
sLanguageString(17) = "Score:"
sLanguageString(18) = "Date:"
sLanguageString(19) = "IP:"
sLanguageString(20) = "Score:"
sLanguageString(21) = "Score: "
sLanguageString(22) = "Valutazione:"
sLanguageString(23) = "Valutazione: "
sLanguageString(24) = "Impossibile salvare le risposte. Il database potrebbe essere bloccato oppure l'amministratore potrebbe avere cancellato la tua utenza. Messaggio di errore: $ErrorMessage"
sLanguageString(25) = "Impossibile caricare le domande. Il database potrebbe essere bloccato. Attendere qualche minuto e riprovare. Messaggio di errore: $ErrorMessage"
sLanguageString(26) = "Impossibile caricare le domande. Non è stata trovata nessuna domanda."
sLanguageString(27) = "Domanda "
sLanguageString(28) = "Risposta data"
sLanguageString(29) = "Risposta esatta"
sLanguageString(30) = "Risposte dal quiz: "
sLanguageString(31) = "Stampa"
sLanguageString(32) = "Inizia"
sLanguageString(33) = "Reset"
sLanguageString(34) = "< Indietro"
sLanguageString(35) = "Invia"
sLanguageString(36) = "Avanti >"
sLanguageString(37) = "Invia"
sLanguageString(38) = "Reset"
sLanguageString(39) = "Inserire un valore per il campo "
sLanguageString(40) = "Inserire un indirizzo di posta elettronica valido."
sLanguageString(41) = "Selezionare un valore per la domanda "
sLanguageString(42) = "Selezionare almeno un valore per la domanda "
sLanguageString(43) = "Inserire un valore per la domanda "
sLanguageString(44) = "Esatta"
sLanguageString(45) = "Errata"
sLanguageString(46) = "ISO-8859-1"
sLanguageString(47) = "Inserire solo lettere e spazi nel box selezionato."
sLanguageString(48) = "Inserire solo numeri nel box selezionato."
sLanguageString(49) = "Inserire un numero valido nel box selezionato."
sLanguageString(50) = "Tempo scaduto. Premere Ok per continuare."
sLanguageString(51) = "Questo test temporalmente limitato a: "
sLanguageString(52) = "\n\nPuoi controllare il tempo residuo nella barra di stato alla fine dello schermo."
sLanguageString(53) = "Windows-1252"
sLanguageString(54) = 1252
sLanguageString(55) = "Stampa certificato"
sLanguageString(56) = "ltr"
sLanguageString(57) = "Chiudi"
ElseIf iLanguage = LanguageHebrew Then
sLanguageString(0) = "נוצר ומנוהל ע""י WebQuiz XP"
sLanguageString(1) = "סיסמא:"
sLanguageString(2) = " לא ניתן להמשיך: ניתן להשיב פעם אחת בלבד."
sLanguageString(3) = "שם משתמש:"
sLanguageString(4) = "סיסמא:"
sLanguageString(5) = "לא ניתן להמשיך: ניתן לגשת לבחינה זו פעם אחת בלבד."
sLanguageString(6) = "לא ניתן להציג שאלות. בסיס הנתונים לא נמצא או שלא ניתן ליצור קשר. Error message: $ErrorMessage"
sLanguageString(7) = "לא ניתן לאתר את מספר הבחינה. Error message: $ErrorMessage"
sLanguageString(8) = "לא ניתן לאתר את מספר הבחינה. לא ניתן לאתר הרשומה."
sLanguageString(9) = "לא ניתן להציג שאלות. בסיס הנתונים הוא לקריאה בלבד. וודא שיש לך הרשאת כתיבה לבסיס הנתונים. Error message: $ErrorMessage"
sLanguageString(10) = "לא ניתן להציג שאלות. בסיס הנתונים נעול. המתן מספר דקות ואחר כך נסה שנית. Error message: $ErrorMessage"
sLanguageString(11) = "לא ניתן לשמור התשובות. בסיס הנתונים נעול. המתן מספר דקות ואחר כך נסה שנית. Error message: $ErrorMessage"
sLanguageString(12) = "לא ניתן להמשיך:תשובותיך נמסרו כבר."
sLanguageString(13) = "לא ניתן לשמור התשובות. בסיס הנתונים נעול או ששמך הוסר מרשימת המשתמשים. המתן מספר דקות ואחר כך נסה שנית. Error message: $ErrorMessage"
sLanguageString(14) = "לא ניתן לשמור התשובות. בסיס הנתונים נעול או ששמך הוסר מרשימת המשתמשים. Error message: $ErrorMessage"
sLanguageString(15) = "לא ניתן לשמור התשובות. בסיס הנתונים נעול או ששמך הוסר מרשימת המשתמשים"
sLanguageString(16) = "לא ניתן להציג שאלות. בסיס הנתונים נעול. המתן מספר דקות ואחר כך נסה שנית. Error message: $ErrorMessage"
sLanguageString(17) = "ציון:"
sLanguageString(18) = "תאריך:"
sLanguageString(19) = "IP:"
sLanguageString(20) = "ציון:"
sLanguageString(21) = " ציון:"
sLanguageString(22) = "הערכה:"
sLanguageString(23) = " הערכה:"
sLanguageString(24) = "לא ניתן לשמור התשובות. בסיס הנתונים נעול או ששמך הוסר מרשימת המשתמשים. Error message: $ErrorMessage"
sLanguageString(25) = "לא ניתן להציג שאלות. בסיס הנתונים נעול. המתן מספר דקות ואחר כך"
sLanguageString(26) = "לא ניתן להציג שאלות. לא נמצאו שאלות"
sLanguageString(27) = " שאלה"
sLanguageString(28) = "התשובה שניתנה"
sLanguageString(29) = "התשובה הנכונה"
sLanguageString(30) = " תשובות מתוך הבחינה:"
sLanguageString(31) = "הדפס"
sLanguageString(32) = "התחל"
sLanguageString(33) = "אפס"
sLanguageString(34) = "חזור >"
sLanguageString(35) = "הגש"
sLanguageString(36) = "< המשך"
sLanguageString(37) = "הגש"
sLanguageString(38) = "אפס"
sLanguageString(39) = " נא הכנס ערך"
sLanguageString(40) = "נא הכנס כתובת דואר אלקטרוני תקפה"
sLanguageString(41) = " נא בחר ערך לתשובה"
sLanguageString(42) = " נא בחר ערך אחד לפחות לתשובה"
sLanguageString(43) = " נא בחר ערך לתשובה"
sLanguageString(44) = "נכון"
sLanguageString(45) = "לא נכון"
sLanguageString(46) = "ISO-8859-8-I"
sLanguageString(47) = "הכנס אותיות ורווחים בלבד בתיבת הטקסט"
sLanguageString(48) = "הכנס ספרות בלבד בתיבת הטקסט"
sLanguageString(49) = "הכנס מספר תקף בתיבת הטקסט"
sLanguageString(50) = "הזמן המוקצב עבר. כדי להמשיך הקש על OK"
sLanguageString(51) = "דקות. תוכל לראות את הזמן הנותר בתחתית המסך "
sLanguageString(52) = "\n\nלמבחן זה מוקצבות "
sLanguageString(53) = "windows-1255"
sLanguageString(54) = 1255
sLanguageString(55) = "הדפס תעודה"
sLanguageString(56) = "rtl"
sLanguageString(57) = "Close"
ElseIf iLanguage = LanguageArabic Then
sLanguageString(0) = "أنتج ويدار على يد WebQuiz XP"
sLanguageString(1) = "كلمة المرور:"
sLanguageString(2) = " لا يمكن المتابعة. يمكن الاجابة مرة واحدة فقط."
sLanguageString(3) = "اسم المستخدم:"
sLanguageString(4) = "كلمة المرور:"
sLanguageString(5) = "لا يمكن المتابعة. يمكن التقدم للإمتحان مرة واحدة فقط."
sLanguageString(6) = "لا يمكن عرض الاسئلة. قاعدة البيانات غير موجودة أو لا يمكن الاتصال بها. Error message: $ErrorMessage"
sLanguageString(7) = "لا يمكن العثور على رقم الامتحان. Error message: $ErrorMessage"
sLanguageString(8) = "لا يمكن العثور على رقم الامتحان. لا يمكن العثور على القائمة."
sLanguageString(9) = "لا يمكن عرض الاسئلة. قاعدة البيانات للقراءة فقط. تأكد ان لك صلاحية للكتابة في قاعدة البانات. Error message: $ErrorMessage"
sLanguageString(10) = "لا يمكن عرض الاسئلة. قاعدة البيانات مغلقة. انتظر بعض دقائق ومن ثم حاول مرة ثانية. Error message: $ErrorMessage"
sLanguageString(11) = "لا يمكن حفظ الاجوبة. قاعدة البيانات مغلقة. انتظر بعض دقائق ومن ثم حاول مرة ثانية. Error message: $ErrorMessage"
sLanguageString(12) = "لا يمكن المتابعة. أجوبتك قد أرسلت."
sLanguageString(13) = "لا يمكن حفظ الاجوبة. قاعدة البيانات مغلقة أو اسمك حذف من قائمة المستخدمين. انتظر بعض دقائق ومن ثم حاول مرة ثانية. Error message: $ErrorMessage"
sLanguageString(14) = "لا يمكن حفظ الاجوبة. قاعدة البيانات مغلقة أو اسمك حذف من قائمة المستخدمين. Error message: $ErrorMessage"
sLanguageString(15) = "لا يمكن حفظ الاجوبة. قاعدة البيانات مغلقة أو اسمك حذف من قائمة المستخدمين"
sLanguageString(16) = "لا يمكن حفظ الاجوبة. قاعدة البيانات مغلقة. انتظر بعض دقائق ومن ثم حاول مرة ثانية. Error message: $ErrorMessage"
sLanguageString(17) = "العلامة:"
sLanguageString(18) = "التاريخ:"
sLanguageString(19) = "IP:"
sLanguageString(20) = "العلامة:"
sLanguageString(21) = " العلامة:"
sLanguageString(22) = "تقدير:"
sLanguageString(23) = " تقدير:"
sLanguageString(24) = "لا يمكن حفظ الاجوبة. قاعدة البيانات مغلقة أو اسمك حذف من قائمة المستخدمين. Error message: $ErrorMessage"
sLanguageString(25) = "لا يمكن حفظ الاجوبة. قاعدة البيانات مغلقة. انتظر بعض دقائق ومن ثم "
sLanguageString(26) = "لا يمكن عرض الاسئلة. اسئلة غير موجودة."
sLanguageString(27) = " سؤال"
sLanguageString(28) = "الاجابة المقترحة"
sLanguageString(29) = "الاجابة الصحيحة"
sLanguageString(30) = " اجابات من الامتحان:"
sLanguageString(31) = "اطبع"
sLanguageString(32) = "ابدأ"
sLanguageString(33) = "امسح"
sLanguageString(34) = "عودة >"
sLanguageString(35) = "سلم"
sLanguageString(36) = "< أكمل"
sLanguageString(37) = "سلم"
sLanguageString(38) = "امسح"
sLanguageString(39) = " الرجاء إدخال قيمة"
sLanguageString(40) = "الرجاء إدخال عنوان بريد الكتروني صحيح"
sLanguageString(41) = " الرجاء اختر قية للإجابة"
sLanguageString(42) = " الرجاء اختر قيمة واحدة على الاقل للإجابة"
sLanguageString(43) = " الرجاء اختر قية للإجابة"
sLanguageString(44) = "صحيح"
sLanguageString(45) = "غير صحيح"
sLanguageString(46) = "ISO-8859-8-I"
sLanguageString(47) = "ادخل فقط أحرف وفراغات في مربع الحوار"
sLanguageString(48) = "ادخل أعداد فقط في مربع الحوار"
sLanguageString(49) = "ادخل رقم صحيح في مربع الحوار"
sLanguageString(50) = " لقد انتهى الوقت المحدد. للمتابعة انقر فوق موافق"
sLanguageString(51) = "دقائق. يمكن مشاهدة الوقت المتبقي في أسفل الشاشة"
sLanguageString(52) = "\n\n لهذا الامتحان حدد"
sLanguageString(53) = "windows-1256"
sLanguageString(54) = 1256
sLanguageString(55) = "اطبع شهادة Print certificate"
sLanguageString(56) = "rtl"
sLanguageString(57) = "Close"
ElseIf iLanguage = LanguageSpanish Then
sLanguageString(0) = "Creado y manejado por SmartLite WebQuiz XP"
sLanguageString(1) = "Contraseña:"
sLanguageString(2) = " Imposible de continuar: no puede enviar sus respuestas más de una vez."
sLanguageString(3) = "Nombre de Usuario:"
sLanguageString(4) = "Contraseña:"
sLanguageString(5) = "Imposible de continuar: no puede accesar al test más de una vez."
sLanguageString(6) = "Imposible cargar las preguntas. La Base de Datos no fue encontrada o la conexion a la base de datos no fue posible. Mensaje de error: $ErrorMessage"
sLanguageString(7) = "Imposible obtener el quiz ID. Mensaje de error: $ErrorMessage"
sLanguageString(8) = "Imposible obtener el quiz ID. El registro no fue encontrado."
sLanguageString(9) = "Imposible obtener el quiz ID. La Base de Datos puede ser de solo lectura. Por favor revisar que Usted cuente con permiso de escribir en el folder de la base de datos. Mensaje de error: $ErrorMessage"
sLanguageString(10) = "Imposible cargar preguntas. La base de datos puede estar cerrada. Por favor espere unos momentos y luego reintente. Mensaje de error: $ErrorMessage"
sLanguageString(11) = "Imposible grabar las respuestas. La base de Datos puede estar cerrada. Por favor espere unos momentos y luego reintente. Mensaje de error: $ErrorMessage"
sLanguageString(12) = "Imposible continuar: sus respuestas ya han sido enviadas."
sLanguageString(13) = "Imposible grabar respuestas. La base de datos puede estar cerrada o el administrador le ha borrado. Por favor espere unos momentos y luego reintente. Mensaje de error: $ErrorMessage"
sLanguageString(14) = "Imposible grabar respuestas. La base de datos puede estar cerrada o el administrador le ha borrado. Mensaje de error: $ErrorMessage"
sLanguageString(15) = "Imposible grabar respuestas. La base de datos puede estar cerrada o el administrador le ha borrado. Mensaje de error: $ErrorMessage"
sLanguageString(16) = "Imposible cargar preguntas. La base de datos puede estar cerrada. Por favor espere unos momentos y luego reintente. Mensaje de error: $ErrorMessage"
sLanguageString(17) = "Resultado:"
sLanguageString(18) = "Fecha:"
sLanguageString(19) = "IP:"
sLanguageString(20) = "Resultado:"
sLanguageString(21) = "Resultado: "
sLanguageString(22) = "Evaluación:"
sLanguageString(23) = "Evaluación: "
sLanguageString(24) = "Imposible grabar respuestas. La base de datos puede estar cerrada o el administrador le ha borrado. Mensaje de error: $ErrorMessage"
sLanguageString(25) = "Imposible cargar preguntas. La base de datos puede estar cerrada. Por favor espere unos momentos y luego reintente. Mensaje de error: $ErrorMessage"
sLanguageString(26) = "Imposible cargar preguntas. Ninguna pregunta ha sido encontrada."
sLanguageString(27) = "Pregunta "
sLanguageString(28) = "Respuesta dada"
sLanguageString(29) = "Respuesta correcta"
sLanguageString(30) = "Pregntas del quiz: "
sLanguageString(31) = "Imprimir"
sLanguageString(32) = "Empezar"
sLanguageString(33) = "Limpiar"
sLanguageString(34) = "< Atrás"
sLanguageString(35) = "Enviar"
sLanguageString(36) = "Siguiente >"
sLanguageString(37) = "Enviar"
sLanguageString(38) = "Limpiar"
sLanguageString(39) = "Por favor introduzca un valor para "
sLanguageString(40) = "Por favor intruduzca una cuenta valida de e-mail."
sLanguageString(41) = "Por favor escoga un valor para la pregunta "
sLanguageString(42) = "Por favor escoga al menos un valor para la pregunta "
sLanguageString(43) = "Por favor ingrese un valor para la pregunta "
sLanguageString(44) = "Correcto"
sLanguageString(45) = "Equivocado"
sLanguageString(46) = "ISO-8859-1"
sLanguageString(47) = "Por favor solo introduzca letras y espacios en el cuadro de texto."
sLanguageString(48) = "Por favor solo introduzca n\xE1meros en el cuadro de texto."
sLanguageString(49) = "Por favor intruduzca un n\xFAmero v\xE1lido en el cuadro de texto."
sLanguageString(50) = "El tiempo ha transcurrido. Por favor presione ok para continuar."
sLanguageString(51) = "Este test tiene tiempo l\xEDmite: "
sLanguageString(52) = "\n\nUsted puede revisar el tiempo restante en la barra de estado en la parte superior de la pantalla."
sLanguageString(53) = "Windows-1252"
sLanguageString(54) = 1252
sLanguageString(55) = "Imprimir certificado"
sLanguageString(56) = "ltr"
sLanguageString(57) = "Cerrar"
End If
%>
<%
Const GlobalPDFTempFolder = "output" 'This is the output folder where the .PDF files will be saved. Please make sure that the read-write permission on this folder have been set. (user: IUSR_MACHINE-NAME)
Const GlobalPFDOwnerPassword = "MyPass" 'This is the security password for the generated .PDF files. It will prevent the file to be edited by the users.
Function GetFirstLetterUCase(sString)
Dim sTemp, sTemp2
sTemp = sString
sTemp2 = UCase(Left(sTemp, 1))
sTemp = Right(sTemp, (Len(sTemp)-1))
sTemp = sTemp2 & sTemp
GetFirstLetterUCase = sTemp
End Function
Function GetDedicatedDate(dDate)
Dim sTemp
sTemp = FormatDedicatedDateString(Month(dDate)) & "/" & FormatDedicatedDateString(Day(dDate)) & "/" & Year(dDate)
GetDedicatedDate = sTemp
End Function
Function GetDedicatedTime(dDate)
Dim sTemp
If Hour(dDate) >= 12 Then
If Hour(dDate) > 12 Then
sTemp = FormatDedicatedDateString((Hour(dDate)-12)) & ":" & FormatDedicatedDateString(Minute(dDate))
Else
sTemp = FormatDedicatedDateString(Hour(dDate)) & ":" & FormatDedicatedDateString(Minute(dDate))
End If
sTemp = sTemp & " PM"
Else
If Hour(dDate) = 0 Then
sTemp = "12:" & FormatDedicatedDateString(Minute(dDate))
Else
sTemp = FormatDedicatedDateString(Hour(dDate)) & ":" & FormatDedicatedDateString(Minute(dDate))
End If
sTemp = sTemp & " AM"
End If
GetDedicatedTime = sTemp
End Function
Function FormatDedicatedDateString(sDate)
Dim sTemp
sTemp = sDate
If Len(sTemp) < 2 Then sTemp = "0" & sTemp
FormatDedicatedDateString = sTemp
End Function
Function GetRandomNumber()
Dim iInt
Randomize
iInt = Int((1000*Rnd())+1)
GetRandomNumber = iInt
End Function
Function GetFieldIndex(sField, aArray)
Dim i
GetFieldIndex = -1
For i = 0 To UBound(aArray)
If LCase(sField) = LCase(aArray(i)) Then
GetFieldIndex = i
Exit Function
End If
Next
End Function
Function GetDedicatedCertificate(sScore, sCertificateName, Cnn, iTimeZone, iUserID)
Dim sSource, sDestination, theField, RS, sFileName, sPrintDestination, iFieldPos, bComponentError
Dim theDoc, FSO, theID, bMailSent, sQuizTitle, aData(), aValues(), iCustomFields
Set RS = Cnn.Execute("SELECT * FROM Options")
If Not RS.EOF Then sQuizTitle = RS("QuizTitle")
Set RS = Nothing
ReDim aData(3)
ReDim aValues(3)
aData(0) = "Quiz_Title"
aData(1) = "Quiz_Score"
aData(2) = "Quiz_Date"
aData(3) = "Quiz_DateTime"
aValues(0) = sQuizTitle
aValues(1) = iQuizScore
aValues(2) = GetDedicatedDate(DateAdd("n", iTimeZone, Now()))
aValues(3) = GetDedicatedDate(DateAdd("n", iTimeZone, Now())) & " " & GetDedicatedTime(DateAdd("n", iTimeZone, Now()))
Set RS = Cnn.Execute("SELECT * FROM UserData")
Set RSData = Cnn.Execute("SELECT * FROM Users WHERE ID=" & iUserID)
Do While Not RS.EOF
ReDim Preserve aData(UBound(aData)+1)
ReDim Preserve aValues(UBound(aValues)+1)
aData(UBound(aData)) = RS("Name")
If Not RSData.EOF Then aValues(UBound(aValues)) = RSData("UD_" & RS("Name"))
RS.MoveNext
Loop
Set RSData = Nothing
Set RS = Nothing
sFileName = "certificate" & iUserID & GetRandomNumber() & Year(Now()) & Month(Now()) & Day(Now()) & Hour(Now()) & Minute(Now()) & Second(Now()) & ".pdf"
sSource = Server.MapPath(sCertificateName)
sDestination = Server.MapPath(GlobalPDFTempFolder) & "\"
sDestination = sDestination & sFileName
sPrintDestination = GlobalPDFTempFolder & "/" & sFileName
On Error Resume Next
Set theDoc = Server.CreateObject("ABCpdf5.Doc")
theDoc.Read sSource
bComponentError = (Err.Number <> 0)
On Error GoTo 0
If Not bComponentError Then
iCustomFields = 0
For Each theField In theDoc.Form.Fields
theID = theField.id
iFieldPos = GetFieldIndex(theField.Name, aData)
If iFieldPos >= 0 Then
theField.Value = aValues(iFieldPos)
theDoc.SetInfo theID, "/TU", aValues(iFieldPos)
ElseIf LCase(theField.Name) <> "read_only" Then
iCustomFields = iCustomFields + 1
theField.Value = "Custom Field " & iCustomFields
theDoc.SetInfo theID, "/TU", "Custom_Field_" & iCustomFields
End If
Next
theDoc.Encryption.Type = 2
theDoc.Encryption.CanCopy = False
theDoc.Encryption.CanAssemble = False
theDoc.Encryption.CanChange = False
theDoc.Encryption.CanCopy = False
theDoc.Encryption.CanEdit = False
theDoc.Encryption.CanExtract = False
theDoc.Encryption.CanFillForms = False
theDoc.Encryption.CanPrint = True
theDoc.Encryption.CanPrintHi = True
theDoc.Encryption.OwnerPassword = GlobalPFDOwnerPassword
On Error Resume Next
theDoc.Save sDestination
If Err.Number <> 0 Then sPrintDestination = ""
On Error GoTo 0
Set theField = Nothing
Set theDoc = Nothing
Else
sPrintDestination = ""
End If
GetDedicatedCertificate = sPrintDestination
End Function
%>
<%
' Derived from the RSA Data Security, Inc. MD5 Message-Digest Algorithm,
' as set out in the memo RFC1321.
'
' See the VB6 project that accompanies this sample for full code comments on how
' it works.
'
' ASP VBScript code for generating an MD5 'digest' or 'signature' of a string. The
' MD5 algorithm is one of the industry standard methods for generating digital
' signatures. It is generically known as a digest, digital signature, one-way
' encryption, hash or checksum algorithm. A common use for MD5 is for password
' encryption as it is one-way in nature, that does not mean that your passwords
' are not free from a dictionary attack.
'
' This is 'free' software with the following restrictions:
'
' You may not redistribute this code as a 'sample' or 'demo'. However, you are free
' to use the source code in your own code, but you may not claim that you created
' the sample code. It is expressly forbidden to sell or profit from this source code
' other than by the knowledge gained or the enhanced value added by your own code.
'
' Use of this software is also done so at your own risk. The code is supplied as
' is without warranty or guarantee of any kind.
'
' Should you wish to commission some derivative work based on this code provided
' here, or any consultancy work, please do not hesitate to contact us.
'
' Web Site: http://www.frez.co.uk
' E-mail: sales@frez.co.uk
Private Const BITS_TO_A_BYTE = 8
Private Const BYTES_TO_A_WORD = 4
Private Const BITS_TO_A_WORD = 32
Private m_lOnBits(30)
Private m_l2Power(30)
m_lOnBits(0) = CLng(1)
m_lOnBits(1) = CLng(3)
m_lOnBits(2) = CLng(7)
m_lOnBits(3) = CLng(15)
m_lOnBits(4) = CLng(31)
m_lOnBits(5) = CLng(63)
m_lOnBits(6) = CLng(127)
m_lOnBits(7) = CLng(255)
m_lOnBits(8) = CLng(511)
m_lOnBits(9) = CLng(1023)
m_lOnBits(10) = CLng(2047)
m_lOnBits(11) = CLng(4095)
m_lOnBits(12) = CLng(8191)
m_lOnBits(13) = CLng(16383)
m_lOnBits(14) = CLng(32767)
m_lOnBits(15) = CLng(65535)
m_lOnBits(16) = CLng(131071)
m_lOnBits(17) = CLng(262143)
m_lOnBits(18) = CLng(524287)
m_lOnBits(19) = CLng(1048575)
m_lOnBits(20) = CLng(2097151)
m_lOnBits(21) = CLng(4194303)
m_lOnBits(22) = CLng(8388607)
m_lOnBits(23) = CLng(16777215)
m_lOnBits(24) = CLng(33554431)
m_lOnBits(25) = CLng(67108863)
m_lOnBits(26) = CLng(134217727)
m_lOnBits(27) = CLng(268435455)
m_lOnBits(28) = CLng(536870911)
m_lOnBits(29) = CLng(1073741823)
m_lOnBits(30) = CLng(2147483647)
m_l2Power(0) = CLng(1)
m_l2Power(1) = CLng(2)
m_l2Power(2) = CLng(4)
m_l2Power(3) = CLng(8)
m_l2Power(4) = CLng(16)
m_l2Power(5) = CLng(32)
m_l2Power(6) = CLng(64)
m_l2Power(7) = CLng(128)
m_l2Power(8) = CLng(256)
m_l2Power(9) = CLng(512)
m_l2Power(10) = CLng(1024)
m_l2Power(11) = CLng(2048)
m_l2Power(12) = CLng(4096)
m_l2Power(13) = CLng(8192)
m_l2Power(14) = CLng(16384)
m_l2Power(15) = CLng(32768)
m_l2Power(16) = CLng(65536)
m_l2Power(17) = CLng(131072)
m_l2Power(18) = CLng(262144)
m_l2Power(19) = CLng(524288)
m_l2Power(20) = CLng(1048576)
m_l2Power(21) = CLng(2097152)
m_l2Power(22) = CLng(4194304)
m_l2Power(23) = CLng(8388608)
m_l2Power(24) = CLng(16777216)
m_l2Power(25) = CLng(33554432)
m_l2Power(26) = CLng(67108864)
m_l2Power(27) = CLng(134217728)
m_l2Power(28) = CLng(268435456)
m_l2Power(29) = CLng(536870912)
m_l2Power(30) = CLng(1073741824)
Private Function LShift(lValue, iShiftBits)
If iShiftBits = 0 Then
LShift = lValue
Exit Function
ElseIf iShiftBits = 31 Then
If lValue And 1 Then
LShift = &H80000000
Else
LShift = 0
End If
Exit Function
ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
Err.Raise 6
End If
If (lValue And m_l2Power(31 - iShiftBits)) Then
LShift = ((lValue And m_lOnBits(31 - (iShiftBits + 1))) * m_l2Power(iShiftBits)) Or &H80000000
Else
LShift = ((lValue And m_lOnBits(31 - iShiftBits)) * m_l2Power(iShiftBits))
End If
End Function
Private Function RShift(lValue, iShiftBits)
If iShiftBits = 0 Then
RShift = lValue
Exit Function
ElseIf iShiftBits = 31 Then
If lValue And &H80000000 Then
RShift = 1
Else
RShift = 0
End If
Exit Function
ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
Err.Raise 6
End If
RShift = (lValue And &H7FFFFFFE) \ m_l2Power(iShiftBits)
If (lValue And &H80000000) Then
RShift = (RShift Or (&H40000000 \ m_l2Power(iShiftBits - 1)))
End If
End Function
Private Function RotateLeft(lValue, iShiftBits)
RotateLeft = LShift(lValue, iShiftBits) Or RShift(lValue, (32 - iShiftBits))
End Function
Private Function AddUnsigned(lX, lY)
Dim lX4
Dim lY4
Dim lX8
Dim lY8
Dim lResult
lX8 = lX And &H80000000
lY8 = lY And &H80000000
lX4 = lX And &H40000000
lY4 = lY And &H40000000
lResult = (lX And &H3FFFFFFF) + (lY And &H3FFFFFFF)
If lX4 And lY4 Then
lResult = lResult Xor &H80000000 Xor lX8 Xor lY8
ElseIf lX4 Or lY4 Then
If lResult And &H40000000 Then
lResult = lResult Xor &HC0000000 Xor lX8 Xor lY8
Else
lResult = lResult Xor &H40000000 Xor lX8 Xor lY8
End If
Else
lResult = lResult Xor lX8 Xor lY8
End If
AddUnsigned = lResult
End Function
Private Function F(x, y, z)
F = (x And y) Or ((Not x) And z)
End Function
Private Function G(x, y, z)
G = (x And z) Or (y And (Not z))
End Function
Private Function H(x, y, z)
H = (x Xor y Xor z)
End Function
Private Function II(x, y, z)
II = (y Xor (x Or (Not z)))
End Function
Private Sub FF(a, b, c, d, x, s, ac)
a = AddUnsigned(a, AddUnsigned(AddUnsigned(F(b, c, d), x), ac))
a = RotateLeft(a, s)
a = AddUnsigned(a, b)
End Sub
Private Sub GG(a, b, c, d, x, s, ac)
a = AddUnsigned(a, AddUnsigned(AddUnsigned(G(b, c, d), x), ac))
a = RotateLeft(a, s)
a = AddUnsigned(a, b)
End Sub
Private Sub HH(a, b, c, d, x, s, ac)
a = AddUnsigned(a, AddUnsigned(AddUnsigned(H(b, c, d), x), ac))
a = RotateLeft(a, s)
a = AddUnsigned(a, b)
End Sub
Private Sub III(a, b, c, d, x, s, ac)
a = AddUnsigned(a, AddUnsigned(AddUnsigned(II(b, c, d), x), ac))
a = RotateLeft(a, s)
a = AddUnsigned(a, b)
End Sub
Private Function ConvertToWordArray(sMessage)
Dim lMessageLength
Dim lNumberOfWords
Dim lWordArray()
Dim lBytePosition
Dim lByteCount
Dim lWordCount
Const MODULUS_BITS = 512
Const CONGRUENT_BITS = 448
lMessageLength = Len(sMessage)
lNumberOfWords = (((lMessageLength + ((MODULUS_BITS - CONGRUENT_BITS) \ BITS_TO_A_BYTE)) \ (MODULUS_BITS \ BITS_TO_A_BYTE)) + 1) * (MODULUS_BITS \ BITS_TO_A_WORD)
ReDim lWordArray(lNumberOfWords - 1)
lBytePosition = 0
lByteCount = 0
Do Until lByteCount >= lMessageLength
lWordCount = lByteCount \ BYTES_TO_A_WORD
lBytePosition = (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE
lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(Asc(Mid(sMessage, lByteCount + 1, 1)), lBytePosition)
lByteCount = lByteCount + 1
Loop
lWordCount = lByteCount \ BYTES_TO_A_WORD
lBytePosition = (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE
lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(&H80, lBytePosition)
lWordArray(lNumberOfWords - 2) = LShift(lMessageLength, 3)
lWordArray(lNumberOfWords - 1) = RShift(lMessageLength, 29)
ConvertToWordArray = lWordArray
End Function
Private Function WordToHex(lValue)
Dim lByte
Dim lCount
For lCount = 0 To 3
lByte = RShift(lValue, lCount * BITS_TO_A_BYTE) And m_lOnBits(BITS_TO_A_BYTE - 1)
WordToHex = WordToHex & Right("0" & Hex(lByte), 2)
Next
End Function
Public Function MD5(sMessage)
Dim x
Dim k
Dim AA
Dim BB
Dim CC
Dim DD
Dim a
Dim b
Dim c
Dim d
Const S11 = 7
Const S12 = 12
Const S13 = 17
Const S14 = 22
Const S21 = 5
Const S22 = 9
Const S23 = 14
Const S24 = 20
Const S31 = 4
Const S32 = 11
Const S33 = 16
Const S34 = 23
Const S41 = 6
Const S42 = 10
Const S43 = 15
Const S44 = 21
x = ConvertToWordArray(sMessage)
a = &H67452301
b = &HEFCDAB89
c = &H98BADCFE
d = &H10325476
For k = 0 To UBound(x) Step 16
AA = a
BB = b
CC = c
DD = d
FF a, b, c, d, x(k + 0), S11, &HD76AA478
FF d, a, b, c, x(k + 1), S12, &HE8C7B756
FF c, d, a, b, x(k + 2), S13, &H242070DB
FF b, c, d, a, x(k + 3), S14, &HC1BDCEEE
FF a, b, c, d, x(k + 4), S11, &HF57C0FAF
FF d, a, b, c, x(k + 5), S12, &H4787C62A
FF c, d, a, b, x(k + 6), S13, &HA8304613
FF b, c, d, a, x(k + 7), S14, &HFD469501
FF a, b, c, d, x(k + 8), S11, &H698098D8
FF d, a, b, c, x(k + 9), S12, &H8B44F7AF
FF c, d, a, b, x(k + 10), S13, &HFFFF5BB1
FF b, c, d, a, x(k + 11), S14, &H895CD7BE
FF a, b, c, d, x(k + 12), S11, &H6B901122
FF d, a, b, c, x(k + 13), S12, &HFD987193
FF c, d, a, b, x(k + 14), S13, &HA679438E
FF b, c, d, a, x(k + 15), S14, &H49B40821
GG a, b, c, d, x(k + 1), S21, &HF61E2562
GG d, a, b, c, x(k + 6), S22, &HC040B340
GG c, d, a, b, x(k + 11), S23, &H265E5A51
GG b, c, d, a, x(k + 0), S24, &HE9B6C7AA
GG a, b, c, d, x(k + 5), S21, &HD62F105D
GG d, a, b, c, x(k + 10), S22, &H2441453
GG c, d, a, b, x(k + 15), S23, &HD8A1E681
GG b, c, d, a, x(k + 4), S24, &HE7D3FBC8
GG a, b, c, d, x(k + 9), S21, &H21E1CDE6
GG d, a, b, c, x(k + 14), S22, &HC33707D6
GG c, d, a, b, x(k + 3), S23, &HF4D50D87
GG b, c, d, a, x(k + 8), S24, &H455A14ED
GG a, b, c, d, x(k + 13), S21, &HA9E3E905
GG d, a, b, c, x(k + 2), S22, &HFCEFA3F8
GG c, d, a, b, x(k + 7), S23, &H676F02D9
GG b, c, d, a, x(k + 12), S24, &H8D2A4C8A
HH a, b, c, d, x(k + 5), S31, &HFFFA3942
HH d, a, b, c, x(k + 8), S32, &H8771F681
HH c, d, a, b, x(k + 11), S33, &H6D9D6122
HH b, c, d, a, x(k + 14), S34, &HFDE5380C
HH a, b, c, d, x(k + 1), S31, &HA4BEEA44
HH d, a, b, c, x(k + 4), S32, &H4BDECFA9
HH c, d, a, b, x(k + 7), S33, &HF6BB4B60
HH b, c, d, a, x(k + 10), S34, &HBEBFBC70
HH a, b, c, d, x(k + 13), S31, &H289B7EC6
HH d, a, b, c, x(k + 0), S32, &HEAA127FA
HH c, d, a, b, x(k + 3), S33, &HD4EF3085
HH b, c, d, a, x(k + 6), S34, &H4881D05
HH a, b, c, d, x(k + 9), S31, &HD9D4D039
HH d, a, b, c, x(k + 12), S32, &HE6DB99E5
HH c, d, a, b, x(k + 15), S33, &H1FA27CF8
HH b, c, d, a, x(k + 2), S34, &HC4AC5665
III a, b, c, d, x(k + 0), S41, &HF4292244
III d, a, b, c, x(k + 7), S42, &H432AFF97
III c, d, a, b, x(k + 14), S43, &HAB9423A7
III b, c, d, a, x(k + 5), S44, &HFC93A039
III a, b, c, d, x(k + 12), S41, &H655B59C3
III d, a, b, c, x(k + 3), S42, &H8F0CCC92
III c, d, a, b, x(k + 10), S43, &HFFEFF47D
III b, c, d, a, x(k + 1), S44, &H85845DD1
III a, b, c, d, x(k + 8), S41, &H6FA87E4F
III d, a, b, c, x(k + 15), S42, &HFE2CE6E0
III c, d, a, b, x(k + 6), S43, &HA3014314
III b, c, d, a, x(k + 13), S44, &H4E0811A1
III a, b, c, d, x(k + 4), S41, &HF7537E82
III d, a, b, c, x(k + 11), S42, &HBD3AF235
III c, d, a, b, x(k + 2), S43, &H2AD7D2BB
III b, c, d, a, x(k + 9), S44, &HEB86D391
a = AddUnsigned(a, AA)
b = AddUnsigned(b, BB)
c = AddUnsigned(c, CC)
d = AddUnsigned(d, DD)
Next
MD5 = LCase(WordToHex(a) & WordToHex(b) & WordToHex(c) & WordToHex(d))
End Function
%>
<%
Const PageToBeCalledAddress = "http://certificates.smartlite.it/certificates/"
Const PageToBeCalledName = "getcertificate.asp"
Const MailPageToBeCalledName = "mailmessage.asp"
Function GetSharedDate(dDate)
Dim sTemp
sTemp = FormatSharedDateString(Month(dDate)) & "/" & FormatSharedDateString(Day(dDate)) & "/" & Year(dDate)
GetSharedDate = sTemp
End Function
Function GetSharedTime(dDate)
Dim sTemp
If Hour(dDate) >= 12 Then
If Hour(dDate) > 12 Then
sTemp = FormatSharedDateString((Hour(dDate)-12)) & ":" & FormatSharedDateString(Minute(dDate))
Else
sTemp = FormatSharedDateString(Hour(dDate)) & ":" & FormatSharedDateString(Minute(dDate))
End If
sTemp = sTemp & " PM"
Else
If Hour(dDate) = 0 Then
sTemp = "12:" & FormatSharedDateString(Minute(dDate))
Else
sTemp = FormatSharedDateString(Hour(dDate)) & ":" & FormatSharedDateString(Minute(dDate))
End If
sTemp = sTemp & " AM"
End If
GetSharedTime = sTemp
End Function
Function FormatSharedDateString(sDate)
Dim sTemp
sTemp = sDate
If Len(sTemp) < 2 Then sTemp = "0" & sTemp
FormatSharedDateString = sTemp
End Function
Function GetSharedCertificate(iQuizScore, sCertificateKey, Cnn, iTimeZone, iUserID)
Dim iError, objHTTP, sOutput, sPageToCall, sPostData, i
Dim aData(), aValues(), sQuizTitle, RS, sAccountPassword
Set RS = Cnn.Execute("SELECT * FROM Options")
If Not RS.EOF Then
sQuizTitle = RS("QuizTitle")
sAccountPassword = RS("CertificateAccountID")
End If
Set RS = Nothing
ReDim aData(3)
ReDim aValues(3)
aData(0) = "Quiz_Title"
aData(1) = "Quiz_Score"
aData(2) = "Quiz_Date"
aData(3) = "Quiz_DateTime"
aValues(0) = sQuizTitle
aValues(1) = iQuizScore
aValues(2) = GetSharedDate(DateAdd("n", iTimeZone, Now()))
aValues(3) = GetSharedDate(DateAdd("n", iTimeZone, Now())) & " " & GetSharedTime(DateAdd("n", iTimeZone, Now()))
Set RS = Cnn.Execute("SELECT * FROM UserData")
If MULTI_PAGE Then
Dim RSData
Set RSData = Cnn.Execute("SELECT * FROM Users WHERE ID=" & iUserID)
Do While Not RS.EOF
ReDim Preserve aData(UBound(aData)+1)
ReDim Preserve aValues(UBound(aValues)+1)
aData(UBound(aData)) = RS("Name")
If Not RSData.EOF Then aValues(UBound(aValues)) = RSData("UD_" & RS("Name"))
If IsNull(aValues(UBound(aValues))) Then aValues(UBound(aValues)) = ""
RS.MoveNext
Loop
Set RSData = Nothing
Else
Do While Not RS.EOF
ReDim Preserve aData(UBound(aData)+1)
ReDim Preserve aValues(UBound(aValues)+1)
aData(UBound(aData)) = RS("Name")
aValues(UBound(aValues)) = Request.Form("UD_" & RS("Name"))
If IsNull(aValues(UBound(aValues))) Then aValues(UBound(aValues)) = ""
RS.MoveNext
Loop
End If
Set RS = Nothing
sPageToCall = PageToBeCalledAddress
If FORCE_UTF_8 Then
sPageToCall = sPageToCall & PageToBeCalledName
Else
sPageToCall = sPageToCall & "getcertificate_" & sLanguageString(54) & ".asp"
End If
For i = 0 To UBound(aData)
If i > 0 Then sPostData = sPostData & "&"
sPostData = sPostData & "Data" & i & "=" & Server.URLEncode(aData(i))
sPostData = sPostData & "&Values" & i & "=" & Server.URLEncode(aValues(i))
Next
sPostData = sPostData & "&Password=" & Server.URLEncode(sAccountPassword)
sPostData = sPostData & "&GenerateCertificate=1"
sPostData = sPostData & "&CertificateKey=" & sCertificateKey
sPostData = Replace(sPostData, " ", "WEBQUIZ_NON_BREAKING_SPACE")
sPostData = sPostData & "&CheckSum=" & MD5(sPostData)
iError = 0
On Error Resume Next
Set objHTTP = Server.CreateObject("WinHTTP.WinHTTPRequest.5.1")
If (Err.Number <> 0) Then iError = 2
On Error GoTo 0
If iError = 0 Then
On Error Resume Next
objHTTP.setTimeOuts 0, (Server.ScriptTimeOut*1000), (Server.ScriptTimeOut*1000), (Server.ScriptTimeOut*1000)
objHTTP.Open "POST", sPageToCall, False
objHTTP.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
objHTTP.Send(sPostData)
If Err.Number <> 0 Then iError = 2
On Error GoTo 0
If iError = 0 Then
If CInt(objHTTP.Status) = 200 Then 'All ok
sOutput = objHTTP.ResponseText
ElseIf CInt(objHTTP.Status) = 404 Then 'Page not found
iError = 3
ElseIf CInt(objHTTP.Status) = 204 Then 'No result, password wrong
iError = 4
Else 'Syntax/COM/other error
iError = 5
End If
If iError <> 0 Then sOutput = ""
If sOutput = "-1" Then sOutput = ""
End If
Set objHTTP = Nothing
End If
If sOutput <> "" Then sOutput = (PageToBeCalledAddress & sOutput)
GetSharedCertificate = sOutput
End Function
Function SendSharedEmail(sFrom, sTo, sBcc, sSubject, sBody, sAttachment, Cnn)
Dim iError, objHTTP, sPageToCall, bMailSent, sPostData, RS, sAccountPassword
sPageToCall = (PageToBeCalledAddress & MailPageToBeCalledName)
Set RS = Cnn.Execute("SELECT * FROM Options")
If Not RS.EOF Then sAccountPassword = RS("CertificateAccountID")
Set RS = Nothing
iError = 2
On Error Resume Next
Set objHTTP = Server.CreateObject("WinHTTP.WinHTTPRequest.5.1")
If (Err.Number = 0) Then iError = 0
On Error GoTo 0
sPostData = "SendMail=1"
sPostData = sPostData & "&From=" & Server.URLEncode(Replace(Replace(sFrom, " ", "WEBQUIZ_NON_BREAKING_SPACE"), vbCrLf, "WEBQUIZ_VB_CR_LF"))
sPostData = sPostData & "&To=" & Server.URLEncode(Replace(Replace(sTo, " ", "WEBQUIZ_NON_BREAKING_SPACE"), vbCrLf, "WEBQUIZ_VB_CR_LF"))
sPostData = sPostData & "&BCC=" & Server.URLEncode(Replace(Replace(sBcc, " ", "WEBQUIZ_NON_BREAKING_SPACE"), vbCrLf, "WEBQUIZ_VB_CR_LF"))
sPostData = sPostData & "&Subject=" & Server.URLEncode(Replace(Replace(sSubject, " ", "WEBQUIZ_NON_BREAKING_SPACE"), vbCrLf, "WEBQUIZ_VB_CR_LF"))
sPostData = sPostData & "&Body=" & Server.URLEncode(Replace(Replace(sBody, " ", "WEBQUIZ_NON_BREAKING_SPACE"), vbCrLf, "WEBQUIZ_VB_CR_LF"))
sPostData = sPostData & "&Attachment=" & Server.URLEncode(Replace(Replace(sAttachment, " ", "WEBQUIZ_NON_BREAKING_SPACE"), vbCrLf, "WEBQUIZ_VB_CR_LF"))
sPostData = sPostData & "&Pass=" & Replace(Replace(sAccountPassword, " ", "WEBQUIZ_NON_BREAKING_SPACE"), vbCrLf, "WEBQUIZ_VB_CR_LF")
sPostData = sPostData & "&CheckSum=" & MD5(sPostData)
If iError = 0 Then
On Error Resume Next
objHTTP.setTimeOuts 0, (Server.ScriptTimeOut*1000), (Server.ScriptTimeOut*1000), (Server.ScriptTimeOut*1000)
objHTTP.Open "POST", sPageToCall, False
objHTTP.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
objHTTP.Send(sPostData)
If Err.Number <> 0 Then iError = 2
On Error GoTo 0
If iError = 0 Then
If CInt(objHTTP.Status) = 200 Then 'All ok
If (objHTTP.ResponseText <> "1") Then iError = 1
ElseIf CInt(objHTTP.Status) = 404 Then 'Page not found
iError = 3
ElseIf CInt(objHTTP.Status) = 204 Then 'No result, password wrong
iError = 4
Else 'Syntax/COM/other error
iError = 5
End If
End If
Set objHTTP = Nothing
End If
bMailSent = (iError = 0)
SendSharedEmail = bMailSent
End Function
%>
<%
Server.ScriptTimeOut = 300
DB_CONNECTION_STRING = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath("/webquiz/database/smwq_prepositions.mdb") & ";"
QUIZ_TAG = "DBVFB"
SAVE_ANSWERS = True
QUESTIONS_TO_SHOW = 10
RANDOM_QUESTIONS = True
RANDOM_ANSWERS = True
PASSWORD = ""
ALLOW_ONE_ACCESS = False
MAX_TIME = 0
NO_BACK_BUTTON = False
NO_USER_CHANGES = False
SEND_ANSWERS_EMAIL_FROM = "walknick@hotmail.com"
SEND_ANSWERS_EMAIL = ""
SHOW_RIGHT_ANSWERS = True
SHOW_FULL_RESULTS = True
SHOW_TOTAL_SCORE = True
SHOW_EVALUATION = True
SHOW_COMMENT_AFTER_ANSWER = False
MULTI_PAGE = False
TIME_ZONE = 0
'SECURITY_OPTIONS = " ondragstart=""return false"" onselectstart=""return false"" onBeforePrint=""document.body.style.display = 'none';"" onAfterPrint=""document.body.style.display = 'block';"""
SHOW_PRINT_BUTTON = True
SHOW_CLOSE_BUTTON = False
SHOW_IP_ADDRESS = True
SHOW_PRINT_CERTIFICATE_BUTTON = True
SEND_ANSWERS_EMAIL_FORMAT = 0 '0=Questions and all given answers 1=Questions and wrong given answers 2=Questions and all given answers and all correct answers
SET_PAGECODE = False
USE_DEDICATED_PDF_COMPONENT = False
FORCE_UTF_8 = True
USE_TOPICS_STRUCTURE = False
If FORCE_UTF_8 Then
Response.CharSet = "utf-8"
Session.CodePage = 65001
Else
Response.CharSet = sLanguageString(53)
Session.CodePage = sLanguageString(54)
End If
Dim sCertificateSource, iQuizMaxScore, rsTopics, sQuestionsTopicID, iQuestionTopicsCount
CreditString = "
![]()
" & sLanguageString(0) & " "
'--- Do not edit below this line ---
iDBType = 0
If Instr(DB_CONNECTION_STRING, "Provider=SQLOLEDB.1") > 0 Then iDBType = 1
iTimeOut = Abs(MAX_TIME \ 60) * 2
If iTimeOut < 90 Then iTimeOut = 90
Session.TimeOut = iTimeOut
lUserID = CLng(Request.Form("UserID"))
iStatusID = CLng(Request.Form("StatusID")) '-1=Ready to evaluate, 0=First time, >0=Question number
iDirection = CLng(Request.Form("Direction")) '1=Next, -1=Back
sAnswersSequence = Request.Form("AnswersSequence")
If iStatusID > 1 And iDirection = 1 And MULTI_PAGE And SHOW_COMMENT_AFTER_ANSWER And Request.Form("Comments") <> "" Then
iStatusID = iStatusID - 1
bShowCommentsNow = True
End If
Function SLWQ_GetQuizMaxScore(cnnQuiz)
Dim RS, iScore, iQuestionScore, iScoRight, iScoWrong
Dim sRightAns, iScoNull, iAnsSco, i, iPos, bWrongFound
Dim iMaxAns, sChar, iMinScore, iMaxScore, aScores(), k
Dim aOutputScores(), j, bDoNotCheck
iScore = 0
k = 0
Set RS = cnnQuiz.Execute("SELECT * FROM Questions")
Do While Not RS.EOF
iQuestionScore = 0
iMaxAns = RS("MaxAnswers")
iScoRight = RS("ScoreRight")
iScoWrong = RS("ScoreWrong")
iScoNull = RS("ScoreNull")
sRightAns = RS("RightAnswer")
If RS("Type") = 0 Then 'Multiple Choise
iPos = InStr(sRightAns, "1")
For i = 1 To iMaxAns
If Not IsNull(RS("ScoreAnswer" & i)) Then
If i <> iPos Then
iScoWrong = iScoWrong + RS("ScoreAnswer" & i)
Else
iScoRight = iScoRight + RS("ScoreAnswer" & i)
End If
End If
Next
ElseIf RS("Type") = 1 Or RS("Type") = 2 Then 'Multiple Answer | True/False
bWrongFound = False
For i = 1 To iMaxAns
sChar = Mid(sRightAns, i, 1)
If Not IsNull(RS("ScoreAnswer" & i)) Then
If sChar = "1" Then iScoRight = iScoRight + RS("ScoreAnswer" & i)
iScoWrong = iScoWrong + RS("ScoreAnswer" & i)
If sChar <> "1" Then bWrongFound = True
End If
Next
If Not bWrongFound Then
iMinScore = 0
For i = 1 To iMaxAns
If Not IsNull(RS("ScoreAnswer" & i)) Then
If i = 1 Then iMinScore = RS("ScoreAnswer" & i)
If iMinScore > RS("ScoreAnswer" & i) Then iMinScore = RS("ScoreAnswer" & i)
End If
Next
iScoWrong = iScoWrong - iMinScore
End If
ElseIf RS("Type") = 3 Then 'FillIn
' Do nothing
End If
ReDim Preserve aScores(k)
If iScoWrong > iScoRight And iScoWrong > iScoNull Then
aScores(k) = iScore + iScoWrong
ElseIf iScoRight > iScoWrong And iScoRight > iScoNull Then
aScores(k) = iScore + iScoRight
ElseIf iScoNull > iScoWrong And iScoNull > iScoRight Then
aScores(k) = iScore + iScoNull
End If
If QUESTIONS_TO_SHOW < 0 Then
ReDim Preserve aOutputScores(k)
aOutputScores(k) = aScores(k)
End If
k = k + 1
RS.MoveNext
Loop
Set RS = Nothing
If QUESTIONS_TO_SHOW > 0 Then
If Not RANDOM_QUESTIONS Then
For i = 0 To (QUESTIONS_TO_SHOW-1)
ReDim Preserve aOutputScores(i)
aOutputScores(i) = aScores(i)
Next
Else
bDoNotCheck = False
ReDim aOutputScores(QUESTIONS_TO_SHOW-1)
For j = 0 To UBound(aOutputScores)
If j > UBound(aScores) Then
ReDim Preserve aOutputScores(j-1)
bDoNotCheck = True
Exit For
Else
aOutputScores(j) = aScores(j)
End If
Next
If Not bDoNotCheck Then
For i = j To UBound(aScores)
For k = 0 To UBound(aOutputScores)
If aOutputScores(k) < aScores(i) Then
aOutputScores(k) = aScores(i)
Exit For
End If
Next
Next
End If
End If
End If
For i = 0 To UBound(aOutputScores)
iScore = iScore + aOutputScores(i)
Next
SLWQ_GetQuizMaxScore = iScore
End Function
Function IsPrivateQuiz()
OpenConnection True
sSQL = "SELECT COUNT(*) FROM AllowedUsers"
If iDBType = 1 Then sSQL = sSQL & " AND QuizID=" & iQuizID
rsQuiz.Open sSQL, cnnQuiz, 1
IsPrivateQuiz = rsQuiz(0) > 0
CloseConnection rsQuiz, cnnQuiz
End Function
Function GetQuestionCount()
OpenConnection True
sSQL = "SELECT COUNT(*) FROM Questions"
If iDBType = 1 Then sSQL = sSQL & " AND QuizID=" & iQuizID
rsQuiz.Open sSQL, cnnQuiz, 1
GetQuestionCount = rsQuiz(0)
CloseConnection rsQuiz, cnnQuiz
End Function
Function CheckPassword()
If PASSWORD <> "" And UCase(Request.Form("TestPassword")) = UCase(PASSWORD) Then Session("TestPassword") = UCase(PASSWORD)
If PASSWORD <> "" And Session("TestPassword") <> UCase(PASSWORD) Then
PrintHeader ""
Response.Write "" & vbCrLf
Response.Write "