[Resolvido] Gerar numeros e letras em ordem alfanumerica

[JWdesenvolvimentos 1]

Ola Amigos do forum, faz um bom tempo que parei de mexer com delphi e agora estou tendo que reapreender, estou tendo dificulade para gerar uma especie de lista com numeros e letras que nao se repitam, de maneira alguma começando dessa maneira:

 

usando 8 digitos exemplo

 

AAAAAAAA

AAAAAAAB

AAAAAAAC

 

assim por diante

 

AAAAAAA1

AAAAAAA9

AAAAAABA

AAAAAABB

AAAAAABC

AAAAAA1A

AAAAAA9A

AAAAAA1B

 

que so acabe apos usar todas as combinacoes possiveis dividindo em arquvivos de de 35000 sequencias ou talvez em 3 mb salvando em arquivo txt

 

os codigos que possuo sao os seguintes:

 

 

esse gera codigos aleatorios porem um so de cada vez, gostaria que fosse gerando ate nao ter mais combinacoes possiveis e entao parar.

 

procedure TForm1.Button2Click(Sender: TObject); 

var 
i:integer; 
const 
letras='ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890'; 
digitos=8; 
begin 

for i:=1 to digitos do 
Memo1.Text:=memo1.Text+letras[random(length(letras))+1]; 
end;

esse outro faz gerar ate o numero colocado porem so numeros

procedure TForm1.Button1Click(Sender: TObject); 

var 

  x: integer; 
begin 

  for x := 0 to Pred(50) do 
    begin 


      Memo1.Lines.Add(IntToStr(x)); 
    end; 

         end;

Esse outro carega arquivo txt, apaga a segunda linha e grava no arquivo txt a alteracao

 

procedure TForm1.Button3Click(Sender: TObject); 

  Var 
  Lista:TStringList; 
  i:Integer; 
Begin 
Lista:=TStringList.Create; 
Lista.LoadFromFile('c:\log.txt'); 

For i:=0 to Lista.Count -1 do begin 

if Lista[i]='2' then Lista.Delete(i); 

End; 
Lista.SaveToFile('c:\log.txt'); 
Lista.Free; 

end;

 

Como posso juntar esses 3 codigos para gerar letras e numeros e gravar no arquivo conforme sao geradas as sequencias ?

[JWdesenvolvimentos 1]

Bom, já que até o momento não houve nenhum post para meu problema e talvez você internauta esteja interesado no assunto aqui em discussão, veja aqui http://www.activedelphi.com.br/forum/viewtopic.php?p=261726#261726 também sobre o mesmo assunto e ajude melhorar com suas ideias obrigado JW.

[Chrnos 30]

Bom ver que conseguiu resolver seu problema com a ajuda dos colegas do site citado acima... mas lembre-se amigo: fórum não é serviço de help-desk, nem sempre terá suas respostas imediatamente após postar seu tópico... qualquer coisa, leia este tópico.

 

Marcarei o tópico como resolvido, visto que pelo que li sua dúvida já foi respondida no link que postou acima.

 

[]'s

[JWdesenvolvimentos 1]

Ola, Chrnos não tenho a intensão de pegar codigos prontos, ou usar os outros para fazer o sitema por mim, sempre antes de por algum post para apreender e resolver o problema, pesquiso antes em varios foruns sobre o assunto que preciso o qual nao encontrei em nenhum forum dos que pesquisei, usei o link a cima para não reescrever o assunto novamente e sim contiuar o mesmo em discussão aqui no forum, peço desculpa se de alguma maneira faltei com esse forum, no mais o sistema ainda esta em construção e concerteza logo teremos uma solução completa o qual assim que tiver vou postar aqui, para que todos possam melhorar apreender e se beneficiar do mesmo.

 

abraço JW.

[Chrnos 30]

Está certo JWdesenvolvimentos, peço desculpas também caso tenha feito um post ofensivo... pelo que li você está tentando quebrar o arquivo TXT em arquivos menores, estou correto? Tem um jeito para isso, neste post

 

[]'s

[JWdesenvolvimentos 1]

Ola, Amigo sua ajuda foi de grande importancia para o aprendizado deste colega, implementei o codigo que me passou pois e esatamente o que preciso, pois o codigo reparte em partes apos o arquivo gerado.

 

duvida1, o codigo renomeia a extensao do arquivo e nao o arquivo como posso mudadr isso , tentei mas não consigo alterar a forma como e renomeado.

 

