Ir para conteúdo

POWERED BY:

Arquivado

Este tópico foi arquivado e está fechado para novas respostas.

Ilano

Como usar esta função para gerar boleto bancário?

Recommended Posts

Olá pessoal,

 

Peguei o código abaixo do site http://www.macoratti.net/boleto.htm, mas a linha digitável não foi gerada corretamente. Qual sua ordem de uso, isto é, qual a ordem de aplicação das funções?

 

Function Calculo_DV11(ByVal strNumero As String) As String

'declara as variáveis

Dim intContador As Integer

Dim intNumero As Integer

 

Dim intTotalNumero As Integer

 

Dim intMultiplicador As Integer

 

Dim intResto As Integer

 

' se nao for um valor numerico sai da função

If Not IsNumeric(strNumero) Then

Calculo_DV11 = ""

Exit Function

End If

 

'inicia o multiplicador

intMultiplicador = 9

 

'pega cada caracter do numero a partir da direita

For intcontador = Len(strNumero) To 1 Step -1

 

'extrai o caracter e multiplica prlo multiplicador

intnumero = Val(Mid(strNumero, intcontador, 1)) * intMultiplicador

 

'soma o resultado para totalização

intTotalNumero = intTotalNumero + intnumero

 

'se o multiplicador for maior que 2 decrementa-o caso contrario atribuir valor padrao original

intMultiplicador = IIf(intMultiplicador > 2, intMultiplicador - 1, 9)

 

Next

 

'calcula o resto da divisao do total por 11

intResto = intTotalNumero Mod 11

 

'verifica as exceções ( 0 -> DV=0 10 -> DV=X (para o BB) e retorna o DV

Select Case intResto

Case 0

Calculo_DV11 = "0"

Case 10

Calculo_DV11 = "X"

Case Else

Calculo_DV11 = str(intResto)

End Select

 

End Function

 

Function Calculo_DV10(ByVal strNumero As String) As String

'declara As variáveis

Dim intContador As Integer

Dim intNumero As Integer

 

Dim intTotalNumero As Integer

 

Dim intMultiplicador As Integer

 

Dim intResto As Integer

 

' se nao for um valor numerico sai da função

If Not IsNumeric(strNumero) Then

Calculo_DV10 = ""

Exit Function

End If

 

'inicia o multiplicador

intMultiplicador = 2

 

'pega cada caracter do numero a partir da direita

For intContador = Len(strNumero) To 1 Step -1

 

'extrai o caracter e multiplica pelo multiplicador

intNumero = Val(Mid(strNumero, intContador, 1)) * intMultiplicador

 

' se o resultado for maior que nove soma os algarismos do resultado

If intNumero > 9 Then

intNumero = Val(Left(intNumero, 1)) + Val(Right(intNumero, 1))

End If

 

'soma o resultado para totalização

intTotalNumero = intTotalNumero + intNumero

 

'se o multiplicador for igual a 2 atribuir valor 1 se for 1 atribui 2

intMultiplicador = IIf(intMultiplicador = 2, 1, 2)

 

Next

 

Dim DezenaSuperior As Integer

If intTotalNumero < 10 Then

DezenaSuperior = 10

Else

DezenaSuperior = 10 * (Val(Left(CStr(intTotalNumero), 1)) + 1)

End If

intResto = DezenaSuperior - intTotalNumero

 

'verifica as exceções ( 0 -> DV=0 )

Select Case intResto

Case 0

Calculo_DV10 = "0"

Case Else

Calculo_DV10 = Str(intResto)

End Select

 

End Function

 

Private Function Monta_CodBarras(ByVal Banco As String, ByVal Moeda As String, ByVal valor As Single, ByVal vencimento As Date, ByVal Livre As String)

 

Dim codigo_sequencia As String

Dim database As Date

Dim fator As Integer

Dim intDac As Integer

 

'database para calculo do fator

database = CDate("7/10/1997")

fator = DateDiff("d", database, Format(vencimento, "dd/MM/yyyy"))

valor = Int(valor * 100)

Livre = Format(Livre, "0000000000000000000000000")

 

' sequencia sem o DV

codigo_sequencia = Banco & Moeda & fator & Format(valor, "0000000000") & Livre

 

' calculo do DV

