Nenhuma resposta neste tópico

[JWdesenvolvimentos]

Ola, não consigo fazer o codigo abaixo gerar arquivos pequenos sem gerar o arquivo maior.

O sistema gera um arquivo enorme exemplo 16 digitos, ultrapsa 200gb e só então divide em partes de 5mb.

O que eu estou tendo fazer e não gerar o arquivo grande e sim gerar arquivos pequenos em ordem txt1.txt, txt2.txt, e etc.... ate acabar as sequencias.


alguém se habilita?

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))+10 do 
		 begin 
			 BlockRead(Arq, buffer, bufferSize, BufferSize); 
			 BlockWrite(Arq2, buffer, BufferSize, BufferSize); 
		 end; 
		 CloseFile(Arq2); 
	 end; 
	 CloseFile(Arq); 
 end; 
 
 
 
 
   procedure TForm1.Button2Click(Sender: TObject); 
var 
  S : String; 
  Ultimo : Boolean; 
  O : TextFile; 
 Fname : String; 
 
   begin 
	  Fname := 'E:\codigos\log.txt'; 
AssignFile(O,Fname); 
Rewrite(O); 
  Ultimo := False; 
 
   while not Ultimo do begin 
		Sequencia( 16, S, Ultimo ); 
 
 Writeln(O,S); 
 
 Edit1.Text:=(S); 
		end; 
 
CloseFile(O); 
  QuebraArquivo('E:\codigos\log.txt'); 
		end;