<%@ Language=VBScript%>
<%
'This active server page collects problem report data and saves it in the PR-Tracker
'database. This webpage works as is but will need to be customized to meet your company
'requirements. Minimally you will need to modify the constants in the SIMPLE
'CUSTOMIZATION BLOCK below. After you customize the webpage, you should rename or move it
'so that it isn't overwritten during a PR-Tracker upgrade.
'If you would like help customizing this webpage contact support@prtracker.com.
Option Explicit
Response.Buffer = true
Response.ExpiresAbsolute = 0
%>
<%
'*************************** SIMPLE CUSTOMIZATION BLOCK ***************************
%>
<%
'The PROJECT_DIR constant specifies what PR-Tracker project the problem report
'must be saved in.
const PROJECT_DIR = "DEMO"
'These two constant settings specify the message the user will see after
'entering a problem report. Search the code below to see how they are used
'and then customize them to meet your requirements.
const MESSAGE_TO_ORIGINATOR = "Message to originator to be supplied"
const URL_REDIRECT = "DemoResponse.asp"
const TEMP_DIR = "C:\TEMP\"
const DEFAULT_METHOD = "Customer Report"
const DEFAULT_STATUS = "New"
const DEFAULT_PRIORITY = 1
const DEFAULT_PROBLEM_TYPE = "TBD"
const EMAIL_FROM_NAME = "PR-Tracker Demo"
const EMAIL_FROM = "TechSupport@prtracker.com"
const EMAIL_HOST = "www.prtracker.com"
const EMAIL_ADDRESS_LOG_FILE = "d:\www\prtracker\LogFiles\EmailAddresses.txt"
'Default option for product drop down list
Dim PRODUCT_CHOICE(2)
PRODUCT_CHOICE(0) = "Product A"
PRODUCT_CHOICE(1) = "Product B"
PRODUCT_CHOICE(2) = "Product C"
Dim OS_CHOICE(7)
OS_CHOICE(0) = "Windows 95"
OS_CHOICE(1) = "Windows 98"
OS_CHOICE(2) = "Windows ME"
OS_CHOICE(3) = "Windows NT Workstation 4.0"
OS_CHOICE(4) = "Windows NT Server 4.0"
OS_CHOICE(5) = "Windows 2000 Pro"
OS_CHOICE(6) = "Windows 2000 Server"
OS_CHOICE(7) = "Other ..."
'************************ END OF SIMPLE CUSTOMIZATION BLOCK ***********************
'Data items collected on problem report form
Dim gstrCompanyName, gstrTelephone, gstrEmail, gstrOriginator
Dim gstrVersion, gstrOS, gstrProblemDescription
'Other variables
Dim bytRequest, lngTotalBytes, gstrPrText
Dim strData, strTempFileName
Dim strPrNumber, strErrorMessage
if Request.QueryString("submit") <> "true" then
'BEGIN CLIENT SIDE HTML AND JAVA
%>
Problem Report
<% 'END OF CLIENT SIDE HTML AND JAVA
Else 'Request.QueryString("submit") = "true"
'So we need to process the data entered in the Problem Report form
lngTotalBytes = Request.TotalBytes
bytRequest = Request.BinaryRead(lngTotalBytes)
call ParseRequest(bytRequest)
gstrOriginator = GetFieldValue("UserName")
gstrCompanyName = GetFieldValue("CompanyName")
gstrTelephone = GetFieldValue("Telephone")
gstrEmail = GetFieldValue("Email")
gstrVersion = GetFieldValue("Version")
gstrOS = GetFieldValue("OS")
gstrProblemDescription = GetFieldValue("ProblemDescription")
strTempFileName = TEMP_DIR & "\pr" & month(date) & day(date)& hour(Time) & minute(Time) & second(Time)& ".prx"
strData = BuildPRData()
call SaveToFile(strData,strTempFileName)
If Err.number <> 0 Then
Response.Write "An error occured while saving the problem report data to " & " " _
& "the a temporary file on the server." & " " & Err.Description
else
if SaveProblemReportInDatabase(strTempFileName,PROJECT_DIR,gstrOriginator,strPrNumber,strErrorMessage) then
if isEmailAddress(gstrEmail) then
SendConfirmationEmail(strPrNumber)
end if
Response.Redirect URL_REDIRECT & "?PrNumber=" & strPrNumber
else
Response.Write "An error occured while saving the problem report to the database." _
& " " & strErrorMessage
End If
End If
Response.End
end if
function FormatPrNumber(strPrNumber)
FormatPrNumber = right("000" & strPrNumber,4)
end function
Function MakeUniversalDate(newDate)
Dim strDate
strDate = "#" & DatePart("yyyy",newDate)
strDate = strDate & "-" & Right("0" & DatePart("m", newDate),2)
strDate = strDate & "-" & Right("0" & DatePart("d", newDate),2)
strDate = strDate & (" 00:00:00")
strDate = strDate & "#"
MakeUniversalDate = strDate
End Function
Function BuildPRData()
'This function formats the problem report data in the format of PR-Tracker .PR files.
'View any .PR file with Notepad for more information about the format.
dim strPrData, strPrText, lngTextLength, i
Dim strAttachmentLinks, strAttachmentName
strPrData = ":Title=" & MakeTitle(gstrProblemDescription) & vbnewline
strPrData = strPrData & ":Originator=" & gstrOriginator & vbnewline
strPrData = strPrData & ":OrigDate=" & MakeUniversalDate(date) & vbnewline
strPrData = strPrData & ":Investigator=" & vbnewline
strPrData = strPrData & ":Resolver=" & vbnewline
strPrData = strPrData & ":Verifier=" & vbnewline
strPrData = strPrData & ":Status=" & DEFAULT_STATUS & vbnewline
strPrData = strPrData & ":Priority=" & cstr(DEFAULT_PRIORITY) & vbnewline
strPrData = strPrData & ":Type=" & cstr(DEFAULT_PROBLEM_TYPE) & vbnewline
strPrData = strPrData & ":Sub Type=" & vbnewline
strPrData = strPrData & ":Method=" & cstr(DEFAULT_METHOD) & vbnewline
strPrText = strPrText & "Name: " & gstrOriginator & vbnewline
strPrText = strPrText & "Company Name:" & gstrCompanyName & vbnewline
strPrText = strPrText & "Telephone: " & gstrTelephone & vbnewline
strPrText = strPrText & "Email: " & gstrEmail & vbnewline
strPrText = strPrText & "Version: " & gstrVersion & vbnewline
strPrText = strPrText & "OS: " & gstrOS & vbnewline & vbnewline
strPrText = strPrText & "Description: " & vbnewline & gstrProblemDescription & vbnewline & vbnewline
for i = 1 to 3
strAttachmentName = GetFileName("Attachment" & trim(cstr(i)))
if strAttachmentName <> "" then
strPrText = strPrText & "Attachment: "
lngTextLength = len(strPrText)
strPrText = strPrText & strAttachmentName & vbnewline
strAttachmentLinks = strAttachmentLinks & ":Attachment=" & trim(cstr(lngTextLength)) & ";" & strAttachmentName & vbnewline
end if
next
gstrPrText = strPrText'Used by SendEmailConfirmation
BuildPRData = strPrData & strPrText & strAttachmentLinks
End Function
Function SaveToFile(vstrData,vstrFileName)
'Saves problem data to a temporary file on the server
Dim fs, f, pos
set fs = Server.CreateObject("Scripting.FileSystemObject")
pos = InStrRev(vstrFileName,"\")
set f = fs.CreateTextFile(vstrFileName,true)
f.write vstrData
f.close()
set f = nothing
set fs = nothing
End Function
Function SaveProblemReportInDatabase(vstrTempFileName,vstrProjectDir,vstrOriginator,vstrPrNumber,vstrErrorMessage)
dim strResponse, strAttachmentFilename, strAttachData
dim objPRServer, i, strTransaction, intStart, intEnd
set objPRServer = Server.CreateObject("prwebsvr.clsPrTrackerDBFiles")
strTransaction = objPRServer.AddNewProblemReport(vstrTempFileName,vstrProjectDir,vstrOriginator)
'If the problem report was saved succesfully, the strTransaction value returned
'Will be formauated similar to "#1997-03-01 13:47:18#;118;1;1;Mien Manager".
'Otherwise there will be an error message will be returned.
intStart = instr(strTransaction,"#;") + 2
if intStart > 2 then
'Get the PR Number which follows #;
intEnd = instr(intStart,strTransaction,";") - 1
vstrPrNumber = mid(strTransaction,intStart,intEnd-intStart+1)
for i = 1 to 2
strAttachmentFilename = GetFileName("Attachment" & trim(cstr(i)))
If strAttachmentFilename <> "" then
strAttachmentFilename = vstrProjectDir & "\Attachments\" & FormatPrNumber(vstrPrNumber) & "\" & strAttachmentFilename
strAttachData = GetFileContent("Attachment" & trim(cstr(i)))
strResponse = objPRServer.PutFile(strAttachmentFilename, strAttachData)
end if
next
SaveProblemReportInDatabase = true
else
'Substring #; wasn't found. There must be an error.
vstrErrorMessage = strTransaction
SaveProblemReportInDatabase = false
end if
set objPRServer = nothing
End Function
Sub DisplayOptions(OptionArray, SelectedIndex)
Dim index, i
if not IsArray(OptionArray) then exit sub
for each i in OptionArray
if i = SelectedIndex then
Response.Write ("")
else
Response.Write ("")
end if
next
End Sub
'Get the first line of text up to 80 characters
Function MakeTitle(strText)
Dim intEolPosition, strTitle
intEolPosition = instr(strText,vbnewline)
if intEolPosition > 1 then
strTitle = Left(strText,intEolPosition-1)
else
strTitle = strText
end if
strTitle = Left(strTitle,80)
if strTitle = "" then
strTitle = "No Title"
end if
MakeTitle = strTitle
End Function
Function SendConfirmationEmail(strPrNumber)
Dim Mailer
Set Mailer = Server.CreateObject("SMTPsvg.Mailer")
Mailer.FromName = EMAIL_FROM_NAME
Mailer.FromAddress = EMAIL_FROM
Mailer.RemoteHost = EMAIL_HOST
Mailer.AddRecipient gstrOriginator, gstrEmail
Mailer.ReturnReceipt = false
Mailer.ConfirmRead = false
Mailer.Subject = "PR-Tracker Demo Problem " & strPrNumber
Mailer.BodyText = "Thank you for trying our demo Problem Report form. We hope you" _
& vbnewline & "try PR-Tracker Web Client too." & vbnewline & vbnewline & gstrPrText
Mailer.Timeout = 30
Mailer.SendMail
set Mailer = nothing
End Function
Function isEmailAddress (vstrEmail)
if len(vstrEmail) >0 and instr(1,vstrEmail, "@")>0 then
isEmailAddress = True
else
isEmailAddress = False
end if
End Function
%>