<%@LANGUAGE="VBSCRIPT" CODEPAGE="1252"%>
<%
Dim Recordset1__MMColParam
Recordset1__MMColParam = "2"
If (Request.QueryString("farm2") <> "") Then
Recordset1__MMColParam = Request.QueryString("farm2")
End If
%>
<%
myDSN="Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:\Inetpub\wwwroot\Menu\Profarin\Profarin2. mdb"
set CN=server.createobject("ADODB.Connection")
CN.Open myDSN
'cirRS stands for recordset corresponding to the resulting parameterized query
set Recordset1=server.createobject("ADODB.Recordset")
Recordset1.ActiveConnection = CN
'Dim sFiscalStaff
'sFiscalStaff = Request.QueryString("lstFiscalStaff")
if request("farm2") = "*" then
SQL = "SELECT * FROM Produtos"
'Response.Write SQL
Recordset1.Open SQL
end if
%>
<%
'************************************************* ******
'* ASP 101 Sample Code -
http://www.asp101.com/ *
'* *
'* This code is made available as a service to our *
'* visitors and is provided strictly for the *
'* purpose of illustration. *
'* *
'*
http://www.asp101.com/samples/license.asp *
'* *
'* Please direct all inquiries to
webmaster@asp101.com *
'************************************************* ******
%>
<% ' ***** Begin the functions to be called by the runtime script *****
' To find the actual runtime code scroll WAY DOWN....
' This function is written to enable the adding of multiples of an item
' but this sample always just adds one. If you wish to add different
' quantities simply replace the value of the Querystring parameter count.
' We didn't do this because we wanted to keep the whole thing simple and
' not get into using forms so it stayed relatively readable.
Sub AddItemToCart(iItemID, iItemCount, iItemCod)
If dictCart.Exists(iItemID) Then
dictCart(iItemID) = dictCart(iItemID) + iItemCount
Else
dictCart.Add iItemID, iItemCount
End If
Response.Write "<p>" & iItemCount & " of item # " & iItemID & " " & iItemCod & " have been added to your cart.</p>" & vbCrLf
End Sub
Sub RemoveItemFromCart(iItemID, iItemCount)
If dictCart.Exists(iItemID) Then
If dictCart(iItemID) <= iItemCount Then
dictCart.Remove iItemID
Else
dictCart(iItemID) = dictCart(iItemID) - iItemCount
End If
Response.Write "<p>" & iItemCount & " of item # " & iItemID & " have been removed from your cart.</p>" & vbCrLf
Else
Response.Write "<p>Couldn't find any of that item your cart.</p>" & vbCrLf
End If
End Sub
Sub ShowItemsInCart()
Dim objKey
Dim aParameters ' as Variant (Array)
Dim sTotal, sShipping
' Const ForReading = 1
' Const ForWriting = 2
' Const ForAppending = 8
%>
<table border="1" cellpadding="3" cellspacing="1">
<tr>
<td>Item #</td>
<td>Description</td>
<td>Quantity</td>
<td>Remove Item From Cart</td>
<td>Price</td>
<td>Totals</td>
</tr>
<%
dim sqltemp
'Dim objFSO, objFile
'Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
set rst5=Server.CreateObject("ADODB.Recordset")
sTotal = 0
For Each objKey in dictCart
Set rs_getDetail1 = Server.CreateObject("ADODB.Recordset")
rs_getDetail1.ActiveConnection = MM_Profarin_STRING
rs_getDetail1.Source = "SELECT * FROM Produtos WHERE Nome_Art = '" & objKey & "'"
rs_getDetail1.Open()
If not rs_getDetail1.EOF then
aParameters = GetItemParameters(objKey)
%>
<tr>
<td align="center"><%= objKey %></td>
<td align="left"><%=rs_getDetail1.Fields.Item("Cod_Art ").Value %></td>
<td align="center"><%= dictCart(objKey) %></td>
<td align="left"><a href="teste4.asp?action=del&item=<%= objKey %>&count=1">Remove One</a> <a href="teste4.asp?action=del&item=<%= objKey %>&count=<%= dictCart(objKey) %>">Remove All</a></td>
<td align="right">$<%'= aParameters(2) %></td>
<td align="right">$<%'= FormatNumber(dictCart(objKey) * CSng(aParameters(2)), 2) %></td>
</tr>
<%
' sTotal = sTotal + (dictCart(objKey) * CSng(aParameters(2)))
'rst5.close
rs_getDetail1.close
end if
' objFile.close
' SET objFile = NOTHING
' SET objFSO = NOTHING
Next
%>
</table>
<%
End Sub
Sub ShowFullCatalog()
Dim aParameters ' as Variant (Array)
Dim I
Dim iItemCount ' Number of items we sell
' If you are really going to use this sample this should probably be pulled from a DB
iItemCount = 3
%>
<center>
- <a href='?page=memberlist&letter=other'>#</a> -
<%
for x=1 to 26
response.write " <a href='?letter=" & chr(64+x) & "'>" & chr(64+x) & "</a> -"
next
%>
</center>
<table border="1" cellpadding="3" cellspacing="1">
<tr>
<td>Image</td>
<td>Description</td>
<td>Price</td>
<td>Add Item To Cart</td>
</tr>
<%
do until Recordset1.EOF
' For I = 1 to iItemCount
' aParameters = GetItemParameters(I)
%>
<tr>
<td><%=(Recordset1.Fields.Item("Cod_Art").Value)%> </td>
<td><%=(Recordset1.Fields.Item("Nome_Art").Value)% ></td>
<td><a href="teste4.asp?action=add&cod=<%=Recordset1.Fiel ds.Item("Cod_Art").Value%>&item=<%=Recordset1.Fiel ds.Item("Nome_Art").Value%>&count=1">Add this to my cart!</a></td>
</tr>
<%
Recordset1.MoveNext()
loop
%>
</table>
<%
End Sub
Sub PlaceOrder()
Dim objKey
Dim aParameters ' as Variant (Array)
Dim sTotal, sShipping
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
%>
<table border="1" cellpadding="3" cellspacing="1">
<tr>
<td>Item #</td>
<td>Description</td>
<td>Quantity</td>
<td>Price</td>
<td>Totals</td>
</tr>
<%
Dim con, sql_insert, data_source
Dim objFSO, objFile
Dim iCount, tempo
Dim tsObject,textfile 'Text Stream Object
sTotal = 0
Application.Lock
Application("ASPCounter1") = Application("ASPCounter1") + 1
Application.Unlock
Application("ASPCounter1") = right("0000" & Application("ASPCounter1"), 4)
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.CreateTextFile("C:\Inetpub\wwwroot\Menu\Pro farin\" & Pd(DAY(date()),2) & Pd(Month(date()),2) & Application("ASPCounter1") & ".txt",true)
'Cabeçalho Ficheiro
' Nº Encomenda
Application.Lock
Application("ASPCounter") = Application("ASPCounter") + 1
Application.Unlock
Application("ASPCounter") = right(" " & Application("ASPCounter"), 12)
objFile.write Application("ASPCounter") & " 102 " & " 2 " & " 3F" & right("000000000" & Session("delegado"),9) & " 4 " & " 5" & Pd(DAY(date()),2) & Pd(Month(date()),2) & right(YEAR(Date()),2) & " " & " 6 "
'Inserir encomendas na BD
For Each objKey in dictCart
set conn=Server.CreateObject("ADODB.Connection")
conn.Provider="Microsoft.Jet.OLEDB.4.0"
conn.Open(Server.Mappath("profarin2.mdb"))
Set rs_getDetail2 = Server.CreateObject("ADODB.Recordset")
sSQL = "SELECT Cod_Art, Nome_Art FROM Produtos WHERE Nome_Art = '" & objKey & "'"
rs_getDetail2.Open sSQL,conn, 3,3
If not rs_getDetail2.EOF then
data_source = "dsn=Profarin;"
sql_insert = "insert into Encomendas (CodEnc,CodProd, NomeProd,QtaEnc,Dia,Hora) values ('" & Application("ASPCounter") & "', " & rs_getDetail2.Fields.Item("Cod_Art").Value & ", '" & rs_getDetail2.Fields.Item("Nome_Art").Value & "', " & dictCart(objKey) & ", #" & date() & "#, #" & time() & "#)"
' Creating the Connection Object and opening the database
Set con = Server.CreateObject("ADODB.Connection")
con.Open data_source
' Executing the sql insertion code
con.Execute sql_insert
aParameters = GetItemParameters(objKey)
nome = (rs_getDetail2.Fields.Item("Cod_Art").Value)
'euNumber = RTrim(MyString)
'euNumber = right("000000000000" & nome, 12)
qta = dictCart(objKey)
qta = right("0000" & qta,4)
nome_qta = nome & qta
nome_qta = right(" " & nome_qta, 12)
'euNumber1 = left(euNumber,5)
'euNumber1 = replace(euNumber1,"0"," ")
'euNumber2 = mid(euNumber,6,12)
'euNumber3 = euNumber1 & euNumber2
iCount = iCount + 1
objFile.Write(nome_qta)
%>
<tr>
<td align="center"><%= objKey %></td>
<td align="left"><%=rs_getDetail2.Fields.Item("Cod_Art ").Value %></td>
<td align="center"><%= dictCart(objKey) %></td>
<td align="right">$<%'= FormatNumber(dictCart(objKey) * CSng(aParameters(2)), 2) %></td>
</tr>
<%
' sTotal = sTotal + (dictCart(objKey) * CSng(aParameters(2)))
rs_getDetail2.close
conn.close
end if
Next
iCount = iCount + 8
' iCount = right(iCount & " ", 12)
objFile.Write left("Z" & iCount & " ",12)
objFile.close
SET objFile = NOTHING
SET objFSO = NOTHING
' Done. Now Close the connection
con.Close
Set con = Nothing
' Calculate shipping
sShipping = CalculateShippingCost(sTotal)
' Add shipping to total
sTotal = sTotal + sShipping
%>
<tr>
<td colspan="4" align="right"><b>S+H:</b></td>
<td align="right">$<%= FormatNumber(sShipping, 2) %></td>
</tr>
<tr>
<td colspan="4" align="right"><b>Total:</b></td>
<td align="right">$<%= FormatNumber(sTotal, 2) %></td>
</tr>
</table>
<%
' You could also do whatever other processing you would need to here.
' For example, send credit card info to processor or send order details
' to your warehouse for shipping. I'm just gonna send an email with
' the product details so you can see how you'd access them. Please
' be aware that email is NOT SECURE! So please don't transfer users'
' personal or credit card information this way.
Dim objMessage, strMessageBody
strMessageBody = "Quantity Item# Description Unit Price Total" & vbCrLf & vbCrLf
For Each objKey in dictCart
aParameters = GetItemParameters(objKey)
strMessageBody = strMessageBody & " " & dictCart(objKey)
strMessageBody = strMessageBody & " " & objKey
' strMessageBody = strMessageBody & " " & aParameters(1)
' strMessageBody = strMessageBody & String(25 - Len(aParameters(1)), " ") & aParameters(2)
' strMessageBody = strMessageBody & " " & FormatNumber(dictCart(objKey) * CSng(aParameters(2)), 2) & vbCrLf
Next
strMessageBody = strMessageBody & vbCrLf
strMessageBody = strMessageBody & String(41, " ") & "Shipping: " & FormatNumber(sShipping, 2) & vbCrLf
strMessageBody = strMessageBody & vbCrLf
strMessageBody = strMessageBody & String(37, " ") & "Order Total: " & FormatNumber(sTotal, 2) & vbCrLf
'Response.Write "<pre>" & strMessageBody & "</pre>"
Set objMessage = Server.CreateObject("CDO.Message")
With objMessage
' Set message attributes
.To = "Full Name <user name@some domain.com>"
.From = "Full Name <user name@some domain.com>"
.Subject = "Shopping Cart Contents"
.TextBody = strMessageBody
' Send message - uncomment the following line only
' AFTER you've entered appropriate To and From
' addresses above. Then the script will actually
' send the messages.
'.Send
End With
Set objMessage = Nothing
Response.AddHeader "Refresh", "5;URL=http://www.google.com/"
End Sub
' We implemented this this way so if you attach it to a database you'd only need one call per item
Function GetItemParameters(iItemID)
Dim aParameters ' Will contain 3 string values : image path, description, price
' However we need to keep price so it can be converted to a
' single for computation hence no currency symbol. This array
' can also be expanded to contain any other information about the
' product that you might want to pull from the DB.
' Select Case iItemID
' Case 1
aParameters = CStr(Request.QueryString("cod"))
' Case 2
' aParameters = Recordset1.Fields.Item("Nome_Art").Value
' Case 3
' aParameters = Recordset1.Fields.Item("Nome_Art").Value
' Case 4 ' Not in use because we couldn't draw a pen in a few seconds!
' aParameters = Recordset1.Fields.Item("Nome_Art").Value
' End Select
' Return array containing product info.
GetItemParameters = aParameters
End Function
' Free shipping if there's nothing to ship or the merchandise
' subtotal is over $100. Otherwise, small orders are $5 and
' larger orders are $7.50.
Function CalculateShippingCost(sngOrderTotal)
Dim sngShipping
If sngOrderTotal <= 0 Or sngOrderTotal > 100 Then
sngShipping = 0
ElseIf sngOrderTotal < 50 Then
sngShipping = 5
Else
sngShipping = 7.50
End If
CalculateShippingCost = sngShipping
End Function
%>
<% ' ***** Begin the infamous runtime script *****
' Declare our Vars
Dim dictCart ' as dictionary
Dim dictCart1 ' as dictionary
Dim sAction ' as string
Dim iItemID ' as integer
Dim iItemCount ' as integer
Dim iItemCod ' as integer
' Get a reference to the cart if it exists otherwise create it
If IsObject(Session("cart")) Then
Set dictCart = Session("cart")
' Set dictCart1 = Session("cart")
Else
' We use a dictionary so we can name our keys to correspond to our
' item numbers and then use their value to hold the quantity. An
' array would also work, but would be a little more complex and
' probably not as easy for readers to follow.
Set dictCart = Server.CreateObject("Scripting.Dictionary")
' Set dictCart1 = Server.CreateObject("Scripting.Dictionary")
End If
If IsObject(Session("cart1")) Then
Set dictCart1 = Session("cart1")
' Set dictCart1 = Session("cart")
Else
' We use a dictionary so we can name our keys to correspond to our
' item numbers and then use their value to hold the quantity. An
' array would also work, but would be a little more complex and
' probably not as easy for readers to follow.
Set dictCart1 = Server.CreateObject("Scripting.Dictionary")
' Set dictCart1 = Server.CreateObject("Scripting.Dictionary")
End If
' Get all the parameters passed to the script
sAction = CStr(Request.QueryString("action"))
iItemID = CStr(Request.QueryString("item"))
iItemCount = CInt(Request.QueryString("count"))
iItemCod = CStr(Request.QueryString("cod"))
'session("teste") = iItemCod
'teste = left(iItemCod,7)
'Session.Abandon
%>
<table border="0" cellspacing="0" cellpadding="0">
<tr><td><%
' Select action based on user input
Select Case sAction
Case "add"
AddItemToCart iItemID, iItemCount, iItemCod
' AddItemToCart1 iItemID, iItemCount, iItemCod
ShowItemsInCart
%>
</td></tr>
<tr><td align="right"><a href="teste4.asp?action="><img src="images/shop_look.gif" border="0" width="46" height="46" alt="Continue Looking" /></a> <a href="teste4.asp?action=checkout"><img src="images/shop_checkout.gif" border="0" width="46" height="46" alt="Checkout" /></a>
<%
Case "del"
RemoveItemFromCart iItemID, iItemCount
ShowItemsInCart
%>
</td></tr>
<tr><td align="right"><a href="teste4.asp?action="><img src="images/shop_look.gif" border="0" width="46" height="46" alt="Continue Looking" /></a> <a href="teste4.asp?action=checkout"><img src="images/shop_checkout.gif" border="0" width="46" height="46" alt="Checkout" /></a>
<%
Case "viewcart"
ShowItemsInCart
%>
</td></tr>
<tr><td align="right"><a href="teste4.asp?action="><img src="images/shop_look.gif" border="0" width="46" height="46" alt="Continue Looking" /></a> <a href="teste4.asp?action=checkout"><img src="images/shop_checkout.gif" border="0" width="46" height="46" alt="Checkout" /></a>
<%
Case "checkout"
PlaceOrder
%>
</td></tr>
<tr><td align="left">
<br /><br />
<h3>Thank you for your order!</h3>
<p>
If this had been an actual shopping cart, this is where you would have had them enter
their personal information and payment method and then taken care of any backend
processing before finalizing their order. However as this is a shopping cart sample
and this is where security becomes a problem, we'll leave it for a future sample.
</p>
<%
Case Else ' Shop
ShowFullCatalog
%>
</td></tr>
<tr>
<td align="right"><a href="teste4.asp?action=viewcart"><img src="images/shop_cart.gif" border="0" width="46" height="46" alt="View Cart Contents" /></a>
<%
End Select
' Return cart to Session for storage
Set Session("cart") = dictCart
Set Session("cart1") = dictCart1
'Set Session("cart") = dictCart1
%>
</td>
</tr>
</table>
<%
Sub Application_OnStart
Application.Lock
Application("ASPCounter") = 1 ' Starting amount
' Application("ASPCounterDate") = formatdatetime(now,vblongdate)
Application.Unlock
End Sub
%>
<%
Function pd(n, totalDigits)
if totalDigits > len(n) then
pd = String(totalDigits-len(n),"0") & n
else
pd = n
end if
End Function
%>
<%
Recordset1.Close()
Set Recordset1 = Nothing
CN.Close
set CN=nothing
%>
I have this program that is an online store but i have this problem, when i add a produt i get an error saying "The operation is not allowed if the object is closed" in the Recordset1.Close().
If i comment that 2 lines:
Recordset1.Close()
Set Recordset1 = Nothing
I can add the produt i choose to the basket, but if want to add another produt i get the same error saying: "The operation is not allowed if the object is closed" in the line that have
do until Recordset1.EOF
Notice that i have a first asp page that i can search all the products if i want (putting a * signal) or seaching by name or code of the product.
please help me someone
Thank you
Recordset Problem
Linear Mode
