frete gratis sistemas locaweb...

Fernando Web · Abril 16, 2009

Boa tarde a todos...

Sou administrador de uma loja virtual e a desenvolvi em cima do codigo fonte locaweb.

Vi que não é possivel disponibilizar aos usuarios a opção de frete gratuito, então corri atraz e desenvolvi uma solução.

Funciona da seguinte maneira:

O frete só gratuito para determinadas faixas de CEP, que são as cidades que a minha empresa atende, o sistemas esta funcionando normalmentemas tem um problema: não consegui que o frete apareça para compras acima de 100R$.

Não consigo pegar o valor total da compra. Se alguem puder me ajudar fico grato!!!

Codigo: cep_frete.asp

<!--#INCLUDE FILE="funcoes/funcoes_config_loja.asp" -->
<!--#INCLUDE FILE="funcoes/funcoes.asp" -->
<%

Call abre_conexao(conexao)

'Carrega a configuração geral da loja
Call Carrega_Configuracao()


informacoes = ""

If request("pais") <> "" then
	VarPAIS = request("pais")
End if

If (request("cep") <> "") Then
	VarCEP = request("cep")
End if

If request("pesofrete") <> "" then
	FctPeso = request("pesofrete")
End if

var_valor = "valor"

If (VarCEP <> "") Or (request("pais") <> "BR") Then
	If (request("pais") <> "") Then
		Call Consulta_CEP(VarCEP)
	End If
End if

' Consulta o frete para o CEP
Function Consulta_CEP(VarCEP)

	If (request("pais") = "BR") Then
		SET Cep_obj = CreateObject("Correios.CEP")

		Cep_obj.EncontraCEP(VarCEP)
		If Cep_obj.Erro	= 0 then
			vc_informacoes_a = replace(Cep_obj.Endereco & "#" & Cep_obj.Bairro & "#" & Cep_obj.Cidade & "#" & Cep_obj.Estado,"'","\'")
		End If
		Cidade = Cep_obj.Cidade
		UF = Cep_obj.Estado

		SET Cep_obj = Nothing
	End If	

	' Calculo de frete para o Brasil
	If VarPAIS = "BR" Then
		Call Frete_Gratis(VarCEP,var_valor)
		' Sedex Convencional
		If Application("DisponivelSedex") = "sim" Then
			Call Frete_Correios(VarCEP,FctPeso)
		End If
		If Application("DisponivelESedex") = "sim" Then
			Call Frete_CorreiosEsedex(VarCEP,FctPeso)
		End If
		' PAC
		If Application("DisponivelPAC") = "sim" Then
			Call Frete_CorreiosPAC(VarCEP,FctPeso)
		End If
		' Direct Express
		IF pegaValorAtrib(Application("XMLArquivoConfiguracao"),"dados/configuracao_dados","DisponivelDirectExpress") = "sim" THEN
			Call Frete_DirecExpress(VarCEP,FctPeso)
		End if		  
		' Retirar na Loja
		IF Application("DisponivelRetirarNaLoja") = "sim" THEN
			Call Frete_RetirarLoja()
		End If
		' Transportadora
		IF Application("DisponivelTransportadora") = "sim" THEN
			Call Frete_Transportadora()
		End if 
		' FretePersonalizado
		IF Application("DisponivelFretePersonalizado") = "sim" THEN
			Call Frete_Personalizado(Cidade,UF,FctPeso)
		End if 
	' Calculo de frete para o exterior
	Else
		If Application("disponivelfedex") = "sim" Then
			' FEDEX
			Call Frete_FEDEX(VarPAIS,VarCEP,FctPeso)
		End If
	End If

	'Retira o último # do array de opções de frete
	If right(informacoes,1) = "#" Then
		informacoes = mid(informacoes,1,len(informacoes)-1)
	End If

%>
<script type="text/javascript">
	window.parent.handleResponse('<%=Replace(informacoes, "'", "\'")%>');
</script>
<%
End function

