<% '-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-# ' Loja Exemplo Locaweb ' Versão: 6.3 ' Data: 12/09/06 ' Arquivo: cep_frete.asp ' Versão do arquivo: 0.0 ' Data da ultima atualização: 06/08/07 ' '----------------------------------------------------------------------------- ' 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("volumecubfrete") <> "" then FctVolumeCub = request("volumecubfrete") 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 'Gera o Pacode do Soap para Frete PAC function GerarPacoteSoap(nCdEmpresa, sDsSenha, sCepOrigem, sCepDestino, nVlPeso,nVlVolume) Dim sSoap sSoap = "" sSoap = sSoap & "" sSoap = sSoap & "" sSoap = sSoap & "" sSoap = sSoap & "" & nCdEmpresa & "" sSoap = sSoap & "" & sDsSenha & "" sSoap = sSoap & "" & sCepOrigem & "" sSoap = sSoap & "" & sCepDestino & "" sSoap = sSoap & "" & nVlPeso & "" sSoap = sSoap & "" & nVlVolume & "" sSoap = sSoap & "" sSoap = sSoap & "" sSoap = sSoap & "" GerarPacoteSoap = sSoap end function ' 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) session("PrazoEntrega") = Application("PrazoEntregaSedex") End If If Application("DisponivelESedex") = "sim" Then Call Frete_CorreiosEsedex(VarCEP,FctPeso) session("PrazoEntrega") = Application("PrazoEntregaESedex") End If ' Sedex 10 If Application("DisponivelSedex10") = "sim" Then Call Frete_Correiossedex10(VarCEP,FctPeso) session("PrazoEntrega") = Application("PrazoEntregaSedex10") End If ' Direct Express IF pegaValorAtrib(Application("XMLArquivoConfiguracao"),"dados/configuracao_dados","DisponivelDirectExpress") = "sim" THEN Call Frete_DirecExpress(VarCEP,FctPeso) session("PrazoEntrega") = Application("PrazoEntregaDirectExpress") End if ' Retirar na Loja IF Application("DisponivelRetirarNaLoja") = "sim" THEN Call Frete_RetirarLoja() session("PrazoEntrega") = Application("PrazoEntregaRetirarNaLoja") End If ' Transportadora IF Application("DisponivelTransportadora") = "sim" THEN Call Frete_Transportadora() session("PrazoEntrega") = Application("PrazoEntregaTransportadora") End if ' FretePersonalizado IF Application("DisponivelFretePersonalizado") = "sim" THEN Call Frete_Personalizado(Cidade,UF,FctPeso) session("PrazoEntrega") = Application("PrazoEntregaFretePersonalizado") End if 'Adic - GPJR 29-09-2008 If Application("DisponivelFretePAC") = "sim" Then Call Frete_PAC(Cidade, UF, VarCEP, FctPeso) 'Response.Write " Primeiro " session("PrazoEntrega") = Application("PrazoEntregaFretePAC") End if 'FIM ' Calculo de frete para o exterior Else If Application("disponivelfedex") = "sim" Then ' FEDEX Call Frete_FEDEX(VarPAIS, VarCEP, FctPeso) session("PrazoEntrega") = Application("PrazoEntregaFedex") 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,FctVolumeCub,FctPeso,VarFrete) 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 ' 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 ' Sedex 10 If VarFrete = "SEDEX-10" Then Call Frete_CorreiosSedex10(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 'Adic - GPJR 29-09-2008 ' Frete PAC IF VarFrete = "PAC" Then Call Frete_PAC(Cidade, UF, VarCEP, FctPeso) End if 'FIM ' Calculo de frete para o exterior Else If VarFrete = "FEDEX" Then ' FEDEX Call Frete_FEDEX(VarPAIS,VarCEP,FctPeso) End If End If if Len(Trim(informacoes)) = 0 Then Atualiza_CEP = 0 Exit Function 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) varSubTotal = pegaValorAtrib(Application("DiretorioPedidos")&session("id_transacao")&".xml","dados_pedido","valor_subtotal") cod_sedex = "40010" Set Sedex_obj = CreateObject("Correios.Sedex") If Application("SedexComSeguro") = "sim" Then Frete_temp = Sedex_obj.Tarifacao(CStr(cod_sedex), CStr(Application("ceploja")), CStr(FctCEP), CDBL(FctPeso), CDBL(varSubTotal)) Else Frete_temp = Sedex_obj.Tarifacao(CStr(cod_sedex), CStr(Application("ceploja")), CStr(FctCEP), CDBL(FctPeso), "0") End if If Sedex_obj.Erro <> 0 Then Frete_sedex_erro = Sedex_obj.DescricaoErro Frete_sedex = "vazio" Else Frete_sedex_erro = "ok" Frete_sedex = Frete_temp Frete_sedex = FormatNumber(Frete_sedex) Frete_sedexVis = FormatNumber(Frete_sedex)*FatorCambio(Session("Valor_Cambio")) Frete_sedex = FormatNumber(Frete_sedex)&"|"&FormatNumber(Frete_sedexVis) End If Set Sedex_obj = Nothing informacoes = informacoes & OpcaoFrete("SEDEX",Frete_sedex,Frete_sedex_erro) End function '############### ESEDEX ############### Function Frete_CorreiosEsedex(FctCEP,FctPeso) varSubTotal = pegaValorAtrib(Application("DiretorioPedidos")&session("id_transacao")&".xml","dados_pedido","valor_subtotal") cod_Esedex = "81019" Set Esedex_obj = CreateObject("Correios.eSedex") If Application("ESedexComSeguro") = "sim" Then Frete_temp = Esedex_obj.Tarifacao(CStr(cod_Esedex), CStr(Application("ceploja")), CStr(FctCEP), CDBL(FctPeso), CDBL(varSubTotal)) Else Frete_temp = Esedex_obj.Tarifacao(CStr(cod_Esedex), CStr(Application("ceploja")), CStr(FctCEP), CDBL(FctPeso), "0") End if If Esedex_obj.Erro <> 0 Then Frete_Esedex_erro = Esedex_obj.DescricaoErro Frete_Esedex = "vazio" Else Frete_Esedex_erro = "ok" Frete_Esedex = Frete_temp Frete_Esedex = FormatNumber(Frete_Esedex) Frete_EsedexVis = FormatNumber(Frete_Esedex)*FatorCambio(Session("Valor_Cambio")) Frete_Esedex = FormatNumber(Frete_Esedex)&"|"&FormatNumber(Frete_EsedexVis) End If Set Esedex_obj = Nothing informacoes = informacoes & OpcaoFrete("E-SEDEX",Frete_Esedex,Frete_Esedex_erro) End Function '############### SEDEX 10 ############### Function Frete_CorreiosSedex10(FctCEP,FctPeso) varSubTotal = pegaValorAtrib(Application("DiretorioPedidos")&session("id_transacao")&".xml","dados_pedido","valor_subtotal") cod_Sedex10 = "40215" Set Sedex10_obj = CreateObject("Correios.Sedex") If Application("Sedex10ComSeguro") = "sim" Then Frete_temp = Sedex10_obj.Tarifacao(CStr(cod_Sedex10), CStr(Application("ceploja")), CStr(FctCEP), CDBL(FctPeso), CDBL(varSubTotal)) Else Frete_temp = Sedex10_obj.Tarifacao(CStr(cod_Sedex10), CStr(Application("ceploja")), CStr(FctCEP), CDBL(FctPeso), "0") End if If Sedex10_obj.Erro <> 0 Then Frete_Sedex10_erro = Sedex10_obj.DescricaoErro Frete_Sedex10 = "vazio" Else Frete_Sedex10_erro = "ok" Frete_Sedex10 = Frete_temp Frete_Sedex10 = FormatNumber(Frete_Sedex10) Frete_Sedex10Vis= FormatNumber(Frete_Sedex10)*FatorCambio(Session("Valor_Cambio")) Frete_Sedex10 = FormatNumber(Frete_Sedex10)&"|"&FormatNumber(Frete_Sedex10Vis) End If Set Sedex10_obj = Nothing informacoes = informacoes & OpcaoFrete("SEDEX-10",Frete_Sedex10,Frete_Sedex10_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 'Adic - GPJR 29-09-2008 '############### FRETE PAC ############### Function Frete_PAC(Cidade, UF, FctCEP, FctPeso) dim auxValor dim oXmlHttp, oXmlDom dim sReturn, sPacoteSoap dim nCodigoRet, sDescricaoRet 'set oXmlHttp = server.CreateObject("Microsoft.XMLHTTP") set oXmlHttp = Server.CreateObject("MSXML2.ServerXMLHTTP") const sSoapServer = "https://shopping.correios.com.br/wbm/shopping/script/ConsultarFrete.asmx" 'Favor informar nCdEmpresa, sDsSenha, sCepOrigem, sCepDestino, nVlPeso,nVlVolume) nCdEmpresa = "82425" sDsSenha = "real2008" sCepOrigem = CStr(Application("ceploja")) sCepDestino = FctCEP nVlPeso = "0" if Cdbl(FctPeso > 0) Then nVlPeso = CStr(FctPeso * 1000) ELse Frete_PAC = False Exit Function End If Call abre_xmlpedido(session("id_transacao"), objPAC, objRoot) Set stts = objPAC.getElementsByTagName("dados_pedido[@id_transacao="&session("id_transacao")&"]/produto") n_stts = stts.length Set RS_PAC= CreateObject("ADODB.Recordset") Set RS_PAC.ActiveConnection = Conexao RS_PAC.CursorLocation = 3 RS_PAC.CursorType = 0 RS_PAC.LockType = 1 Session("VolumeFrete") = 0 For i = 0 to n_stts - 1 Set Aux = stts.item(i) codProd = Aux.getAttribute("codigo_produto") qtdProd = Aux.getAttribute("quantidade_produto") * 10 vSplitCodPed = Split(codProd,"_") qtd_Resto = 0 cmdPAC = "SELECT MAX(quantidade_final) AS Total FROM Produto_Caixa Where codigo_produto = " & vSplitCodPed(0) RS_PAC.Open cmdPAC, Conexao qtdMax = RS_PAC("Total") if CInt(qtdMax) < CInt(qtdProd) Then qtd_Resto = CInt(qtdProd) - CInt(qtdMax) End If RS_PAC.Close session("temp") = "" Do While True qtdProd = qtdProd - qtd_Resto cmdPAC = "SELECT cx.Comprimento_Caixa AS Comprimento, cx.Largura_Caixa AS Largura, cx.Altura_Caixa AS Altura " cmdPAC = cmdPAC & "FROM Produto_Caixa pc INNER JOIN Caixas cx ON (cx.codigo_chave = pc.codigo_caixa) " cmdPAC = cmdPAC & "WHERE (pc.codigo_produto = " & vSplitCodPed(0) & ") " cmdPAC = cmdPAC & "AND (" & qtdProd & " BETWEEN pc.quantidade_inicial AND pc.quantidade_final)" RS_PAC.Open cmdPAC, Conexao VolCalc = 0 if RS_PAC.RecordCount = 0 Then Frete_PAC = False Exit Function Else if not IsNull(RS_PAC("Comprimento")) Then Comprimento = RS_PAC("Comprimento") Else Comprimento = 0 End If if not IsNull(RS_PAC("Largura")) Then Largura = RS_PAC("Largura") Else Largura = 0 End If if not IsNull(RS_PAC("Altura")) Then Altura = RS_PAC("Altura") Else Altura = 0 End If VolCalc = (Cdbl(Comprimento) * Cdbl(Largura) * Cdbl(ALtura)) if Cdbl(VolCalc) > 0 Then Session("VolumeFrete") = CStr(Cdbl(Session("VolumeFrete")) + Cdbl(VolCalc)) End If End If RS_PAC.Close if CInt(qtd_Resto) <= 0 Then Exit For Else qtdProd = qtd_Resto qtd_Resto = CInt(qtd_Resto) - CInt(qtdMax) if CInt(qtd_Resto) <= 0 Then qtd_Resto = 0 End If End If Loop Next set objPAC = nothing set stts = nothing set RS_PAC = nothing if Cdbl(Session("VolumeFrete")) > 0 Then nVlVolume = Cstr(Session("VolumeFrete")) Else Frete_PAC = False Exit Function End If sPacoteSoap = GerarPacoteSoap(nCdEmpresa,sDsSenha,sCepOrigem,sCepDestino,nVlPeso,nVlVolume) oXmlHttp.open "POST", sSoapServer, false oXmlHttp.setOption 2, 13056 oXmlHttp.setRequestHeader "SOAPAction", "http://tempuri.org/ConsultarFrete" oXmlHttp.setRequestHeader "Content-Type", "text/xml; charset=utf-8" 'Response.Write(sPacoteSoap) oXmlHttp.send(sPacoteSoap) sReturn = oXmlHttp.responseText 'Response.Write("erro: "&sReturn) 'parse xml Set oXmlDom = Server.CreateObject("Microsoft.XMLDOM") oXmlDom.async = false oXmlDom.loadXML sReturn 'setando o root para ConsultarFreteResult set oXmlDom = oXmlDom.selectSingleNode("soap:Envelope/soap:Body/ConsultarFreteResponse/ConsultarFreteResult") 'recuperando os códigos de retorno nCodigoRet = oXmlDom.selectSingleNode("Codigo").Text sDescricaoRet = oXmlDom.selectSingleNode("Descricao").Text 'Se o retorno foi OK então listar os fretes disponíveis if nCodigoRet = 1 then dim oNodes, oNode 'Seleciona os fretes no XML Set oNodes = oXmlDom.selectNodes("FretesDisponiveis/cFrete") 'Mostra todos os fretes disponíveis for each oNode in oNodes if (oNode.selectSingleNode("Codigo").Text = "41068") or (oNode.selectSingleNode("Codigo").Text = "41025") Then auxValor = CDbl(oNode.selectSingleNode("Valor").Text) auxValor = FormatNumber(auxValor) & "|" & FormatNumber(auxValor) if Application("PrazoEntregaFretePAC") = Empty Then PrazoEntrega = CInt(oNode.selectSingleNode("PrazoEntrega").Text) Else PrazoEntrega = CInt(Application("PrazoEntregaFretePAC")) End If PrazoEntrega = PrazoEntrega + 3 If PrazoEntrega > 1 Then session("PrazoEntrega") = Cstr(PrazoEntrega) & " dias" Else session("PrazoEntrega") = Cstr(PrazoEntrega) & "dia" End If set PrazoEntrega = nothing informacoes = informacoes & OpcaoFrete("PAC", auxValor, "ok") Exit For End if next End If Set oXmlDom = Nothing End Function 'FIM '############### 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 %>