GARANTIR DESCONTO

Fórum Função de verificação de Repetição e Sequência de Caracter #294781

08/09/2005

0

Delphi

Bom Dia!

Estou precisando de uma função que verifique caracter repetido e sequência de caracter.
Já procurei no fórum e só encontrei uma função que verifique o caracter repetido.
Explicando melhor:
Preciso de uma função que verifique se em uma senha um caracter se repete 3 vezes (AAA, BBB, 111)
ou se esse caracter está seguindo uma sequência de 3 caracteres (Abc, def, ABC, 123), ou seja, se
numa senha existir o caracter ´a´ a função deverá verificar tb se os próximos dois carateres são ´b´ e ´c´.

Alguém possui uma função que faça essas duas verificações?

Desde já muito obrigada!


Dani_anjos

Dani_anjos

Responder

Posts

08/09/2005

Wilson Brito

[b:c302845dfa]Faça um teste.[/b:c302845dfa]

function VerificaRepeticao(texto:string;quant:byte):boolean;
const
 Letras: array[1..26] of char = (´a´,´b´,´c´,´d´,´e´,´f´,´g´,´h´,´i´,´j´,´k´,´l´,´m´,´n´,´o´,´p´,´q´,´r´,´s´,´t´,´u´,´v´,´w´,´x´,´y´,´z´);
 Numeros: array[1..10] of char = (´0´,´1´,´2´,´3´,´4´,´5´,´6´,´7´,´8´,´9´);
var
  i: integer;
//Igualdade
function igual(t:string):boolean;
var
  c,cont: integer;
  s: string;
begin
  Result := False;
  If length(t) > 1 then begin
    s := t[1];
    cont := 1;
    for c := 2 to Length(t) do begin
      if s <> t[c] then begin
        Result := false;
        break;
      end;
      s := t[c];
      inc(cont);
    end;
    If  Cont = quant then Result := True;
  end;
end;
//Seqüência
function sequencia(t:string):boolean;
var
  c,l,n1,n2: integer;
begin
  t := AnsiLowerCase(t);
  Result := true;
  //localizar letra
  n1 := -1;
  for l := 1 to 26 do begin
    if letras[l] = t[1] then
      n1 := l;
  end;
  if n1 > -1 then begin
    for c := 1 to quant do begin
       If (t[c] <> letras[n1]) then begin
         Result := False;
       end;
       Inc(n1);
    end;
  end;
  //localizar número
  n2 := -1;
  for l := 1 to 10 do begin
    if numeros[l] = t[1] then
      n2 := l;
  end;
  if n2 > -1 then begin
    for c := 1 to quant do begin
       If t[c] <> numeros[n2] then begin
         Result := False;
       end;
       Inc(n2);
    end;
  end;

 If (n1 = -1) and (n2 = -1) then Result := False;
end;


[b:c302845dfa]Use assim:[/b:c302845dfa]

procedure TForm1.Button1Click(Sender: TObject);
begin
  if VerificaRepeticao(Edit1.Text,3) then
  showmessage(´repete´) else showmessage(´não repete´);
end;



Responder

Gostei + 0

08/09/2005

Wilson Brito

[b:2d256ee778]Faltou um pedaço da função:[/b:2d256ee778]

function VerificaRepeticao(texto:string;quant:byte):boolean;
const
 Letras: array[1..26] of char = (´a´,´b´,´c´,´d´,´e´,´f´,´g´,´h´,´i´,´j´,´k´,´l´,´m´,´n´,´o´,´p´,´q´,´r´,´s´,´t´,´u´,´v´,´w´,´x´,´y´,´z´);
 Numeros: array[1..10] of char = (´0´,´1´,´2´,´3´,´4´,´5´,´6´,´7´,´8´,´9´);
var
  i: integer;
//Igualdade
function igual(t:string):boolean;
var
  c,cont: integer;
  s: string;
begin
  Result := False;
  If length(t) > 1 then begin
    s := t[1];
    cont := 1;
    for c := 2 to Length(t) do begin
      if s <> t[c] then begin
        Result := false;
        break;
      end;
      s := t[c];
      inc(cont);
    end;
    If  Cont = quant then Result := True;
  end;