intDac = calcula_DV_CodBarras(codigo_sequencia)

 

' monta a sequencia para o codigo de barras com o DV

Monta_CodBarras = Left(codigo_sequencia, 4) & intDac & Right(codigo_sequencia, 39)

 

End Function

 

Private Function calcula_DV_CodBarras(ByVal sequencia As String) As Integer

 

Dim intContador, intNumero, intTotalNumero As Integer

Dim intMultiplicador, intResto, intresultado As Integer

Dim caracter As String

 

intMultiplicador = 2

 

For intContador = 1 To 43

caracter = Mid(Right(sequencia, intContador), 1, 1)

If intMultiplicador > 9 Then

intMultiplicador = 2

intNumero = 0

End If

intNumero = caracter * intMultiplicador

intTotalNumero = intTotalNumero + intNumero

intMultiplicador = intMultiplicador + 1

Next

 

intResto = intTotalNumero Mod 11

 

intresultado = 11 - intResto

 

If intresultado = 10 Or intresultado = 11 Then

calcula_DV_CodBarras = 1

Else

calcula_DV_CodBarras = intresultado

End If

 

End Function

 

Function Linha_Digitavel(ByVal sequencia As String, ByVal DV_CodBarras As String, ByVal valor As Single) As String

 

Dim seq1 As String

Dim seq2 As String

Dim seq3 As String

 

Dim dv1, dv2, dv3 As Integer

 

'separa a sequencia e prepara o valor

seq1 = Left(sequencia, 9)

seq2 = Mid(sequencia, 10, 10)

seq3 = Right(sequencia, 10)

valor = Int(valor * 100)

 

' calcula os dvs

dv1 = Val(Calculo_DV10(seq1))

dv2 = Val(Calculo_DV10(seq2))

dv3 = Val(Calculo_DV10(seq3))

 

'formata a sequencia

seq1 = Left(seq1 & dv1, 5) & "." & Right(seq1 & dv1, 5)

seq2 = Left(seq2 & dv2, 5) & "." & Right(seq2 & dv2, 6)

seq3 = Left(seq3 & dv3, 5) & "." & Right(seq3 & dv3, 6)

 

Linha_Digitavel = seq1 & " " & seq2 & " " & seq3 & " " & DV_CodBarras & " " & valor

 

End Function

 

Function Calculo_NossoNumero(ByVal sequencia As String) As String

'montamos o nosso numero com o numero do convenio ( 6 posicoes)

Dim dv As Integer

 

dv = Calculo_DV11(sequencia)

Calculo_NossoNumero = Format(sequencia & dv, "00000000000000000")

 

End Function

 

Tentei usá-la assim:

 

'GERAR O BOLETO BANCÁRIO: LINHA DIGITÁVEL ***********************************************
'Dim vlLivre As String
'vlLivre = Format(Ds.Tables(0).Rows(0)("Cand_Codigo"), "00000000") & Ds.Tables(0).Rows(0)("Esc_Carteira") & Right(Ds.Tables(0).Rows(0)("Esc_Agencia"), 1)

'3 - Private Function Monta_CodBarras(ByVal Banco As String, ByVal Moeda As String, ByVal valor As Single, ByVal vencimento As Date, ByVal Livre As String)
Dim V1 As String
'************** VERIFICAR SE ESSE AQUI ESTÁ CORRETO **********************
V1 = Monta_CodBarras("001", "9", "1001" & Format(Ds.Tables(0).Rows(0)("Of_Valor"), "0000000000"), Ds.Tables(0).Rows(0)("Vencimento"), Format(Ds.Tables(0).Rows(0)("Esc_Convenio"), "0000000"))

'4 - Private Function calcula_DV_CodBarras(ByVal sequencia As String) As Integer
Dim vlBarras As String
vlBarras = calcula_DV_CodBarras(V1)

'5 - Function Linha_Digitavel(ByVal sequencia As String, ByVal DV_CodBarras As String, ByVal valor As Single) As String
Dim vSequencia As String
LbLinha1.Text = Linha_Digitavel(V1, vlBarras, Format(Ds.Tables(0).Rows(0)("Of_Valor"), "###,###,###,##0.00"))
LbLinha2.Text = LbLinha1.Text
vSequencia = Replace(LbLinha1.Text, ".", "")
vSequencia = Replace(vSequencia, " ", "")

