<% '-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-# ' Loja Exemplo Locaweb ' Versão: 6.4 ' Data: 12/09/06 ' Arquivo: cep_frete.asp ' Versão do arquivo: 0.0 ' Data da ultima atualização: 12/05/08 ' '----------------------------------------------------------------------------- ' Licença Código Livre: http://comercio.Locaweb.com.br/gpl/gpl.txt '-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-# %> <% 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 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 ' 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 %> <% 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 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" 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 = "" entrada = entrada & "" entrada = entrada & "" entrada = entrada & " " entrada = entrada & " " & cepOrigem & "" entrada = entrada & " " & cepDestino & "" entrada = entrada & " " & pesoFrete & "" entrada = entrada & " " & volumeFrete & "" entrada = entrada & " " & codigoFrete & "" entrada = entrada & " " entrada = entrada & " " entrada = entrada & " " 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 = "" entrada = entrada & "" entrada = entrada & "" entrada = entrada & " " entrada = entrada & " " & cepOrigem & "" entrada = entrada & " " & cepDestino & "" entrada = entrada & " " & pesoFrete & "" entrada = entrada & " " & volumeFrete & "" entrada = entrada & " " & codigoFrete & "" entrada = entrada & " " entrada = entrada & " " entrada = entrada & " " 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 = "" entrada = entrada & "" entrada = entrada & "" entrada = entrada & " " entrada = entrada & " " & cepOrigem & "" entrada = entrada & " " & cepDestino & "" entrada = entrada & " " & pesoFrete & "" entrada = entrada & " " & volumeFrete & "" entrada = entrada & " " & codigoFrete & "" entrada = entrada & " " entrada = entrada & " " entrada = entrada & " " 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 = "" TS = TS & "" TS = TS & "" TS = TS & "" & Application("FedExConta") & "" TS = TS & "" & Application("FedExMeter") & "" TS = TS & "FDXE" TS = TS & "" TS = TS & "" & ShipDate & "" TS = TS & "REGULARPICKUP" TS = TS & "" & Application("FedExService") & "" TS = TS & "" & Application("FedExPackaging") & "" TS = TS & "KGS" TS = TS & "" & Replace(FctPESO,",",".") & "" TS = TS & "" TS = TS & "" & Replace(Application("ceploja"),"-","") & "" TS = TS & "" & Application("paisloja") & "" TS = TS & "" TS = TS & "" TS = TS & "" & FctZIP & "" TS = TS & "" & FctPAIS & "" TS = TS & "" TS = TS & "" TS = TS & "SENDER" TS = TS & "" TS = TS & "" & Session("total") & "" TS = TS & "" 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",FormatNumber(VarFrete_transportadora),VarFrete_transportadora_erro) 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 %>