end;
//Seqüência
function sequencia(t:string):boolean;
var
  c,l,n1,n2: integer;
begin
  t := AnsiLowerCase(t);
  Result := true;
  //localizar letra
  n1 := -1;
  for l := 1 to 26 do begin
    if letras[l] = t[1] then
      n1 := l;
  end;
  if n1 > -1 then begin
    for c := 1 to quant do begin
       If (t[c] <> letras[n1]) then begin
         Result := False;
       end;
       Inc(n1);
    end;
  end;
  //localizar número
  n2 := -1;
  for l := 1 to 10 do begin
    if numeros[l] = t[1] then
      n2 := l;
  end;
  if n2 > -1 then begin
    for c := 1 to quant do begin
       If t[c] <> numeros[n2] then begin
         Result := False;
       end;
       Inc(n2);
    end;
  end;

 If (n1 = -1) and (n2 = -1) then Result := False;
end;

begin
  Result := False;
  for i := 1 to Length(texto) do begin
    if igual(copy(texto,i,quant)) Or sequencia(copy(texto,i,quant)) then begin
      Result := true;
      Break;
    end;
  end;
end;



Responder

Gostei + 0

08/09/2005

Dani_anjos

Obrigada!!!
A função que vc me enviou funcionou perfeitamente!
Muito obrigada mesmo!

Abraços! :wink:


Responder

Gostei + 0

07/10/2007

Xxfabiokogaxx

Private Sub CmdTestar_Click()
If VerificaRepeticao(TxtSenha.Text, 3) Then
MsgBox ´Repete.´
Else
MsgBox ´Não Repete.´
End If
End Sub

Function VerificaRepeticao(texto As String, quant As Integer) As Boolean
Dim i As Integer
VerificaRepeticao = False
For i = 1 To Len(texto)
If igual(Mid(texto, i, quant), quant) Or sequencia(Mid(texto, i, quant), quant) Then
VerificaRepeticao = True
Exit For
End If
Next
End Function

Function igual(t As String, quant As Integer) As Boolean
Dim c, cont As Integer
Dim s As String
igual = False
If Len(t) > 1 Then
s = Mid(t, 1, 1)
cont = 1
For c = 2 To Len(t)
If s <> Mid(t, c, 1) Then
igual = False
Exit For
End If
s = Mid(t, c, 1)
cont = cont + 1
Next
If cont = quant Then igual = True
End If
End Function

Function sequencia(t As String, quant As Integer) As Boolean

Dim c, l, n1, n2 As Integer
Dim Letras(26) As String
Dim Numeros(10) As String

Letras(1) = ´a´
Letras(2) = ´b´
Letras(3) = ´c´
Letras(4) = ´d´
Letras(5) = ´e´
Letras(6) = ´f´
Letras(7) = ´g´
Letras(8) = ´h´
Letras(9) = ´i´
Letras(10) = ´j´
Letras(11) = ´k´
Letras(12) = ´l´
Letras(13) = ´m´
Letras(14) = ´n´
Letras(15) = ´o´
Letras(16) = ´p´
Letras(17) = ´q´
Letras(18) = ´r´
Letras(19) = ´s´
Letras(20) = ´t´
Letras(21) = ´u´
Letras(22) = ´v´
Letras(23) = ´w´
Letras(24) = ´x´
Letras(25) = ´y´
Letras(26) = ´z´

Numeros(1) = ´0´
Numeros(2) = ´1´
Numeros(3) = ´2´
Numeros(4) = ´3´
Numeros(5) = ´4´
Numeros(6) = ´5´
Numeros(7) = ´6´
Numeros(8) = ´7´
Numeros(9) = ´8´
Numeros(10) = ´9´

t = LCase(t)
sequencia = True

´localizar letra
n1 = -1
For l = 1 To 26
If Letras(l) = Mid(t, 1, 1) Then n1 = l
Next
If n1 > -1 Then
For c = 1 To quant
If Mid(t, c, 1) <> Letras(n1) Then
sequencia = False
End If
If n1 >= 26 Then n1 = 1 Else n1 = n1 + 1
Next
End If