'6 - Function Calculo_NossoNumero(ByVal sequencia As String) As String
'O Nosso número será o Nº do Convênio e o Nº da Inscrição (Cand_Codigo).

'FIM DA GERAÇÃO DO BOLETO BANCÁRIO: LINHA DIGITÁVEL *********************************************

'GERANDO O CÓDIGO DE BARRAS: ******************************************
'Esta linha está sendo gerada corretamente. O problema está na geração da LINHA DIGITÁVEL
LbBarras.Text = Fn.getCodigoBarras(LbLinha1.Text)

'FIM DO CÓDIGO DE BARRAS. **********************************************

 

O único problema q estou tendo é em gerar o número da LINHA DIGITÁVEL, pois fazendo um teste no BB disseram que o CAMPO 3 está inválido. Por favor, me ajudem, pois só tenho até quarta-feira para resolver isso, e eu já tentei de tudo e não estou conseguindo resolver o problema.

 

Grato,

 

Ilano.

Compartilhar este post


Link para o post
Compartilhar em outros sites

Voce ja leu o lay out do banco?

O lay out voce pode obter com o proprio banco.

 

La certamente voce encontrara a explicacao para todos os calculos que sao efetuados para a linha digitavel e para a sequencia numerica do codigo de barras.

 

Verifique no lay out como e calculada essa sequencia que esta problematica.

 

Um Abraco

Compartilhar este post


Link para o post
Compartilhar em outros sites

Olá pessoal,

 

A coisa tá séria mesmo! Vieram dois caras do BB aqui e não resolveram nada, queriam instalar um programa aqui no computador pra gerar esse boleto, só q o boleto terá q ser gerado on-line para o candidato imprimir e pagar, só q o bicho tá pegando e preciso urgentemente resolver isso. Será q alguém não tem um outro exemplo, uma outra forma de fazer isso e q possa me ajudar? O código q eu postei aqui tá um pouco confuso e ficou mais ainda depois da vinda daqueles dois caras.

Por favor, me ajudem, meu prazo de entrega está se esgotando... http://forum.imasters.com.br/public/style_emoticons/default/upset.gif

Compartilhar este post


Link para o post
Compartilhar em outros sites

Olá pessoal,

 

Estou procurando de todas as formas resolver o problema, mas está difícil. Agora estou usando uma classe q é a apresentada neste artigo Gerando boletos bancários II, só q está dando um problema na classe na linha:

 

_Buffer.Append("<tr><td class=ld align=center><spam id=aceite2>" + lBoleto.Aceite + "</spam></td></tr></table></TD>")

O erro retornado é:

 

Conversion from string "<tr><td class=ld align=center><s" to type 'Double' is not valid.

Estou passando os parâmetros para a classe, da seguinte forma:

 

Private Sub ReceberDados()

Dim Ds As Data.DataSet

Ds = Candidatos.ConsultaAvancada(" A.Cand_CPF = '" & Secreto.Criptografa(Session("pCPF")) & "' ")

If Not Ds Is Nothing Then

If Ds.Tables(0).Rows.Count > 0 Then

With Profile.DadosDocumento

.DataDocumento = Format(Now(), "dd/MM/yyyy")

.DataEmissao = Format(Now(), "dd/MM/yyyy")

.DataProcessamento = Format(Now(), "dd/MM/yyyy")

.DataVencimento = Ds.Tables(0).Rows(0)("DataPagamento")

.NumeroDocumento = Format(Ds.Tables(0).Rows(0)("Cand_Codigo"), "0000000") 'Ds.Tables(0).Rows(0)("Esc_Convenio") & Format(Ds.Tables(0).Rows(0)("Cand_Codigo"), "0000000000")

.Sequencial = Format(Ds.Tables(0).Rows(0)("Cand_Codigo"), "0000000")

.Valor = Format(Ds.Tables(0).Rows(0)("Of_Valor"), "###,###,###,##0.00")

End With

'dados do Cedente (ESCOLA)

With Profile.DadosCedente

.Aceite = True

.Carteira = Ds.Tables(0).Rows(0)("Esc_Carteira")

.Contrato = Ds.Tables(0).Rows(0)("Esc_Convenio") & Format(Ds.Tables(0).Rows(0)("Cand_Codigo"), "0000000000")