duvida2 Como posso fazer para o sistema ir gerando arquivos pequenos a medida que sao geradas as sequencias, liberado a memoria pois quando coloco pra gerar 5 carcteres o pc tranca e não tem memoria para continuar.

 

acredito que solucionadas essa duvidas o sistema estara completo........

 

segue o codigo implementado.

 

unit sequenciaUnit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    ListBox1: TListBox;
    Edit1: TEdit;
  function CharInStr( const aChar : Char ) : Integer;
  procedure Sequencia( const aTam : Integer;  var aSequencia : String; var aUltimo : Boolean );
  procedure QuebraArquivo(FileName: string; MaxSizeByte: LongInt = 524288);

  procedure Button1Click(Sender: TObject);



  private

  public
  end;

var
  Form1: TForm1;

implementation


{$R *.dfm}
 const
 _cst_validchars = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789';

function Tform1.CharInStr( const aChar : Char ) : Integer;
var
  i : Integer;
  Achou : Boolean;
begin
   i:=0;
   Achou := False;
   while (not Achou ) and (i<length(_cst_validchars)) do begin
         inc(i);
         Achou := ( aChar = _cst_validchars[i] );
   end;

   // Se encontrar, tá certo.
   // Se não encontrar retornaremos o ultimo caracter valido
   // na esperança de sairmos de algum loop.
   Result := i;
end;

procedure TForm1.Sequencia( const aTam : Integer;  var aSequencia : String; var aUltimo : Boolean );
var
  i,k,l  : Integer;
begin
    while Length(aSequencia)<aTam  do
          aSequencia := aSequencia + _cst_validchars[1];

    aUltimo := False;
    l := Length( _cst_validchars );
    k := aTam;
    i := CharInStr(aSequencia[k]);
    // Ainda tem caracteres validos para listar?
    if i<l then
       // Sim.
       aSequencia[k] := _cst_validchars[i+1]
    else begin
         // Não. temos que retroceder.
         // Esse laço vai procurar o caracter na combinação
         // que pode ser incrementado.
         repeat
               dec(k);
               i := CharInStr( aSequencia[k] );
         until (k=0) or (i<l);
         // Encontramos o caracter que pode ser incrementado?
         if k>=1 then begin
            // Incrementado caracter encontrado
            aSequencia[k] := _cst_validchars[i+1];
            // Resetando os outros a partir de k
            while k<aTam do begin
                  inc(k);
                  aSequencia[k] := _cst_validchars[1];
            end;
         end
         else
            aUltimo := True;
    end;
end;

procedure TForm1.QuebraArquivo(FileName: string; MaxSizeByte: LongInt = 524288);
 var
     Arq, Arq2 : file of byte;
     buffer: array [1 .. 524288] of byte;//buffer de 1MB
     bufferSize: integer;
     cont, cont2 : integer;
 begin
     AssignFile(Arq, FileName);
     Reset(Arq);
     bufferSize := Length(buffer);
     cont := 0;
     while(not(eof(Arq))) do
     begin
         inc(cont);
         AssignFile(Arq2, FileName+inttostr(cont));
         Rewrite(Arq2);
         //faz duas leituras de 512Kb
         for cont2 := 1 to Round(MaxSizeByte/length(buffer))+1 do
         begin
             BlockRead(Arq, buffer, bufferSize, BufferSize);
             BlockWrite(Arq2, buffer, BufferSize, BufferSize);
         end;
         CloseFile(Arq2);
     end;
     CloseFile(Arq);
 end;




   procedure TForm1.Button1Click(Sender: TObject);
var
  S : String;
  Ultimo : Boolean;
  Lista : TStringList;
begin
   Lista:= TStringList.Create;
    S:= ''; // Ou um valor qualquer ex: '1234';
    Ultimo := False;

    //ListBox1.Items.BeginUpdate;
    while not Ultimo do begin
        Sequencia( 4, S, Ultimo );

      // ListBox1.Items.Add( S );
        Lista.Add(S)

    end;
  //ListBox1.Items.EndUpdate;
  //Lista.Add(ListBox1.Items.GetText);
  Lista.SaveToFile('c:\codigos\log.txt');

//QuebrandoArquivo

    QuebraArquivo('c:\codigos\log.txt');

   Lista.Free;
    end;

alguem ja criou algo semelhante?