Partir Archivos

[[seoane]]

Empezado por jorge_mosquera

Le verdad SI he partido los archivos utilizando TStringList, y recorriendo el archivo original, y me ha funcionado muy bien, solo que es algo lento.

No hubiera estado demás que mencionaras lo que habías intentado tu, así no hubiéramos perdido el tiempo. Incluso, tampoco hubiera sobrado un poco del código que utilizas.

De todas formas:

Código Delphi [-]
function Min(i,j: Integer): Integer;
begin
  if i < j then
    Result:= i
  else
    Result:= j;
end;

procedure Partir(Filename: string);
var
  Source, Dest: File;
  Size, Leidos, Escritos: Integer;
  Buffer: PChar;
begin
  AssignFile(Source,Filename);
  {$I-}
    Reset(Source,1);
  {$I+}
  if IOResult = 0 then
  try
    Size:= FileSize(Source) div 2;
    // Creamos un buffer de 1Mb
    GetMem(Buffer,1024 * 1024);
    try
      // Creamos el primer trozo
      AssignFile(Dest,Filename + '.001');
      {$I-}
        Rewrite(Dest,1);
      {$I+}
      if IOResult = 0 then
      try
        while (not Eof(Source)) and (Size > 0) do
        begin
          BlockRead(Source,Buffer^,Min(1024 * 1024,Size),Leidos);
          BlockWrite(Dest,Buffer^,Leidos,Escritos);
          dec(Size,Escritos);
        end;
        // Ajustamos el final de linea
        Buffer[0]:= #0;
        while (not Eof(Source)) and (Buffer[0] <> #10) do
        begin
          Buffer[0]:= #0;
          BlockRead(Source,Buffer^,1,Leidos);
          BlockWrite(Dest,Buffer^,Leidos,Escritos);
        end;
      finally
        CloseFile(Dest);
      end;
      // Creamos el segundo trozo
      AssignFile(Dest,Filename + '.002');
      {$I-}
        Rewrite(Dest,1);
      {$I+}
      if IOResult = 0 then
      try
        while not Eof(Source) do
        begin
          BlockRead(Source,Buffer^,1024 * 1024,Leidos);
          BlockWrite(Dest,Buffer^,Leidos,Escritos);
        end;
      finally
        CloseFile(Dest);
      end;
    finally
      FreeMem(Buffer);
    end;
  finally
    CloseFile(Source);
  end;
end;

// Por ejemplo
Partir('C:\Origen.txt');