.NomeCedente = Ds.Tables(0).Rows(0)("Esc_Nome")

.AgenciaCedente = Ds.Tables(0).Rows(0)("Esc_Agencia")

.ContaCedente = Ds.Tables(0).Rows(0)("Esc_Conta")

.DVContaCedente = Ds.Tables(0).Rows(0)("Esc_DVConta")

.instrucao = Ds.Tables(0).Rows(0)("Esc_Instrucoes")

End With

'dados do Sacado (CANDIDATOS)

With Profile.DadosCliente

.NomeSacado = Ds.Tables(0).Rows(0)("Cand_Nome")

.CPF_CNPJSacado = Secreto.Decriptografa(Ds.Tables(0).Rows(0)("Cand_CPF"))

.EnderecoSacado = Ds.Tables(0).Rows(0)("Cand_Endereco")

.Cidade = Ds.Tables(0).Rows(0)("Cand_Cidade")

.Estado = Ds.Tables(0).Rows(0)("Cand_Estado")

.Bairro = Ds.Tables(0).Rows(0)("Cand_Bairro")

.Cep = Ds.Tables(0).Rows(0)("Cand_Cep")

End With

End If

End If

 

GeraBoletoBB()

 

End Sub

 

Private Sub GeraBoletoBB()

Dim bolBB As Boleto = New BoletoBrasil

 

bolBB.Aceite = Profile.DadosCedente("Aceite")

bolBB.CedenteAgencia = Profile.DadosCedente("AgenciaCedente")

bolBB.CedenteConta = Profile.DadosCedente("ContaCedente")

bolBB.CedenteContaDV = Profile.DadosCedente("DVContaCedente")

bolBB.CedenteNome = Profile.DadosCedente("NomeCedente")

bolBB.Carteira = Int32.Parse(Profile.DadosCedente("Carteira"))

bolBB.Instrucao1 = Profile.DadosCedente("instrucao")

'

bolBB.Sequencial = Convert.ToInt32(Profile.DadosDocumento("Sequencial"))

bolBB.Documento = Profile.DadosDocumento("NumeroDocumento")

bolBB.DtDocumento = Convert.ToDateTime(Profile.DadosDocumento("DataDocumento"))

bolBB.DtEmissao = Convert.ToDateTime(Profile.DadosDocumento("DataEmissao"))

bolBB.DtProcessamento = Convert.ToDateTime(Profile.DadosDocumento("DataProcessamento"))

bolBB.DtVencimento = Convert.ToDateTime(Profile.DadosDocumento("DataVencimento"))

bolBB.Valor = CSng(Convert.ToDouble(Profile.DadosDocumento("Valor")))

'

bolBB.SacadoNome = Profile.DadosCliente("NomeSacado")

bolBB.SacadoEndereco = Profile.DadosCliente("EnderecoSacado")

bolBB.SacadoCPF_CNPJ = Profile.DadosCliente("CPF_CNPJSacado")

bolBB.SacadoCidade = Profile.DadosCliente("Cidade")

bolBB.SacadoUF = Profile.DadosCliente("Estado")

bolBB.SacadoBairro = Profile.DadosCliente("Bairro")

bolBB.SacadoCEP = Profile.DadosCliente("Cep")

 

Dim geraBoleto As New HTMLBoleto()

geraBoleto.ImagesFolder = "imagesBoleto"

geraBoleto.AddBoleto(bolBB)

geraBoleto.SaveToFile("boletoBB")

Response.Write(geraBoleto.ToString())

 

End Sub

 

Protected Sub Page_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load

If Not IsPostBack Then

ReceberDados()

 

End If

 

End Sub

O q pode estar errado???

 

Grato,

 

Ilano.

Compartilhar este post


Link para o post
Compartilhar em outros sites

Não sei o que é este Iboleto.Aceite, mas veja se ele tem o método ToString(). Se tiver deve ficar assim:

_Buffer.Append("<tr><td class=ld align=center><spam id=aceite2>" + lBoleto.Aceite.ToString() + "</spam></td></tr></table></TD>")

Abraços...

Compartilhar este post


Link para o post
Compartilhar em outros sites

×

Informação importante

Ao usar o fórum, você concorda com nossos Termos e condições.