<%option explicit%> <% const secretword="" ' Enter your secret word here ' const diagdbtypes="Access, Sqlserver, Mysql, ODBC" const diagmailtypes="cdonts, aspmail,aspemail,jmail,jmail44,ocxmail,cdosys" '**************************************************************************** ' Form Diagnostic tool to test reading of files,mail, database read and write ' configuration ' Version 4.00 ' March 15, 2008 ' June 4, 2008 No database facilities ' Tests mailing and database read/write permissions '***************************************************************************** dim sAction dim conn, databasename, databaselocation, databaseserver, databaseuserid, databasepassword dim databasedriver dim dbtable dim messages(100),messagecount ' holds diagnostics messages dim currenturl dim secretwordvalue, helpmessage currentURL="testafh.asp" ' this file name dim curTest dim testsql messagecount=0 dim secretok Displayheader ' generate normal html header Getactiontype if saction="" then else saction=lcase(saction) select case saction case "mail" Testmail ' test mail case "database" Testdatabase ' test database case "configuration" Testconfiguration ' test confiuration end select end if Displayform displaytrailer ' generfate normal trailer '********************************************************************** ' what type of test is requested ' mail, database, file reading ' set scation field '******************************************************************* Sub getactiontype secretwordvalue=requestform("secretword") if secretword="" then secretok=false saction="" else If lcase(secretwordvalue)<>lcase(secretword) then secretok=false saction="" ' addinfo "Secret word does not match. No test was done." ' exit sub else secretok=true end if end if saction=request("mail") if saction<>"" then saction="mail" exit sub end if saction=request("database") if saction<>"" then saction="database" exit sub end if saction=request("configuration") if saction<>"" then saction="configuration" exit sub end if end sub '******************************************************************************** ' generates a number of form fields and buttons '******************************************************************************** Sub DisplayForm DisplayMessages response.write "
" response.write "
" Generateinfo response.write "" GenerateSecretword ' generate secret word If secretok=true then Generatemailtest ' mail sub form 'GeneratedatabaseTest Generateconfigurationtest ' configuration end if response.write "
" Response.Write("
") end sub '******************************************************************** ' generate row etc are all in afhdisplaysubs.asp file ' the file afhdatabasecofig.asp '******************************************************************* Sub GeneratedatabaseTest If request("databasename")="" then Setdatabasedefaults end if response.write "" generatetable GenerateRow "Database name","databasename","Data base name or ODBC connection" GenerateRowList "Database Type","databasetype",diagdbtypes,"Type of database" GenerateRow "Database Location","databaselocation","For access database only. The physical location" GenerateRow "Database Server","databaseServer","Form SQL Server and MYSQL, the server name" GenerateRow "Database Userid","databaseUserid","For SQL Server and MYSQL a userid that can read/write the database" GenerateRow "Database Password","databasePassword","Password for SQL Server or MYSQL database" GenerateRow "MYSQL Database Driver","databasedriver","MYSQL or MYSQL351 depdending on MYSQL version you have installed" Generatetableend GenerateSubmitbutton "database","Test Database","" response.write "
" end sub ' '******************************************************************************* ' database is in config_database '******************************************************************************* Sub Setdatabasedefaults Session("databasename")=config_databasename session("databasetype")=config_databasetype session("databaselocation")=config_databaselocation Session("databaseuserid")=config_databaseuserid session("databasepassword")=config_databasepassword session("databaseserver")=config_databaseserver session("databasedriver")=config_databasedriver end sub '********************************************************************* ' display any error messages store in messages array '******************************************************************* Sub DisplayMessages dim i if messagecount=0 then exit sub WriteArrayList messages, messagecount messagecount=0 end sub '***************************************************************************** ' the form value can come either from form or ' via session variable if person tried before '**************************************************************************** Sub GenerateRow (fieldcaption, fieldname, helpmessage) dim fieldvalue fieldvalue=request(fieldname) if fieldvalue="" then fieldvalue=session(fieldname) end if fieldsize=30 WriteFormRowText fieldcaption, fieldname, fieldvalue, fieldrequired, fieldsize, fieldvalid, helpmessage end sub '****************************************************************************** ' create a drop down list '****************************************************************************** Sub GenerateRowList (fieldcaption, fieldname, Ilist, helpmessage) dim fieldvalue, listarray(100), listcount, prompt fieldvalue=request(fieldname) if fieldvalue="" then fieldvalue=session(fieldname) end if fieldsize=30 prompt="" converttoarray ilist, listarray, listcount,"," WriteFormRowList fieldcaption, fieldname, fieldvalue, fieldrequired, fieldsize, fieldvalid, listarray, listcount, prompt, helpmessage end sub '*************************************************************************** ' display rows for mail test ' if the person has run a configuration test, then use those as default values '**************************************************************************** sub Generatemailtest if request("mailystem")="" then setmaildefaults end if response.write "" generatetable GenerateRow "Email System","mailsystem","mail system name provided by your web host" GenerateRowList "Email Interface","maildriver",diagmailtypes,"Driver name" GenerateRow "Sender email address","mailfromaddress","Email address of sender of this email" GenerateRow "Receiver email address","mailtoaddress","The email address where test message is to be sent" GenerateRow "Receiver email name","mailtoname","The person's name to whome message is to be sent" generatetableend GenerateSubmitbutton "mail","Test Mail","" response.write "
" end sub sub Setmaildefaults configcount=readsess("configcount") if configcount<>"" then confignames=readsessarray("confignames") configvalues=readsessarray("configvalues") 'for i = 0 to configcount-1 ' debugwrite confignames(i) & "=" & configvalues(i) 'next writesess "mailsystem",readconfig("config_emailsystem") writesess "maildriver",readconfig("config_emaildriver") writesess "mailfromaddress",readconfig("config_emailaddress") writesess "mailtoaddress",readconfig("config_emailaddress") writesess "mailtoname",readconfig("config_emailname") end if end sub '******************************************************************** ' configuration read and parse test '******************************************************************** Sub generateconfigurationtest response.write "" generatetable If request("configfilename")="" then session("configfilename")="config_forms.asp" end if GenerateRow "Configuration File","configfilename","Configuration file to be read and displayed" generatetableend GenerateSubmitbutton "configuration","Test Configuration","" response.write "
" end sub '***************************************************************** ' test database. first determine type and then do test ' three different tests can be done for different database types: access, sql server, MYSQL '***************************************************************** Sub TestDatabase dim databasetype databasetype=lcase(request("Databasetype")) Select case databasetype case "access" Testaccessdatabase case "sqlserver" testsqlserverdatabase case "mysql" testmysqldatabase case "odbc" testodbcdatabase end select Displaymessages end sub '************************************************************************* ' test access. pass location and name ' access requires name and location '************************************************************************ sub TestSqlServerDatabase databasename=request("databasename") databaseserver=request("databaseserver") databaseuserid=requestform("databaseuserid") databasepassword=requestform("databasepassword") writesess "diagnostic","Yes" writesess "errormessage","" addinfo "Trying to open SQL Server Database " & databasename OpenSqlserver conn, databasename, databaseserver, databaseUserid, databasepassword writesess "diagnostic","" if readsess("Errormessage")<>"" then adderror "Database could not be opened for the following reason" adderror readsess("errormessage") else addinfo "Database has been opened successfully" TestdatabaseRead conn testdatabasewrite conn end if closedatabase conn end sub '************************************************************************* ' test MYSQL. pass userid, password and driver and sever ' access requires name and location '************************************************************************ sub TestMYSQLDatabase databasename=request("databasename") databaseserver=request("databaseserver") databaseuserid=requestform("databaseuserid") databasepassword=requestform("databasepassword") databasedriver=requestform("databasedriver") writesess "diagnostic","Yes" writesess "errormessage","" addinfo "Trying to open MYSQL Database " & databasename OpenMYSQL conn, databasename, databaseserver, databaseUserid, databasepassword, databasedriver writesess "diagnostic","" if readsess("Errormessage")<>"" then adderror "Database could not be opened for the following reason" adderror readsess("errormessage") else addinfo "Database has been opened successfully" TestdatabaseRead conn testdatabasewrite conn end if closedatabase conn end sub '************************************************************************* ' test access. pass location and name ' access requires name and location '************************************************************************ sub TestODBCDatabase databasename=request("databasename") writesess "diagnostic","Yes" writesess "errormessage","" addinfo "Trying to open SQL Server Database " & databasename OpenODBC conn, databasename writesess "diagnostic","" if readsess("Errormessage")<>"" then adderror "Database could not be opened for the following reason" adderror readsess("errormessage") else addinfo "Database has been opened successfully" TestdatabaseRead conn testdatabasewrite conn end if closedatabase conn end sub '************************************************************************* ' test SQL Server Database. Server name, userid and password '' access requires name and location '************************************************************************ sub testaccessDatabase databasename=request("databasename") databaselocation=request("databaselocation") writesess "diagnostic","Yes" writesess "errormessage","" addinfo "Trying to open Access database " & databasename openaccess conn, databasename, databaselocation writesess "diagnostic","" if readsess("Errormessage")<>"" then adderror "Database could not be opened for the following reason" adderror readsess("errormessage") else addinfo "Database has been opened successfully" TestdatabaseRead conn testdatabasewrite conn end if closedatabase conn end sub '********************************************************************* ' try opening a known table afhforms '******************************************************************** Sub TestDatabaseRead(conn) on error resume next dim sql, rs dbtable="afhtables" testsql = "select * from " & dbtable Set rs = conn.Execute(Testsql) If not rs.eof then fieldvalue=rs(0) end if if err.number > 0 then addError "" & "Database read failed" & "" CheckMicrosoftError dbc else addInfo "Database can be read" end if Closerecordset rs end sub '********************************************************************* ' try writing to a known table afhadminlog '******************************************************************** sub testdatabasewrite (conn) dim sql, ipaddress dbtable="afhadminlog" ipaddress=request.servervariables("REMOTE_ADDR") curTest="Write database" sql="Insert into " & dbtable & "(loguserid, logaction,logipaddress) values ('testafh', 'testafh','" & ipaddress &"')" conn.execute(sql) If err.number > 0 then addError "" & "Write failed" & "" If conn.errors.count> 0 then AddError "Microsoft Message
" & GetSess("Openerror") CheckMicrosoftError dbc end if else Addinfo "Write database OK" end if end sub ' Sub addError (msg) messages(messagecount)=msg messagecount=messagecount+1 end sub Sub addInfo (msg) messages(messagecount)=msg messagecount=messagecount+1 end sub ' Sub Testmail '**************************************************** ' Get information from form '**************************************************** mailtrace="No" dim imailtype, mailsystem, fromaddress, fromname, toaddress, toname, body, subject dim ihtmlformat, attachmentlist ihtmlformat="Text" imailtype=requestform("maildriver") mailsystem=requestform("mailsystem") fromaddress=requestform("mailfromaddress") fromname="Advanced Form Handler Test Utility" toaddress=requestform("mailtoaddress") toname=request("mailtoname") body="Advanced Form Handler Mail Diagnostic " & now() subject="Advanced Form Handler Diagnostic Test" If imailtype="" then addinfo "Email driver is required" end if if mailsystem="" then addinfo "Mail system is required" end if If fromaddress="" then addinfo "From Address is required" end if if toaddress="" then addinfo "To address is required" end if if toname="" then addinfo "To name is required" end if if messagecount>0 then exit sub WritemailMessage fromname, fromaddress, toname, toaddress, subject, body, imailtype, mailsystem, ihtmlformat, attachmentlist, mailerror 'Debugwrite "mailerror=" & mailerror If mailerror<>"" then addinfo "An Error has occured sending mail" addinfo mailerror else addinfo "Mail has been sent" end if end sub '************ Sub CheckMicrosoftError (dbc) dim counter If dbc.errors.count> 0 then AddError "Error count=" & dbc.errors.count For counter= 0 to dbc.errors.count-1 AddError "Error #" & dbc.errors(counter).number addError "Error desc. -> " & dbc.errors(counter).description next End If end sub Sub RunFileReadTests on error resume next dim whichfile, fsobj, recordobj whichfile=server.mappath("license.txt") CurTest="Reading " & whichfile set fsObj = Server.CreateObject("Scripting.FileSystemObject") set RecordObj= fsObj.OpenTextFile(whichfile, 1, False) If Err.number=0 then AddError "Read successful" else adderror err.description end if recordobj.close set recordobj=nothing set fsobj=nothing end sub '*********************************************************************** ' create standard HTML header '*********************************************************************** sub Displayheader response.write "Advanced Form Handler Test Utility 3.00" response.write "" response.write "" response.write "" response.write "
" response.write "" end sub Sub Displaytrailer dim url response.write "
" url=generateurl("http://www.hkprog.com/afh/support.htm","For more assistance please click here") response.write url response.write "
" end sub ' sub GenerateInfo response.write "

" %> This diagnostic tool allows you to test the mail and database facilities.
You can also test reading the configuration file.

<% end sub Sub Testconfiguration dim i ConfigurationInit '********************************************************************************* ' some values are actually constants in ASP. ' These include database locations etc '********************************************************************************* if configcount=0 then response.write "Configuration cannot be read
" exit sub end if generatetable for i = 0 to configcount-1 WriteFormRowNull confignames(i),configvalues(i) next generatetableend end sub '******************************************************************** ' configuration read and parse test '******************************************************************** Sub generateSecretWord dim inword response.write "" generatetable inword=requestform("secretword") dim fieldvalue fieldsize=30 Fieldcaption="Secret Word" fieldname="secretword" fieldvalue=inword helpmessage="To protect against hackers
you must provide your secret word.
If you have not set one up, see the AFH documentation." WriteFormRowPassword fieldcaption, fieldname, fieldvalue, fieldrequired, fieldsize, fieldvalid, helpmessage 'GenerateRow "Secret Word","secretword"," generatetableend If secretok=false then GenerateSubmitbutton "secret","Continue","" end if response.write "
" end sub %>