' Atualiza o frete para o CEP
Function Atualiza_CEP(VarCEP,VarPAIS,FctPeso,VarFrete)

	' Verifica se o CEP é numérico
	If IsNumeric(Replace(VarCEP,"-","")) Then

		SET Cep_obj = CreateObject("Correios.CEP")

		Cep_obj.EncontraCEP(VarCEP)
		If Cep_obj.Erro	= 0 then
			vc_informacoes_a = replace(Cep_obj.Endereco & "#" & Cep_obj.Bairro & "#" & Cep_obj.Cidade & "#" & Cep_obj.Estado,"'","\'")
		End If
		Cidade = Cep_obj.Cidade
		UF = Cep_obj.Estado

		SET Cep_obj = Nothing

	End If

	' Calculo de frete para o Brasil
	If VarPAIS = "BR" Then
		' Sedex Convencional
		Call Frete_Gratis(VarCEP,var_valor)
		If VarFrete = "SEDEX" Then
			Call Frete_Correios(VarCEP,FctPeso)
		End If
		' E-Sedex
		If VarFrete = "E-SEDEX" Then
			Call Frete_CorreiosEsedex(VarCEP,FctPeso)
		End If
		' PAC
		If VarFrete = "PAC" Then
			Call Frete_CorreiosPAC(VarCEP,FctPeso)
		End If		
		' Direct Express
		If VarFrete = "DIRECT EXPRESS" Then
			Call Frete_DirecExpress(VarCEP,FctPeso)
		End If 
		' Retirar na Loja
		IF VarFrete = "RETIRAR NA LOJA" THEN
			Call Frete_RetirarLoja()
		End If		
		' Transportadora a cobrar
		IF VarFrete = "TRANSPORTADORA A COBRAR - Valor a combinar" THEN
			Call Frete_Transportadora()
		End If		
		' Frete personalizado
		IF VarFrete = Ucase(pegaValorAtrib(Application("XMLArquivoConfiguracao"),"dados/configuracao_dados","NomeFretePersonalizado")) THEN
			Call Frete_Personalizado(Cidade,UF,FctPeso)
		End If
	' Calculo de frete para o exterior
	Else
		If VarFrete = "FEDEX" Then
			' FEDEX
			Call Frete_FEDEX(VarPAIS,VarCEP,FctPeso)
		End If
	End If

	'Retira o último # do array de opções de frete
	If right(informacoes,1) = "#" Then
		informacoes = mid(informacoes,1,len(informacoes)-1)
	End If

	varNovoFrete = split(Replace(informacoes, "'", "\'"),":")
	If varNovoFrete(2) = "ok" Then
		If Instr(varNovoFrete(1),"|") <> 0 Then
			varArrayNovoFrete = Split(varNovoFrete(1),"|")
			varNovoFreteReal = varArrayNovoFrete(0)
		Else
			varNovoFreteReal = varNovoFrete(1)
		End If
		Atualiza_CEP = varNovoFreteReal
	Else
		Session("ultima_opcao_frete") = Session("opcao_frete")
		Session("valor_frete") = empty
		Session("opcao_frete") = empty

		Session("msgErroFrete") = varNovoFrete(2)
	End If

End function

'############### INICIO - OPÇÕES DE FRETE ###############