´localizar número
n2 = -1
For l = 1 To 10
If Numeros(l) = Mid(t, 1, 1) Then n2 = l
Next
If n2 > -1 Then
For c = 1 To quant
If Mid(t, c, 1) <> Numeros(n2) Then
sequencia = False
End If
If n2 >= 10 Then n2 = 1 Else n2 = n2 + 1
Next
End If

If (n1 = -1) And (n2 = -1) Then sequencia = False

End Function


Responder

Gostei + 0

07/10/2007

Xxfabiokogaxx

1) PREVENDO SEQUENCIAS DECRESCENTES EX: 654321
2) CORREÇÃO DO ERRO QUANDO SENHA = 890
3) CÓDIGO EM VB.

Private Sub CmdTestar_Click()
If VerificaRepeticao(TxtSenha.Text, 3) Then
MsgBox ´Repete.´
Else
MsgBox ´Não Repete.´
End If
End Sub

Function VerificaRepeticao(texto As String, quant As Integer) As Boolean
Dim i As Integer
VerificaRepeticao = False
For i = 1 To Len(texto)
If igual(Mid(texto, i, quant), quant) Or sequenciaASC(Mid(texto, i, quant), quant) Or sequenciaDESC(Mid(texto, i, quant), quant) Then
VerificaRepeticao = True
Exit For
End If
Next
End Function


Function igual(t As String, quant As Integer) As Boolean
Dim c, cont As Integer
Dim s As String
igual = False
If Len(t) > 1 Then
s = Mid(t, 1, 1)
cont = 1
For c = 2 To Len(t)
If s <> Mid(t, c, 1) Then
igual = False
Exit For
End If
s = Mid(t, c, 1)
cont = cont + 1
Next
If cont = quant Then igual = True
End If
End Function

Function sequenciaASC(t As String, quant As Integer) As Boolean

Dim c, l, n1, n2 As Integer
Dim Letras(26) As String
Dim Numeros(10) As String

Letras(1) = ´a´
Letras(2) = ´b´
Letras(3) = ´c´
Letras(4) = ´d´
Letras(5) = ´e´
Letras(6) = ´f´
Letras(7) = ´g´
Letras(8) = ´h´
Letras(9) = ´i´
Letras(10) = ´j´
Letras(11) = ´k´
Letras(12) = ´l´
Letras(13) = ´m´
Letras(14) = ´n´
Letras(15) = ´o´
Letras(16) = ´p´
Letras(17) = ´q´
Letras(18) = ´r´
Letras(19) = ´s´
Letras(20) = ´t´
Letras(21) = ´u´
Letras(22) = ´v´
Letras(23) = ´w´
Letras(24) = ´x´
Letras(25) = ´y´
Letras(26) = ´z´

Numeros(1) = ´0´
Numeros(2) = ´1´
Numeros(3) = ´2´
Numeros(4) = ´3´
Numeros(5) = ´4´
Numeros(6) = ´5´
Numeros(7) = ´6´
Numeros(8) = ´7´
Numeros(9) = ´8´
Numeros(10) = ´9´

t = LCase(t)
sequenciaASC = True

´localizar letra
n1 = -1
For l = 1 To 26
If Letras(l) = Mid(t, 1, 1) Then n1 = l
Next
If n1 > -1 Then
For c = 1 To quant
If Mid(t, c, 1) <> Letras(n1) Then
sequenciaASC = False
End If
If n1 >= 26 Then n1 = 1 Else n1 = n1 + 1
Next
End If

´localizar número
n2 = -1
For l = 1 To 10
If Numeros(l) = Mid(t, 1, 1) Then n2 = l
Next
If n2 > -1 Then
For c = 1 To quant
If Mid(t, c, 1) <> Numeros(n2) Then
sequenciaASC = False
End If
If n2 >= 10 Then
If c < quant Then
sequenciaASC = False
End If
Else
n2 = n2 + 1
End If
Next
End If

If (n1 = -1) And (n2 = -1) Then sequenciaASC = False

End Function

Function sequenciaDESC(t As String, quant As Integer) As Boolean

