Соединить и сжать несколько файлов в один

Советы » Файлы » Соединить и сжать несколько файлов в один

uses

Zlib; procedure

CompressFiles(Files : TStrings; const

Filename : String

); var

infile, outfile, tmpFile : TFileStream; compr : TCompressionStream; i,l : Integer; s : String

; begin

if

Files.Count > 0 then

begin

outFile := TFileStream.Create(Filename,fmCreate); try

{ the number of files } l := Files.Count; outfile.Write

(l,SizeOf(l)); for

i := 0 to

Files.Count-1 do

begin

infile := TFileStream.Create(Files[i],fmOpenRead); try

{ the original filename } s := ExtractFilename(Files[i]); l := Length(s); outfile.Write

(l,SizeOf(l)); outfile.Write

(s[1],l); { the original filesize } l := infile.Size; outfile.Write

(l,SizeOf(l)); { compress and store the file temporary} tmpFile := TFileStream.Create('tmp',fmCreate); compr := TCompressionStream.Create(clMax,tmpfile); try

compr.CopyFrom(infile,l); finally

compr.Free; tmpFile.Free; end

; { append the compressed file to the destination file } tmpFile := TFileStream.Create('tmp',fmOpenRead); try

outfile.CopyFrom(tmpFile,0); finally

tmpFile.Free; end

; finally

infile.Free; end

; end

; finally

outfile.Free; end

; DeleteFile('tmp'); end

; end

; procedure

DecompressFiles(const

Filename, DestDirectory : String

); var

dest,s : String

; decompr : TDecompressionStream; infile, outfile : TFilestream; i,l,c : Integer; begin

// IncludeTrailingPathDelimiter (D6/D7 only) dest := IncludeTrailingPathDelimiter(DestDirectory); infile := TFileStream.Create(Filename,fmOpenRead); try

{ number of files } infile.Read

(c,SizeOf(c)); for

i := 1 to

c do

begin

{ read filename } infile.Read

(l,SizeOf(l)); SetLength(s,l); infile.Read

(s[1],l); { read filesize } infile.Read

(l,SizeOf(l)); { decompress the files and store it } s := dest+s; //include the path outfile := TFileStream.Create(s,fmCreate); decompr := TDecompressionStream.Create(infile); try

outfile.CopyFrom(decompr,l); finally

outfile.Free; decompr.Free; end

; end

; finally

infile.Free; end

; end

;

Другое по теме:

Категории

Статьи

Советы

Copyright © 2022 - All Rights Reserved - www.delphirus.com