'############### SEDEX CONVENCIONAL ###############
Function Frete_Correios(FctCEP,FctPeso)

	cepOrigem   = Application("ceploja")
	cepDestino  = Trim(FctCEP)
	pesoFrete   = CDBL(FctPeso)
	volumeFrete = "0"
	codigoFrete = Application("SedexCodigo")

	entrada = "<?xml version=""1.0"" encoding=""utf-8""?>"
	entrada = entrada & "<soap12:Envelope xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" xmlns:xsd=""http://www.w3.org/2001/XMLSchema"" xmlns:soap12=""http://www.w3.org/2003/05/soap-envelope"">"
	entrada = entrada & "<soap12:Body>"
	entrada = entrada & "   <Correios xmlns=""http://tempuri.org/"">"
	entrada = entrada & "	  <cepOrigem>" & cepOrigem & "</cepOrigem>"
	entrada = entrada & "	  <cepDestino>" & cepDestino & "</cepDestino>"
	entrada = entrada & "	  <peso>" & pesoFrete & "</peso>"
	entrada = entrada & "	  <volume>" & volumeFrete & "</volume>"
	entrada = entrada & "	  <codigo>" & codigoFrete & "</codigo>"
	entrada = entrada & "	</Correios>"
	entrada = entrada & "  </soap12:Body>"
	entrada = entrada & " </soap12:Envelope>"

	set objXmlDom = CreateObject("Microsoft.XMLDOM")
	set objXmlHttp = CreateObject("Microsoft.XMLHTTP")
	 
	' Efetua a conexão ao Web Service
	objXmlHttp.open "POST", Application("URLWebServiceCorreiosLocaweb"), false
	objXmlHttp.setRequestHeader "Man", POST & " " & Application("URLWebServiceCorreiosLocaweb") & " HTTP/1.1"
	objXmlHttp.setRequestHeader "MessageType", "CALL"
	objXmlHttp.setRequestHeader "Content-Type", "application/soap+xml; charset=utf-8"
	objXmlHttp.send(entrada)

	' Resgata o valor calculado
	retorno = objXmlHttp.responsetext
	 
	' Verifica se o processo da consulta foi feito com sucesso
	If objXmlHttp.Status = 200 Then

		' Trata o retorno do processo
		objXmlDom.async = False
		objXmlDom.LoadXML(retorno)
		retornoFrete = objXmlDom.selectSingleNode("soap:Envelope/soap:Body/CorreiosResponse/CorreiosResult").text

		If IsNumeric(retornoFrete) Then
			' Exibe os dados de retorno
			If Trim(retornoFrete) = "0" Then
				Frete_sedex_erro = Application("CepFrtTxtModNaoAtende")
				Frete_sedex = "vazio"
			Else
				Frete_sedex_erro = "ok"
				Frete_sedex = retornoFrete 
				Frete_sedex = FormatNumber(Frete_sedex)
				Frete_sedexVis = FormatNumber(Frete_sedex)*FatorCambio(Session("Valor_Cambio"))
				Frete_sedex = FormatNumber(Frete_sedex)&"|"&FormatNumber(Frete_sedexVis)
			End If
		Else
			' Mensagem de erro
			Frete_sedex_erro = retornoFrete
			Frete_sedex = "vazio"
		End If

	Else

		' Mensagem de erro
		Frete_sedex_erro = Application("CepFrtTxtErroProcessamento")
		Frete_sedex = "vazio"

	End If
	 
	set objXmlHttp = nothing
	set objXmlDom = Nothing

	'Monta string de valores para post
	informacoes = informacoes & OpcaoFrete("SEDEX",Frete_sedex,Frete_sedex_erro)

End Function

