Los archivos con la extensión .tar.gz, también conocidos como "tarball", son viejos conocidos para aquellos que están acostumbrados a trabajar con linux, ya que es uno de los formatos mas extendidos dentro de ese mundillo para intercambiar ficheros comprimidos. En realidad un tarball es un archivo TAR que posteriormente a sido comprimido con gzip.
Estos dos formatos se complementan a la perfección, mientras gzip nos permite comprimir un fichero, el formato TAR nos permite almacenar dentro de un mismo fichero toda una estructura de ficheros y directorios. De esta manera si queremos comprimir todo el contenido de un directorio dentro de un solo fichero comprimido, primero tenemos que crear un fichero TAR con todos los ficheros y luego comprimir ese fichero usando gzip.
El código que muestro a continuación se divide en dos partes, una "unit" con el objeto TTarWriter y un ejemplo de como usarlo para crear un archivo ".tar.gz".
unit tar; interface uses Windows, Sysutils, Classes; type ETarError = class(Exception); ETarInvalidName = class(ETarError); THEADER_POSIX_USTAR = packed record name: array[0..99] of AnsiChar; mode: array[0..7] of AnsiChar; uid: array[0..7] of AnsiChar; gid: array[0..7] of AnsiChar; size: array[0..11] of AnsiChar; mtime: array[0..11] of AnsiChar; checksum: array[0..7] of AnsiChar; typeflag: AnsiChar; linkname: array[0..99] of AnsiChar; magic: array[0..5] of AnsiChar; version: array[0..1] of AnsiChar; uname: array[0..31] of AnsiChar; gname: array[0..31] of AnsiChar; devmajor: array[0..7] of AnsiChar; devminor: array[0..7] of AnsiChar; prefix: array[0..154] of AnsiChar; pad: array[0..11] of AnsiChar; end; TTarWriter = class(TObject) private FCRC32: Cardinal; FCalcCRC32: Boolean; FDest: TStream; FSize: Integer; procedure WriteBuffer(const Buffer; Count: Longint); procedure CopyFrom(Source: TStream; Count: Int64); public constructor Create(Dest: TStream; CalcCRC32: Boolean = FALSE); destructor Destroy; override; procedure AddDir(Name: AnsiString); overload; procedure AddDir(Name: AnsiString; Path: String); overload; procedure AddFile(Name: AnsiString; Filename: String); procedure AddStream(AStream: TStream; Count: Integer; Name: AnsiString; TypeFlag: AnsiChar = '0'; MTime: int64 = 0); procedure Pad(Count: Integer); property CRC32: Cardinal read FCRC32; property Size: Integer read FSize; end; implementation var CRCTable: array[0..255] of Cardinal; procedure MakeCRCTable; var c: Cardinal; n,k: Integer; begin for n:= 0 to 255 do begin c:= n; for k:= 0 to 7 do if Odd(c) then c:= $edb88320 xor (c shr 1) else c:= c shr 1; CRCTable[n]:= c; end; end; // Calcula el CRC-32 function UpdateCRC(CRC: Cardinal; Buffer: PByte; Len: Integer): Cardinal; begin CRC:= CRC xor $ffffffff; while Len > 0 do begin CRC:= CRCTable[(CRC xor Cardinal(Buffer^)) and $ff] xor (CRC shr 8); dec(Len); inc(Buffer); end; Result:= CRC xor $ffffffff; end; function IntToOct(Value: Cardinal; Digits: Integer): AnsiString; begin Result:= EmptyStr; while Value > 0 do begin Result:= IntToStr(Value mod 8) + Result; Value:= Value div 8; end; while Length(Result) < Digits do Result:= '0' + Result; end; { TTarWriter } procedure TTarWriter.AddDir(Name: AnsiString); begin // Todos los directorios deben terminar en "/" if Copy(Name,Length(Name),1) <> '/' then Name:= Name + '/'; AddStream(nil, 0, Name, '5'); end; procedure TTarWriter.AddDir(Name: AnsiString; Path: String); var SR: TSearchRec; begin if Copy(Name,Length(Name),1) <> '/' then Name:= Name + '/'; // Añadimos el directorio actual AddStream(nil, 0, Name, '5'); // Y luego su contenido Path:= IncludeTrailingPAthDelimiter(Path); if FindFirst(Path + '*.*',faAnyFile,SR) = 0 then repeat if (SR.Name <> '.') and (SR.Name <> '..') then begin if (SR.Attr and faDirectory) = faDirectory then AddDir(Name+SR.Name,Path+SR.Name) else AddFile(Name+SR.Name,Path+SR.Name); end; until FindNext(SR)<>0; end; procedure TTarWriter.AddFile(Name: AnsiString; Filename: String); var Stream: TFileStream; FTime: FILETIME; MTime: int64; begin Stream:= TFileStream.Create(Filename,fmOpenRead or fmShareDenyWrite); try if GetFileTime(Stream.Handle,nil,nil,@FTime) then // FILETIME -> UNIX MTime:= (int64(FTime) - int64(116444736000000000)) div 10000000 else MTime:= 0; AddStream(Stream, Stream.Size, Name, '0', MTime); finally Stream.Free; end; end; procedure TTarWriter.AddStream(AStream: TStream; Count: Integer; Name: AnsiString; TypeFlag: AnsiChar = '0'; MTime: int64 = 0); var Header: THEADER_POSIX_USTAR; i,j: Integer; P: PByte; begin // Rellenemos la cabecera FillChar(Header,Sizeof(Header),#0); // Si el nombre es demasiado largo if Length(Name) > Sizeof(Header.name) then begin // Lo partismo en 2 partes y usamos el campos "prefix" StrLCopy(Header.prefix,PAnsiChar(Name),Sizeof(Header.prefix)); for i:= High(Header.prefix) downto Low(Header.prefix) do if Header.prefix[i]='/' then break else Header.prefix[i]:= #0; delete(Name,1,StrLen(Header.prefix)); Header.prefix[i]:= #0; // Si sigue siendo demasiado largo devolvemos un error if Length(Name) > Sizeof(Header.name) then raise ETarInvalidName.Create('Invalid name') end; StrLCopy(Header.name,PAnsiChar(Name),Sizeof(Header.name)); // Los campos que no utilizamos los ponemos a cero StrCopy(Header.mode,PAnsiChar(IntToOct(0,7))); StrCopy(Header.uid,PAnsiChar(IntToOct(0,7))); StrCopy(Header.gid,PAnsiChar(IntToOct(0,7))); // Size StrCopy(Header.size,PAnsiChar(IntToOct(Count,11))); // Modification time StrCopy(Header.mtime,PAnsiChar(IntToOct(MTime,11))); // El checksum se llena con el caractrer #32 FillChar(Header.checksum,Sizeof(Header.checksum),#32); Header.typeflag:= TypeFlag; StrCopy(Header.magic,PAnsiChar('ustar')); StrCopy(Header.version,PAnsiChar('00')); // Calcular checksum P:= @Header; j:= 0; for i:= 1 to Sizeof(Header) do begin inc(j,P^); inc(P); end; StrCopy(Header.checksum,PAnsiChar(IntToOct(j,7))); // Escribimos la cabecera WriteBuffer(Header,Sizeof(Header)); // Escribimos los datos del fichero if AStream <> nil then CopyFrom(AStream,Count); // Completamos el bloque Pad(512); end; procedure TTarWriter.CopyFrom(Source: TStream; Count: Int64); const MaxBufferSize = $F000; var Buffer: PChar; BufferSize, n: Integer; begin if Count > MaxBufferSize then BufferSize:= MaxBufferSize else BufferSize:= Count; GetMem(Buffer, BufferSize); try while Count > 0 do begin if Count > BufferSize then n:= BufferSize else n:= Count; Source.ReadBuffer(Buffer^,n); WriteBuffer(Buffer^,n); Dec(Count,n); end; finally FreeMem(Buffer, BufferSize); end; end; constructor TTarWriter.Create(Dest: TStream; CalcCRC32: Boolean = FALSE); begin inherited Create; FCalcCRC32:= CalcCRC32; FDest:= Dest; FSize:= 0; end; destructor TTarWriter.Destroy; begin // Completamos hasta un multiplo de 10Kb Pad(10*1024); end; // Completa el fichero para que su tamaño sea multplo de "Count" procedure TTarWriter.Pad(Count: Integer); var i: Integer; P: PByte; begin i:= FSize mod Count; if i = 0 then Exit; i:= Count - i; GetMem(P,i); try FillChar(P^,i,#0); WriteBuffer(P^,i); finally FreeMem(P); end; end; procedure TTarWriter.WriteBuffer(const Buffer; Count: Integer); begin FDest.WriteBuffer(Buffer,Count); inc(FSize,Count); // Si queremos calcular el CRC32 if FCalcCRC32 then FCRC32:= UpdateCRC(FCRC32,@Buffer,Count); end; initialization MakeCRCTable; end.
Con la "unit" anterior crear un archivo TAR es así de sencillo:
var Dest: TFileStream; begin // Creamos el archivo de destino Dest:= TFileStream.Create('E:\test.tar',fmCreate); try with TTARWriter.Create(Dest) do try // Añadimos un directorio completo AddDir('test','E:\test'); finally Free; end; finally Dest.Free; end; end;
Ahora para conseguir nuestro objetivo solo nos falta comprimir el archivo TAR, y aunque podríamos crear primero el archivo en disco y luego comprimirlo, mejor vamos a crearlo y comprimirlo todo a la vez en una sola pasada, ahorrándonos mucho tiempo. Aunque como vamos a realizar todo el proceso en la memoria hemos de asegurarnos que le fichero comprimido no va a ser demasiado grande.
uses tar,zlib; type { +---+---+---+---+---+---+---+---+---+---+ |ID1|ID2|CM |FLG| MTIME |XFL|OS | +---+---+---+---+---+---+---+---+---+---+ } TGZHeader = packed record ID1: Byte; // IDentification 1 = 31 ID2: Byte; // IDentification 2 = 139 CM: Byte; // Compression Method = 8 FLG: Byte; // Flags MTIME: Cardinal; // Modification TIME XFL: Byte; // Extra Flags OS: Byte; // Operating System end; { +---+---+---+---+---+---+---+---+ | CRC32 | ISIZE | +---+---+---+---+---+---+---+---+ } TGZFooter = packed record CRC32: Cardinal; // CRC-32 ISIZE: Cardinal; // Input SIZE end; var GZHeader: TGZHeader; GZFooter: TGZFooter; TarWriter: TTarWriter; CmpStream: TCompressionStream; TmpStream: TMemoryStream; P: PAnsiChar; FTime: FILETIME; begin // Creamos un buffer temporal TmpStream:= TMemoryStream.Create; try CmpStream:= TCompressionStream.Create(clDefault,TmpStream); try TarWriter:= TTarWriter.Create(CmpStream,TRUE); try // Insertamos los ficheros Rellenar(TarWriter); // Completamos el fichero TarWriter.Pad(10*1024); // Guardamos el tamaño y CRC del fcihero TAR GZFooter.CRC32:= TarWriter.CRC32; GZFooter.ISIZE:= TarWriter.Size; finally TarWriter.Free; end; finally CmpStream.Free; end; // Creamos el gz with GZHeader do begin ID1:= 31; ID2:= 139; CM:= 8; FLG:= 0; GetSystemTimeAsFileTime(FTime); MTIME:= (int64(FTime) - int64(116444736000000000)) div 10000000; XFL:= 0; OS:= 255; end; with TFileStream.Create('E:\123.tar.gz',fmCreate) do try WriteBuffer(GZHeader,Sizeof(GZHeader)); P:= TmpStream.Memory; inc(P,2); WriteBuffer(P^,TmpStream.Size - 6); WriteBuffer(GZFooter,Sizeof(GZFooter)); finally Free; end; finally TmpStream.Free; end; end;
Donde la función "Rellenar" es la que se encarga de añadir ficheros al archivo TAR.
Por ejemplo
procedure Rellenar(TarWriter: TTarWriter); begin with TarWriter do begin // Añade un directorio y todo su contenido, incluyendo subdirectorios AddDir('test','E:\Archivos'); // Añade un directorio vacío AddDir('directorio'); // Añade un fichero AddFile('1.txt','E:\XVI32.exe'); end; end;
El resultado es un fichero tar.gz que podemos abrir con la mayoría de los programas de compresión actuales.
Enlaces de interés:
http://en.wikipedia.org/wiki/Tar_(file_format)
Comentarios
Buenas, Pues como te
Buenas,
Pues como te comentaba en el anterior mensaje, es sencillamente genial :)
No obstante, viendo por encima esto, se me da una duda. Aunque no suelo tener la necesidad de incluir más que un sólo fichero cuando comprimo, ¿cómo lo haríamos si queremos incluir algunos ficheros de un directorio? Es decir, no incluir todos los archivos de un mismo directorio (no se si se me entiende).
Gracias de nuevo amigo ;)
Nos leemos
Pues no hay problema,
Pues no hay problema, simplemente vas escogiendo los ficheros uno a uno.
Siguiendo con el ejemplo anterior:
Saludos
Ah!! perfecto amigo :) Por
Ah!! perfecto amigo :)
Por cierto, mirando esa función (AddDir) con más detalle, la primera comprobación que haces para saber si contiene o no el carácter / puedes hacer simplemente:
Name:= IncludeTrailingPathDelimiter(Name);
Nuevamente gracias
Nos leemos
Pues siento llevarte la
Pues siento llevarte la contraria, pero la función "IncludeTrailingPathDelimiter" compara el ultimo carácter con la constante "PathDelim" que se define así:
Por lo tanto, en windows, compara el ultimo carácter con '\' y no con '/' que es el carácter que se utiliza en linux para separar los directorios. No he probado si reemplazando '/' por '\' funcionaria, probablemente algunos descompresores no protestarían y harían la vista gorda, pero el estándar especifica que se debe usar '/' y no '\' como separador.
Saludos
jejeje, cierto, cierto, al
jejeje, cierto, cierto, al momento de responder no se por qué no me di cuenta del lado de la barra, y sí, ciertamente en Windows es \ (y es lo que haría la función).
En fin, suerte que te tenemos a ti ahí que estás en todo, jejeje :)
Nos leemos
Ya lo probé y funciona
Ya lo probé y funciona perfecto... Pero me gustaría saber la otra parte, o sea, cómo descomprimir el archivo
resultante desde Delphi.
Gracias.
Descomprimir un fichero es
Descomprimir un fichero es mas complicado que crearlo. Cuando lo creamos nosotros elegimos que cabecera vamos a usar (existen varias versiones para el formato .tar y .gz), escogemos que partes del estándar usar y cuales ignorar, en resumen, nosotros ponemos las normas y es el programa que lo descomprime el que se tiene que adaptar a ellas.
Un programa descompresor tiene que implementar TODO el estándar y estar preparado para "cualquier cosa" que le pueda llegar, y programar algo así lleva bastante mas trabajo.
Por otro lado, si el descompresor en el que tu piensas SOLO va a descomprimir los ficheros que tu mismo creas todo es mas sencillo, solo hay que hacer los pasos inversos que cuando lo creamos. Pero en ese caso no tiene sentido ceñirse a un formato estándar como el tar.gz puedes "inventar" uno mas simple que se ajuste a tus necesidades.
Por ejemplo, aquí puedes encontrar un ejemplo de como uso la librería zlib para comprimir y descomprimir una información que solo va a utilizar mi programa por lo que no necesita ajustarse a ningún formato estándar:
http://delphi.jmrds.com/node/65
Me queda una duda. Que es el
Me queda una duda. Que es el tipo FILETIME (FTime: FILETIME;). Podrias mostrar su declaraciòn. Muchas Gracias!.
El tipo FILETIME no lo
El tipo FILETIME no lo declaro yo, si no Windows. Y lo hace de la siguiente manera:
http://msdn.microsoft.com/en-us/library/ms724284(v=vs.85).aspx
Y la gente de borland lo tradujo, en la unit "Windows", de la siguiente manera:
Muchas gracias Domingo!. Muy
Muchas gracias Domingo!. Muy buena calidad el contenido de este blog!
un abrazo!
Hola chicos, muchas gracias
Hola chicos, muchas gracias por vuestro trabajo, es genial!!!!, he estado probando el código y para *.tar con más de 10 elementos lanza un error a la hora de descompresión. Sabéis donde podría estar el error?
¿Que error te da, y con que
¿Que error te da, y con que programa descompresor?
Yo acabo de probar a comprimir una carpeta entera, con con mas de 200 archivos, usando la opción "AddDir", y no he tenido ningún problema en descomprimirla usando 7zip.