%@ Language=VBScript %>
<% Option Explicit %>
<% Response.Buffer=True %>
<%
'********************************************************************
' Version 1.0.1
' Copyright 2001 by MetroStar Systems, Inc. all text, graphics,
' audio, design, software, and other works are the copyrighted works
' of MetroStar Systems, Inc. All Rights Reserved. Any redistribution
' or reproduction of any materials herein is strictly prohibited.
'********************************************************************
%>
<%
'********************************************************************
' Include DB header which opens DB connection
' and include header which contains standard functions
'********************************************************************
%>
<%
Dim numOrderID
strSQL="SELECT * " & _
"FROM Orders " & _
"WHERE SessionID=" & Session.SessionID
objRS.Open strSQL, objConn
If Not objRS.EOF Then
numOrderID=objRS("OrderID")
numTotal=objRS("Total")
total=numTotal
subtotal=objRS("Subtotal")
tax=objRS("Tax")
shipping=objRS("Shipping")
Response.Expires=-1
Else
Response.Redirect("index.asp")
End If
objRS.Close
%>
<%
Dim boolShipping
boolShipping=False
strSQL="SELECT * " & _
"FROM OrderCart " & _
"WHERE OrderID=" & numOrderID
objRS.Open strSQL, objConn
Do While Not objRS.EOF
If objRS("FormatTitle")<>"E-book" Then
boolShipping=True
End If
objRS.MoveNext
Loop
objRS.Close
%>
<%
Const c_Description=1
Const c_Name=2
Const c_Dependency=3
Const c_Validation=4
Const c_Fieldtype=5
Const c_Type=6
Const c_Value=7
Const c_Maxlength=8
Const c_Mandatory=9
Dim strValidate, strChecked
Dim numFormLength, arrName, arrFieldType, arrValue, arrDataOK, arrMandatory, strFormattedValue
Dim strFormName, strTableName
Dim strEmailBody, strEmailBody2, parmList, strUpdateFields, strShipEmailB
Dim strJSTypes, strJSValues, strJSMandatory, strJSDependencies
Dim i
Dim objXML, objRootElement, objForm, objElement
Dim boolDataOK
Set objXML=Server.CreateObject("Microsoft.XMLDOM")
boolDataOK=True
Dim boolDisplay
boolDisplay=True
objXML.ValidateOnParse=True
objXML.Load(Server.MapPath("CreditCard.xml"))
If objXML.ParseError.errorCode<>0 Then
Response.Write "Error: " & objXML.parseError.reason & " "
Response.Write "(code: 0x" & hex(objXML.parseError.errorCode) & ") "
Response.Write "At Line " & objXML.parseError.line & ", "
Response.Write "Position " & objXML.parseError.linepos & " of XML document. "
End If
Set objRootElement=objXML.documentElement
Set objForm=objRootElement.childNodes.Item(0)
i=1
For Each objElement In objForm.childNodes
ReDim arrName(i+1)
ReDim arrFieldType(i+1)
ReDim arrValue(i+1)
ReDim arrDataOK(i+1)
ReDim arrMandatory(i+1)
i=i+1
Next
numFormLength=i-1
i=1
For Each objElement In objForm.childNodes
arrName(i)=objElement.childNodes.Item(c_Name).Text
arrFieldType(i)=objElement.childNodes.Item(c_FieldType).Text
arrDataOK(i)=True
arrMandatory(i)=objElement.childNodes.Item(c_Mandatory).Text
i=i+1
Next
If Not boolShipping Then
arrFieldType(2)="hidden"
arrMandatory(2)="No"
arrFieldType(3)="hidden"
arrMandatory(3)="No"
arrFieldType(4)="hidden"
arrMandatory(4)="No"
arrFieldType(5)="hidden"
arrMandatory(5)="No"
arrFieldType(6)="hidden"
arrMandatory(6)="No"
arrFieldType(7)="hidden"
arrMandatory(7)="No"
arrFieldType(8)="hidden"
arrMandatory(8)="No"
arrFieldType(10)="hidden"
arrMandatory(10)="No"
arrFieldType(11)="hidden"
arrMandatory(11)="No"
arrFieldType(12)="hidden"
arrMandatory(12)="No"
End If
If Request("Submit")<>"" Or Request("Submit.x")<>"" Then
'********************************************************************
' If the form was submitted, collect information and validate it.
'********************************************************************
i=1
For Each objElement In objForm.childNodes
arrValue(i)=Request(arrName(i))
arrDataOK(i)=True
If objElement.childNodes.Item(c_Mandatory).Text<>"" Then
strValidate=arrMandatory(i)
If objElement.childNodes.Item(c_Dependency).Text<>strChecked And objElement.childNodes.Item(c_Dependency).Text<>"" Then
strValidate="No"
End If
arrDataOK(i)=Validate(objElement.childNodes.Item(c_Validation).Text, arrValue(i), objElement.childNodes.Item(c_Maxlength).Text, strValidate)
Select Case LCase(objElement.childNodes.Item(c_Fieldtype).Text)
Case "money"
strFormattedValue=ParsePrice(arrValue(i))
If strFormattedValue<>"" Then
arrValue(i)=strFormattedValue
End If
arrDataOK(i)=(strFormattedValue<>"" Or strValidate="No")
Case "phone"
strFormattedValue=ParsePhone(arrValue(i))
If strFormattedValue<>"" Then
arrValue(i)=strFormattedValue
End If
arrDataOK(i)=(strFormattedValue<>"" Or strValidate="No")
Case "date"
arrDataOK(i)=(IsDate(arrValue(i)) Or strValidate="No")
Case "checkbox"
If objElement.childNodes.Item(c_Dependency).Text="" Then
strChecked="Yes"
End If
Case "radio"
If objElement.childNodes.Item(c_Dependency).Text="" Then
strChecked=arrValue(i)
End If
End Select
If Not arrDataOK(i) Then
boolDataOK=False
End If
If i<12 or i>18 Then
strUpdateFields=strUpdateFields & objElement.childNodes.Item(c_Name).Text & "='" & EncodeDB(arrValue(i)) & "', "
strEmailBody=strEmailBody & objElement.childNodes.Item(c_Description).Text
End If
If Len(objElement.childNodes.Item(c_Description).Text)>0 Then
If Mid(objElement.childNodes.Item(c_Description).Text, Len(objElement.childNodes.Item(c_Description).Text), 1)<>":" Then
strEmailBody=strEmailBody & ":"
End If
End If
If i<12 or i>18 Then
strEmailBody=strEmailBody & vbcrlf & arrValue(i) & vbcrlf & vbcrlf
End If
If i=18 Then
strEmailBody=strEmailBody & vbcrlf
End If
End If
i=i+1
Next
bname=arrValue(1)
bcompany=arrValue(2)
baddr1=arrValue(3)
baddr2=arrValue(4)
bcity=arrValue(5)
bstate=arrValue(6)
bzip=arrValue(7)
bcountry=arrValue(8)
emailaddress=arrValue(9)
phonenumber=arrValue(10)
faxnumber=arrValue(11)
' comments=arrValue(12)
cardnumber=arrValue(13)
expmonth=arrValue(14)
expyear=arrValue(15)
dim seccode, aname, shipname, shipaddress1, shipaddress2, shipcity, shipstate, shipzip, shipcountry, lname
seccode=arrValue(18)
aname=arrValue(19)
shipname=arrValue(20)
shipaddress1=arrValue(21)
shipaddress2=arrValue(22)
shipcity=arrValue(23)
shipstate=arrValue(24)
shipzip=arrValue(25)
shipcountry=arrValue(26)
lname=arrValue(27)
strUpdateFields=Mid(strUpdateFields, 1, Len(strUpdateFields)-2)
'Call Send_Email (Request("email"),emailaddress, "Order", strEmailBody)
'Response.Write arrValue(20) & "Aqui esta la otra "
If boolDataOK Then
'Call Send_Email (Request("email"),emailaddress, "Order", strEmailBody)
'Response.Redirect "http://localhost/DreaMerchant/www/book/ASPComExample.asp"
'''Aqui puse codigo
Dim client
Set client = Server.CreateObject("PFProCOMControl.PFProCOMControl.1")
'build the parameter list, such that we have a sale transaction and
'a credit card tender.
parmList = "TRXTYPE=S&TENDER=C&ZIP=" + bzip + "&COMMENT1=ASP/COM Test Transaction"
parmList = parmList + "&ACCT=" + cardnumber
parmList = parmList + "&PWD=38zy408IND"'zacha1987"
parmList = parmList + "&USER=dreamindollars"'pedrozacharias"
parmList = parmList + "&VENDOR=dreamindollars"'pedrozacharias"
parmList = parmList + "&PARTNER=interl"'VeriSign"
'set the expiration date form the HTML form
dim myYear, myMonth
myYear = request("expyear")
If myYear<10 Then myYear = "0" + myYear End If
myMonth = request("expmonth")
If myMonth<10 Then myMonth = "0" + myMonth End If
parmList = parmList + "&EXPDATE=" + myMonth + myYear
'set the amount from the HTML form
parmList = parmList + "&AMT=" + request.form("amount")
parmList = parmList + "&NAME=" + bname + " " + lname
parmList = parmList + "&STREET=" + baddr1
parmList = parmList + "&CITY=" + bcity
parmList = parmList + "&STATE=" + request.form("bstate")
parmList = parmList + "&CVV2=" + request("seccode")
parmList = parmList + "&SHIPTOFIRSTNAME=" + request("shipname")
parmList = parmList + "&SHIPTOSTREET=" + request("shipaddress1")
parmList = parmList + "&SHIPTOCITY=" + request("shipcity")
parmList = parmList + "&SHIPTOSTATE=" + request("shipstate")
parmList = parmList + "&SHIPTOZIP=" + request("shipzip")
parmList = parmList + "&SHIPTOCOUNTRY=" + request("shipcountry")
''''''''''''''''''''''''
strSQL="SELECT * " & _
"FROM OrderProduct " & _
"WHERE OrderID=" & numOrderID
objRS.Open strSQL, objConn
strEmailBody2 = "Thak you very much for your purchase." & vbcrlf & vbcrlf
StrEmailBody2 = strEmailBody2 + "The following information will be used to complete the transaction:" & vbcrlf & vbcrlf
strEmailBody2 = strEmailBody2 + "Name: " + request.form("bname") & vbcrlf
strEmailBody2 = strEmailBody2 + "Last Name: " + request.form("lname") & vbcrlf
If objRS("ProductID")="7" Then
If request.form("aname") = "" Then
strEmailBody2 = strEmailBody2 + "Name for Autographed Copy: " + request("bname") + " " + request("lname") & vbcrlf
else
strEmailBody2 = strEmailBody2 + "Name for Autographed Copy: " + request("aname") & vbcrlf
End If
End If
strEmailBody2 = strEmailBody2 + "Address: " + request("baddr1") & vbcrlf
strEmailBody2 = strEmailBody2 + "City: " + request("bcity") & vbcrlf
strEmailBody2 = strEmailBody2 + "State: " + request("bstate") & vbcrlf
strEmailBody2 = strEmailBody2 + "Zip: " + request("bzip") & vbcrlf
Dim CC
CC = request("cardnumber")
Dim regEx
Set regEx = New RegExp
regEx.Global = true
regEx.IgnoreCase = True
regEx.Pattern = "[0-9]{12}"
CC = Trim(regEx.Replace(CC, "************"))
strEmailBody2 = strEmailBody2 + "Credit Card: " + CC & vbcrlf
Call Send_Email (Request("email"),request("emailaddress"), "Book Order", strEmailBody2)
Call Send_Email (Request("email"),"pzacharias@metrostarsystems.com","Order Review", strEmailBody)
Dim Ctx1, curString, done, varString, name, value
Ctx1 = client.CreateContext("payflow.verisign.com", 443, 30, "", 0, "", "")
curString = client.SubmitTransaction(Ctx1, parmList, Len(parmList))
client.DestroyContext (Ctx1)
' handle the response
done = 0
'loop until we're done processing the entire string
Do while Len(curString) <> 0
'get the next name value pair
if InStr(curString,"&") Then
varString = Left(curString, InStr(curString , "&" ) -1)
else
varString = curString
end if
Response.Write " "
'get the name part of the name/value pair
name = Left(varString, InStr(varString, "=" ) -1)
'get the value out of the name/value pair
value = Right(varString, Len(varString) - (Len(name)+1))
'write out the name/value pair in "name = value" format
response.write name
response.write " = "
Response.Write value
Response.Write " "
'skip over the &
if Len(curString) <> Len(varString) Then
curString = Right(curString, Len(curString) - (Len(varString)+1))
else
curString = ""
end if
Loop
Session.Abandon()
'Response.Redirect "thankyou.html"
'''' Hasta aqui
strSQL="UPDATE Orders SET " & strUpdateFields & " WHERE OrderID=" & numOrderID
objConn.Execute(strSQL)
boolDisplay=False
'Session.Abandon
Response.Redirect "thankyou.html"
End If
End If
'Response.Write bstate & " "
If boolDisplay Then
DisplayCC
End If
%>
<%
Sub DisplayCC
%>
“They can turn a
gesture of love into an unspeakable act of horror!”
This imaginative story begins
on Her Ladyship William George,a slave ship crossing
the Atlantic from 17th Century Africa to the New World
with a cargo of unfortunate souls and a doomed crew
in command. From a shipwreck on the shoals of an island
in the Caribbean to the urban landscape of modern-day
Washington, DC, the reader is taken on a wild ride
to discover Black Rush!
PURCHASE
ORDER COMPLETED
<%
esdfiles = ApiDriver.csi_order_getesd(OrderCtx)
If ApiDriver.bStat <> Succeed Then
Response.Write "csi_order_getesd: " + ApiDriver.csi_util_errorstr(ApiDriver.csi_order_error(OrderCtx))
Set ApiDriver = nothing
Exit Function
Else
nLBound = LBound(esdfiles)
nUBound = UBound(esdfiles)
If (esdfiles(nLBound ) <> "") Then
%>
To
download your copy of BLACK RUSH simply click and save
the the link below.
»
<%
End If
For i = nLBound to nUBound
file = esdfiles(i)
If (file <> "") Then
%>
<%
If (file = "Could not create URL.") Then
Response.Write file
Else
%>
DOWNLOAD HERE «