'############### ESEDEX ###############
Function Frete_CorreiosEsedex(FctCEP,FctPeso)

	cepOrigem   = Application("ceploja")
	cepDestino  = Trim(FctCEP)
	pesoFrete   = CDBL(FctPeso)
	volumeFrete = "0"
	codigoFrete = Application("ESedexCodigo")

	entrada = "<?xml version=""1.0"" encoding=""utf-8""?>"
	entrada = entrada & "<soap12:Envelope xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" xmlns:xsd=""http://www.w3.org/2001/XMLSchema"" xmlns:soap12=""http://www.w3.org/2003/05/soap-envelope"">"
	entrada = entrada & "<soap12:Body>"
	entrada = entrada & "   <Correios xmlns=""http://tempuri.org/"">"
	entrada = entrada & "	  <cepOrigem>" & cepOrigem & "</cepOrigem>"
	entrada = entrada & "	  <cepDestino>" & cepDestino & "</cepDestino>"
	entrada = entrada & "	  <peso>" & pesoFrete & "</peso>"
	entrada = entrada & "	  <volume>" & volumeFrete & "</volume>"
	entrada = entrada & "	  <codigo>" & codigoFrete & "</codigo>"
	entrada = entrada & "	</Correios>"
	entrada = entrada & "  </soap12:Body>"
	entrada = entrada & " </soap12:Envelope>"

	set objXmlDom = CreateObject("Microsoft.XMLDOM")
	set objXmlHttp = CreateObject("Microsoft.XMLHTTP")
	 
	' Efetua a conexão ao Web Service
	objXmlHttp.open "POST", Application("URLWebServiceCorreiosLocaweb"), false
	objXmlHttp.setRequestHeader "Man", POST & " " & Application("URLWebServiceCorreiosLocaweb") & " HTTP/1.1"
	objXmlHttp.setRequestHeader "MessageType", "CALL"
	objXmlHttp.setRequestHeader "Content-Type", "application/soap+xml; charset=utf-8"
	objXmlHttp.send(entrada)

	' Resgata o valor calculado
	retorno = objXmlHttp.responsetext
	 
	' Verifica se o processo da consulta foi feito com sucesso
	If objXmlHttp.Status = 200 Then

		' Trata o retorno do processo
		objXmlDom.async = False
		objXmlDom.LoadXML(retorno)
		retornoFrete = objXmlDom.selectSingleNode("soap:Envelope/soap:Body/CorreiosResponse/CorreiosResult").text

		If IsNumeric(retornoFrete) Then
			' Exibe os dados de retorno
			If Trim(retornoFrete) = "0" Then
				Frete_Esedex_erro = Application("CepFrtTxtModNaoAtende")
				Frete_Esedex = "vazio"
			Else
				Frete_Esedex_erro = "ok"
				Frete_Esedex = retornoFrete 
				Frete_Esedex = FormatNumber(Frete_Esedex)
				Frete_EsedexVis = FormatNumber(Frete_Esedex)*FatorCambio(Session("Valor_Cambio"))
				Frete_Esedex = FormatNumber(Frete_Esedex)&"|"&FormatNumber(Frete_EsedexVis)
			End If
		Else
			' Mensagem de erro
			Frete_Esedex_erro = retornoFrete
			Frete_Esedex = "vazio"
		End If

	Else

		' Mensagem de erro
		Frete_Esedex_erro = Application("CepFrtTxtErroProcessamento")
		Frete_sedex = "vazio"

	End If
	 
	set objXmlHttp = nothing
	set objXmlDom = Nothing

	informacoes = informacoes & OpcaoFrete("E-SEDEX",Frete_Esedex,Frete_Esedex_erro)

End Function