Dim c, l, n1, n2 As Integer
Dim Letras(26) As String
Dim Numeros(10) As String

Letras(1) = ´a´
Letras(2) = ´b´
Letras(3) = ´c´
Letras(4) = ´d´
Letras(5) = ´e´
Letras(6) = ´f´
Letras(7) = ´g´
Letras(8) = ´h´
Letras(9) = ´i´
Letras(10) = ´j´
Letras(11) = ´k´
Letras(12) = ´l´
Letras(13) = ´m´
Letras(14) = ´n´
Letras(15) = ´o´
Letras(16) = ´p´
Letras(17) = ´q´
Letras(18) = ´r´
Letras(19) = ´s´
Letras(20) = ´t´
Letras(21) = ´u´
Letras(22) = ´v´
Letras(23) = ´w´
Letras(24) = ´x´
Letras(25) = ´y´
Letras(26) = ´z´

Numeros(1) = ´0´
Numeros(2) = ´1´
Numeros(3) = ´2´
Numeros(4) = ´3´
Numeros(5) = ´4´
Numeros(6) = ´5´
Numeros(7) = ´6´
Numeros(8) = ´7´
Numeros(9) = ´8´
Numeros(10) = ´9´

t = LCase(t)
sequenciaDESC = True

´localizar letra
n1 = -1
For l = 1 To 26
If Letras(l) = Mid(t, 1, 1) Then n1 = l
Next
If n1 > -1 Then
For c = 1 To quant
If Mid(t, c, 1) <> Letras(n1) Then
sequenciaDESC = False
End If
If n1 <= 1 Then n1 = 26 Else n1 = n1 - 1
Next
End If

´localizar número
n2 = -1
For l = 1 To 10
If Numeros(l) = Mid(t, 1, 1) Then n2 = l
Next
If n2 > -1 Then
For c = 1 To quant
If Mid(t, c, 1) <> Numeros(n2) Then
sequenciaDESC = False
End If
If n2 <= 1 Then
If c < quant Then
sequenciaDESC = False
End If
Else
n2 = n2 - 1
End If
Next
End If

If (n1 = -1) And (n2 = -1) Then sequenciaDESC = False

End Function


Responder

Gostei + 0

08/10/2007

Alcantarus