'############### PAC ###############
Function Frete_CorreiosPAC(FctCEP,FctPeso)

	cepOrigem   = Application("ceploja")
	cepDestino  = Trim(FctCEP)
	pesoFrete   = CDBL(FctPeso)
	volumeFrete = "0"
	codigoFrete = Application("PACCodigo")

	entrada = "<?xml version=""1.0"" encoding=""utf-8""?>"
	entrada = entrada & "<soap12:Envelope xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" xmlns:xsd=""http://www.w3.org/2001/XMLSchema"" xmlns:soap12=""http://www.w3.org/2003/05/soap-envelope"">"
	entrada = entrada & "<soap12:Body>"
	entrada = entrada & "   <Correios xmlns=""http://tempuri.org/"">"
	entrada = entrada & "	  <cepOrigem>" & cepOrigem & "</cepOrigem>"
	entrada = entrada & "	  <cepDestino>" & cepDestino & "</cepDestino>"
	entrada = entrada & "	  <peso>" & pesoFrete & "</peso>"
	entrada = entrada & "	  <volume>" & volumeFrete & "</volume>"
	entrada = entrada & "	  <codigo>" & codigoFrete & "</codigo>"
	entrada = entrada & "	</Correios>"
	entrada = entrada & "  </soap12:Body>"
	entrada = entrada & " </soap12:Envelope>"

	set objXmlDom = CreateObject("Microsoft.XMLDOM")
	set objXmlHttp = CreateObject("Microsoft.XMLHTTP")
	 
	' Efetua a conexão ao Web Service
	objXmlHttp.open "POST", Application("URLWebServiceCorreiosLocaweb"), false
	objXmlHttp.setRequestHeader "Man", POST & " " & Application("URLWebServiceCorreiosLocaweb") & " HTTP/1.1"
	objXmlHttp.setRequestHeader "MessageType", "CALL"
	objXmlHttp.setRequestHeader "Content-Type", "application/soap+xml; charset=utf-8"
	objXmlHttp.send(entrada)

	' Resgata o valor calculado
	retorno = objXmlHttp.responsetext
	 
	' Verifica se o processo da consulta foi feito com sucesso
	If objXmlHttp.Status = 200 Then

		' Trata o retorno do processo
		objXmlDom.async = False
		objXmlDom.LoadXML(retorno)
		retornoFrete = objXmlDom.selectSingleNode("soap:Envelope/soap:Body/CorreiosResponse/CorreiosResult").text

		If IsNumeric(retornoFrete) Then
			' Exibe os dados de retorno
			If Trim(retornoFrete) = "0" Then
				Frete_PAC_erro = Application("CepFrtTxtModNaoAtende")
				Frete_PAC = "vazio"
			Else
				Frete_PAC_erro = "ok"
				Frete_PAC = retornoFrete 
				Frete_PAC = FormatNumber(Frete_PAC)
				Frete_PACVis = FormatNumber(Frete_PAC)*FatorCambio(Session("Valor_Cambio"))
				Frete_PAC = FormatNumber(Frete_PAC)&"|"&FormatNumber(Frete_PACVis)
			End If
		Else
			' Mensagem de erro
			Frete_PAC_erro = retornoFrete
			Frete_PAC = "vazio"
		End If

	Else

		' Mensagem de erro
		Frete_PAC_erro = Application("CepFrtTxtErroProcessamento")
		Frete_PAC = "vazio"

	End If
	 
	set objXmlHttp = nothing
	set objXmlDom = Nothing

	informacoes = informacoes & OpcaoFrete("PAC",Frete_PAC,Frete_PAC_erro)

End Function

'############### DIRECT EXPRESS ####################

Function Frete_DirecExpress(FctCEP,FctPeso)

	'Contacta o servidor da Direct Express para obter o valor do frete
	Set HttpObjSend = CreateObject("MSXML2.ServerXMLHTTP")
	strDirect = strDirect & "cdrem=" & pegaValorAtrib(Application("XMLArquivoConfiguracao"),"dados/configuracao_dados","ContaDirectExpress")
	strDirect = strDirect & "&peso=" & FctPeso
	strDirect = strDirect & "&cep=" & FctCEP
	strDirect = strDirect & "&vltot=0"
	HttpObjSend.open "Post", Application("URLDirectExpresCalculo"), False
	HttpObjSend.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
	HttpObjSend.send strDirect
	If HttpObjSend.Status = 200 Then

		RetornoDirectExpress = HttpObjSend.responseText

		If IsNumeric(RetornoDirectExpress) Then
			RetornoDirectExpress = Replace(RetornoDirectExpress,".",",")
			Frete_DirecExpress_erro = "ok"
			Frete_DirecExpressVlr = RetornoDirectExpress 
			Frete_DirecExpressVlrVis= (Frete_DirecExpressVlr)*FatorCambio(Session("Valor_Cambio"))
			Frete_DirecExpressVlr = (Frete_DirecExpressVlr)&"|"&FormatNumber(Frete_DirecExpressVlrVis)
		Else
		Frete_DirecExpress_erro = "CEP Destino inválido para o serviço"
		Frete_DirecExpressVlr = "vazio"
		End If
		'Monta string de valores para post
		 informacoes = informacoes & OpcaoFrete("DIRECT EXPRESS",Frete_DirecExpressVlr,Frete_DirecExpress_erro)
	Set HttpObjSend = Nothing
	Else
		Response.write "Error: (" & HttpObjSend.Status & ") " & HttpObjSend.statusText
	End If

End Function

'############### FEDEX INTERNACIONAL ###############
Function Frete_FEDEX(FctPAIS,FctZIP,FctPESO)

	If Application("FedExGateway")="TESTE" Then
		hostFEDEX = Application("URLTESTEFEDEX")
	Else
		hostFEDEX = Application("URLPRODFEDEX")
	End If
	urlFEDEX = "https://" & hostFEDEX & "/GatewayDC"

	If Month(Date) < 10 Then 
		varMES = "0" & Month(Date)
	Else
		varMES = Month(Date)
	End If

	If Day(Date) < 10 Then
		varDIA = "0" & Day(Date)
	Else
		varDIA = Day(Date)
	End If

	ShipDate = year(date) & "-" & varMES & "-" & varDIA

	TS = "<?xml version=""1.0"" encoding=""UTF-8"" ?>"
	TS = TS & "<FDXRateRequest xmlns:api=""http://www.fedex.com/fsmapi"" xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" "
	TS = TS & "xsi:noNamespaceSchemaLocation=""FDXRateRequest.xsd"">"
	TS = TS & "<RequestHeader>"
	TS = TS & "<AccountNumber>" & Application("FedExConta") & "</AccountNumber>"
	TS = TS & "<MeterNumber>" & Application("FedExMeter") & "</MeterNumber>"
	TS = TS & "<CarrierCode>FDXE</CarrierCode>"
	TS = TS & "</RequestHeader>"
	TS = TS & "<ShipDate>" & ShipDate & "</ShipDate>"
	TS = TS & "<DropoffType>REGULARPICKUP</DropoffType>"
	TS = TS & "<Service>" & Application("FedExService") & "</Service>"
	TS = TS & "<Packaging>" & Application("FedExPackaging") & "</Packaging>"
	TS = TS & "<WeightUnits>KGS</WeightUnits>"
	TS = TS & "<Weight>" & Replace(FctPESO,",",".") & "</Weight>"
	TS = TS & "<OriginAddress>"
	TS = TS & "<PostalCode>" & Replace(Application("ceploja"),"-","") & "</PostalCode>"
	TS = TS & "<CountryCode>" & Application("paisloja") & "</CountryCode>"
	TS = TS & "</OriginAddress>"
	TS = TS & "<DestinationAddress>"
	TS = TS & "<PostalCode>" & FctZIP & "</PostalCode>"
	TS = TS & "<CountryCode>" & FctPAIS & "</CountryCode>"
	TS = TS & "</DestinationAddress>"
	TS = TS & "<Payment>"
	TS = TS & "<PayorType>SENDER</PayorType>"
	TS = TS & "</Payment>"
	TS = TS & "<PackageCount>" & Session("total") & "</PackageCount>"
	TS = TS & "</FDXRateRequest>"

	Set xmlhttp = CreateObject("WinHttp.WinHttpRequest.5.1")
	
	xmlhttp.Open "POST",urlFEDEX,"false"
	xmlhttp.setRequestHeader "Referer","FedEx"
	xmlhttp.setRequestHeader "Host", hostFEDEX
	xmlhttp.setRequestHeader "Accept","image/gif, image/jpeg, image/pjpeg,text/plain, text/html, */*"
	xmlhttp.setRequestHeader "Content-Type","image/gif"
	xmlhttp.setRequestHeader "Content-Length", cStr(len(TS))
	xmlhttp.send (TS)

	SendFedExTransaction = xmlhttp.responseText

	Set xmlhttp = Nothing	
	
	VAR_erro = GetXMLNode(SendFedExTransaction,"FDXRateReply/Error/Message")
	VAR_codigo_erro = GetXMLNode(SendFedExTransaction,"FDXRateReply/Error/Code")

	If VAR_codigo_erro <> "" And VAR_erro <> "" Then
		Frete_fedex = "vazio"
		Frete_fedex_erro = VAR_codigo_erro & " - " & VAR_erro
	Else
		Frete_fedex_erro = "ok"
		Frete_fedex = GetXMLNode(SendFedExTransaction,"FDXRateReply/EstimatedCharges/DiscountedCharges/NetCharge")
		Frete_fedex = FormatNumber(Replace(Frete_fedex,".",","))
		Frete_fedexVis = (Frete_fedex)*FatorCambio(Session("Valor_Cambio"))
		Frete_fedex = FormatNumber(Frete_fedex)&"|"&FormatNumber(Frete_fedexVis)
	End If

	informacoes = informacoes & OpcaoFrete("FEDEX",Frete_fedex,Frete_fedex_erro)