1) PREVENDO SEQUENCIAS DECRESCENTES EX: 654321 2) CORREÇÃO DO ERRO QUANDO SENHA = 890 3) CÓDIGO EM VB. Private Sub CmdTestar_Click() If VerificaRepeticao(TxtSenha.Text, 3) Then MsgBox ´Repete.´ Else MsgBox ´Não Repete.´ End If End Sub Function VerificaRepeticao(texto As String, quant As Integer) As Boolean Dim i As Integer VerificaRepeticao = False For i = 1 To Len(texto) If igual(Mid(texto, i, quant), quant) Or sequenciaASC(Mid(texto, i, quant), quant) Or sequenciaDESC(Mid(texto, i, quant), quant) Then VerificaRepeticao = True Exit For End If Next End Function Function igual(t As String, quant As Integer) As Boolean Dim c, cont As Integer Dim s As String igual = False If Len(t) > 1 Then s = Mid(t, 1, 1) cont = 1 For c = 2 To Len(t) If s <> Mid(t, c, 1) Then igual = False Exit For End If s = Mid(t, c, 1) cont = cont + 1 Next If cont = quant Then igual = True End If End Function Function sequenciaASC(t As String, quant As Integer) As Boolean Dim c, l, n1, n2 As Integer Dim Letras(26) As String Dim Numeros(10) As String Letras(1) = ´a´ Letras(2) = ´b´ Letras(3) = ´c´ Letras(4) = ´d´ Letras(5) = ´e´ Letras(6) = ´f´ Letras(7) = ´g´ Letras(8) = ´h´ Letras(9) = ´i´ Letras(10) = ´j´ Letras(11) = ´k´ Letras(12) = ´l´ Letras(13) = ´m´ Letras(14) = ´n´ Letras(15) = ´o´ Letras(16) = ´p´ Letras(17) = ´q´ Letras(18) = ´r´ Letras(19) = ´s´ Letras(20) = ´t´ Letras(21) = ´u´ Letras(22) = ´v´ Letras(23) = ´w´ Letras(24) = ´x´ Letras(25) = ´y´ Letras(26) = ´z´ Numeros(1) = ´0´ Numeros(2) = ´1´ Numeros(3) = ´2´ Numeros(4) = ´3´ Numeros(5) = ´4´ Numeros(6) = ´5´ Numeros(7) = ´6´ Numeros(8) = ´7´ Numeros(9) = ´8´ Numeros(10) = ´9´ t = LCase(t) sequenciaASC = True ´localizar letra n1 = -1 For l = 1 To 26 If Letras(l) = Mid(t, 1, 1) Then n1 = l Next If n1 > -1 Then For c = 1 To quant If Mid(t, c, 1) <> Letras(n1) Then sequenciaASC = False End If If n1 >= 26 Then n1 = 1 Else n1 = n1 + 1 Next End If ´localizar número n2 = -1 For l = 1 To 10 If Numeros(l) = Mid(t, 1, 1) Then n2 = l Next If n2 > -1 Then For c = 1 To quant If Mid(t, c, 1) <> Numeros(n2) Then sequenciaASC = False End If If n2 >= 10 Then If c < quant Then sequenciaASC = False End If Else n2 = n2 + 1 End If Next End If If (n1 = -1) And (n2 = -1) Then sequenciaASC = False End Function Function sequenciaDESC(t As String, quant As Integer) As Boolean Dim c, l, n1, n2 As Integer Dim Letras(26) As String Dim Numeros(10) As String Letras(1) = ´a´ Letras(2) = ´b´ Letras(3) = ´c´ Letras(4) = ´d´ Letras(5) = ´e´ Letras(6) = ´f´ Letras(7) = ´g´ Letras(8) = ´h´ Letras(9) = ´i´ Letras(10) = ´j´ Letras(11) = ´k´ Letras(12) = ´l´ Letras(13) = ´m´ Letras(14) = ´n´ Letras(15) = ´o´ Letras(16) = ´p´ Letras(17) = ´q´ Letras(18) = ´r´ Letras(19) = ´s´ Letras(20) = ´t´ Letras(21) = ´u´ Letras(22) = ´v´ Letras(23) = ´w´ Letras(24) = ´x´ Letras(25) = ´y´ Letras(26) = ´z´ Numeros(1) = ´0´ Numeros(2) = ´1´ Numeros(3) = ´2´ Numeros(4) = ´3´ Numeros(5) = ´4´ Numeros(6) = ´5´ Numeros(7) = ´6´ Numeros(8) = ´7´ Numeros(9) = ´8´ Numeros(10) = ´9´ t = LCase(t) sequenciaDESC = True ´localizar letra n1 = -1 For l = 1 To 26 If Letras(l) = Mid(t, 1, 1) Then n1 = l Next If n1 > -1 Then For c = 1 To quant If Mid(t, c, 1) <> Letras(n1) Then sequenciaDESC = False End If If n1 <= 1 Then n1 = 26 Else n1 = n1 - 1 Next End If ´localizar número n2 = -1 For l = 1 To 10 If Numeros(l) = Mid(t, 1, 1) Then n2 = l Next If n2 > -1 Then For c = 1 To quant If Mid(t, c, 1) <> Numeros(n2) Then sequenciaDESC = False End If If n2 <= 1 Then If c < quant Then sequenciaDESC = False End If Else n2 = n2 - 1 End If Next End If If (n1 = -1) And (n2 = -1) Then sequenciaDESC = False End Function


Amigo... se nao me engano... esse forum é Delphi... e nao VB...

Abraços,

Alcantarus.


Responder

Gostei + 0

09/10/2007

Xxfabiokogaxx

Desculpe, amigo.

Procurei no google sobre o assunto, e só me retornou este fórum. Se alguém procurar no mesmo caminho. Isso talvez ajude.

Infelizmente, não consigo remover as mensagens acima.

Desculpe.


Responder

Gostei + 0

Utilizamos cookies para fornecer uma melhor experiência para nossos usuários, consulte nossa política de privacidade.

Aceitar