End Function

'############### FRETE RETIRAR NA LOJA ###############
Function Frete_RetirarLoja()
	VarFrete_retirarloja = "0"
	VarFrete_retirarloja_erro = "ok"

	informacoes = informacoes & OpcaoFrete("RETIRAR NA LOJA",FormatNumber(VarFrete_retirarloja),VarFrete_retirarloja_erro)

End Function

'############### FRETE TRANSPORTADORA A COBRAR ###############
Function Frete_Transportadora()
	VarFrete_transportadora = "0"
	VarFrete_transportadora_erro = "ok"

	informacoes = informacoes & OpcaoFrete("TRANSPORTADORA A COBRAR - Valor a combinar",FormatNumber(VarFrete_transportadora),VarFrete_transportadora_erro)

End Function


'############### FRETE GRATIS ###############
Function Frete_Gratis(FctCEP,var_valor)


Dim cidade

 cep = FctCEP
 valor_gratis = "0"
 VarFrete_gratis_erro = "ok"
 
 if var_valor >= "100" then
 
  If cep >= 06300000 And cep <= 06399999 Then
	informacoes = informacoes & OpcaoFrete("Frete Gratis",FormatNumber(valor_gratis),VarFrete_gratis_erro)
  ElseIf cep >= 06000000 And cep <= 06299999 Then
	informacoes = informacoes & OpcaoFrete("Frete Gratis",FormatNumber(valor_gratis),VarFrete_gratis_erro)
  ElseIf cep >= 06400000 And cep <= 06499999 Then
	informacoes = informacoes & OpcaoFrete("Frete Gratis",FormatNumber(valor_gratis),VarFrete_gratis_erro)
  ElseIf cep >= 18130000 And cep <= 18139999 Then
	informacoes = informacoes & OpcaoFrete("Frete Gratis",FormatNumber(valor_gratis),VarFrete_gratis_erro)
  ElseIf cep >= 06500000 And cep <= 06549999 Then
	informacoes = informacoes & OpcaoFrete("Frete Gratis",FormatNumber(valor_gratis),VarFrete_gratis_erro)
  ElseIf cep >= 06600000 And cep <= 06649999 Then
	informacoes = informacoes & OpcaoFrete("Frete Gratis",FormatNumber(valor_gratis),VarFrete_gratis_erro)
  ElseIf cep >= 06650000 And cep <= 06699999 Then
	informacoes = informacoes & OpcaoFrete("Frete Gratis",FormatNumber(valor_gratis),VarFrete_gratis_erro)
  ElseIf cep >= 06750000 And cep <= 06799999 Then
	informacoes = informacoes & OpcaoFrete("Frete Gratis",FormatNumber(valor_gratis),VarFrete_gratis_erro)
  ElseIf cep >= 01000000 And cep <= 05999999 Then
	informacoes = informacoes & OpcaoFrete("Frete Gratis",FormatNumber(valor_gratis),VarFrete_gratis_erro)
  ElseIf cep >= 08000000 And cep <= 08499999 Then
	informacoes = informacoes & OpcaoFrete("Frete Gratis",FormatNumber(valor_gratis),VarFrete_gratis_erro)
  End If

end if

End Function


'############### FRETE PERSONALIZADO ###############
Function Frete_Personalizado(Cidade,UF,FctPeso)
	Pesofixo = "P"&fix(FctPeso) 

	indicador = Pega_DadoBanco("Tabela_frete_personalizado","indicador","Localidade","'"& Replace(Cidade,"'","") &"'")

	'Se não houver resultado para indicador a cidade não existe na tabela.
	'Esta condição indica que a cidade não é capital e assume o valor de D (Outras)
	If indicador = "" Then
		Indicador = "D"
	End if

	If Replace(Pesofixo,"P","") > 30 Then
		Frete_Person = "vazio"	
		Frete_Person_erro = Application("CepFrtTxtLimitePeso")
	Else
		Set RS_Frete_PersonInt = Server.CreateObject("ADODB.Recordset")
		Query1 = "SELECT "&Pesofixo&" FROM Tabela_frete_personalizado WHERE uf ='"& uf & "' AND indicador = '"&indicador&"' "
		RS_Frete_PersonInt.Open Query1, Conexao
		
		If Not RS_Frete_PersonInt.Eof Then
			Frete_Person = RS_Frete_PersonInt(Pesofixo)
			Frete_Person = FormatNumber(Frete_Person)
			Frete_PersonVis = FormatNumber(Frete_Person)*FatorCambio(Session("Valor_Cambio"))
			Frete_Person = FormatNumber(Frete_Person)&"|"&FormatNumber(Frete_PersonVis)
			Frete_Person_erro = "ok"
		Else
			Frete_Person = "vazio"	
			Frete_Person_erro = Application("CepFrtTxtModNaoAtende")
		End if
		
		Set RS_Frete_PersonInt = Nothing
	End If

	informacoes = informacoes & OpcaoFrete(UCase(pegaValorAtrib(Application("XMLArquivoConfiguracao"),"dados/configuracao_dados","NomeFretePersonalizado")),Frete_Person,Frete_Person_erro)

End Function

'############### FIM - OPÇÕES DE FRETE ###############


'Funcao para montar as opções de frete
Function OpcaoFrete(tipo,valor,erro)
		OpcaoFrete = tipo & ":" & valor & ":" & erro & "#"
End Function

'Resgata um NODE específico do XML
Function GetXMLNode(stringXML,nodeName)
	Set objXmlDOM = CreateObject("Microsoft.XMLDOM")
	objXmlDOM.async = False 
	objXmlDOM.loadXML(stringXML)
	set Nodes = objXmlDOM.selectNodes(nodeName)
	For each Node in Nodes
		If Not VarType(Node) = 9 Then
			GetXMLNode = ""
		Else
			GetXMLNode = Node.Text
		End If
	Next
	Set objXmlDOM = Nothing
	Set Node = Nothing
End Function

'#FIM DO COMPONENTE
%>

Claudio Neto · Maio 6, 2009

Olá Fernando.

Dá uma procurada no arquivo lista_pedidos.asp. Procura esse trecho aqui:

varTotalParcial = FormatNumber(CDbl(raiz_dados_pedido.getAttribute("valor_subtotal")) + CDbl(raiz_dados_pedido.getAttribute("valor_frete")))
varTotalPedido = raiz_dados_pedido.getAttribute("valor_total")

Tente substituir por:

if FormatNumber(raiz_dados_pedido.getAttribute("valor_total")*FatorCambio(varValor_Cambio)) > 100 then
	varTotalParcial = FormatNumber(CDbl(raiz_dados_pedido.getAttribute("valor_subtotal")))
	varTotalPedido = raiz_dados_pedido.getAttribute("valor_total")
else
	varTotalParcial = FormatNumber(CDbl(raiz_dados_pedido.getAttribute("valor_subtotal")) + CDbl(raiz_dados_pedido.getAttribute("valor_frete")))
	varTotalPedido = raiz_dados_pedido.getAttribute("valor_total")
end if

Veja se resolve seu problema.

Abraços.

Entrar

Arquivado

frete gratis sistemas locaweb...

Recommended Posts

Fernando Web 0

Compartilhar este post

Link para o post

Compartilhar em outros sites

Claudio Neto 3

Compartilhar este post

Link para o post

Compartilhar em outros sites

Fixar div até atingir uma certa altura

Ajuda com Extends e envio para o banco

PHP+Codeginiter - Orientação para Impressão

Este projeto é apoiado pelas empresas

Fóruns

Tempo Real

Informação importante