简单ZIP生成类，可以将流打包生成标准格ZIP格式文件，只是没有对流进行压缩，仅是简单的组合，CRC部分参考的网上代码，以下为源码
View Code
unit uZip;
{
Scinyeah 111021
}
interface
Uses
Windows,SysUtils,Classes;
Type
TSimpleZip = Class
Private
FFile: TMemoryStream;
FDir: TMemoryStream;
FCount: Word;
FTab:Array[0..255] of DWORD;
Procedure InitialTab;
Public
Constructor Create;
Destructor Destroy; Override;
Function CrcFile(FileName: String): DWord;
Function CrcStream(Stream: TStream): DWord;
Procedure Clear;
Function AddFile(FileName: String):Boolean;
Function AddStream(Stream: TStream; Name: String): Boolean;
Procedure SaveToFile(FileName: String);
end;
implementation
//格式来源见 http://www.pkware.com/documents/casestudies/APPNOTE.TXT
Type
ZFile = Packed Record
Tag: Cardinal; //local file header signature 4 bytes (0x04034b50)
Ver: Word; //version needed to extract 2 bytes
Pur: Word; //general purpose bit flag 2 bytes
Met: Word; //compression method 2 bytes
Tim: Word; //last mod file time 2 bytes
Dat: Word; //last mod file date 2 bytes
Crc: Cardinal; //crc-32 4 bytes
CSi: Cardinal; //compressed size 4 bytes
USi: Cardinal; //uncompressed size 4 bytes
Nam: Word; //file name length 2 bytes
Res: Word; //extra field length 2 bytes
end;
ZDir = Packed Record
Tag: Cardinal; //central file header signature 4 bytes (0x02014b50)
VeM: Word; //version made by 2 bytes
VeE: Word; //version needed to extract 2 bytes
Pur: Word; //general purpose bit flag 2 bytes
Met: Word; //compression method 2 bytes
Tim: Word; //last mod file time 2 bytes
Dat: Word; //last mod file date 2 bytes
Crc: Cardinal; //crc-32 4 bytes
CSi: Cardinal; //compressed size 4 bytes
USi: Cardinal; //uncompressed size 4 bytes
Nam: Word; //file name length 2 bytes
Ext: Word; //extra field length 2 bytes
Fil: Word; //file comment length 2 bytes
Dis: Word; //disk number start 2 bytes
IFA: Word; //internal file attributes 2 bytes
EFA: Cardinal; //external file attributes 4 bytes
OffSite: Cardinal //relative offset of local header 4 bytes
end;
ZDirEnd = Packed Record
Tag: Cardinal; //end of central dir signature 4 bytes (0x06054b50)
Num: Word; //number of this disk 2 bytes
Dis: Word; //number of the disk with the start of the central directory 2 bytes
Ent: Word; //total number of entries in the central directory on this disk 2 bytes
Enc: Word; //total number of entries in the central directory 2 bytes
Siz: Cardinal; //size of the central directory 4 bytes
Site: Cardinal; //offset of start of central directory with respect to the starting disk number 4 bytes
CLen: Word; //ZIP file comment length 2 bytes
end;
{ TZip }
function TSimpleZip.AddFile(FileName: String): Boolean;
var
MS: TMemoryStream;
begin
Result := False;
if Not FileExists(FileName) then
Exit;
MS := TMemoryStream.Create;
MS.LoadFromFile(FileName);
MS.Position := 0;
Result := AddStream(MS,FileName);
MS.Free;
end;
function TSimpleZip.AddStream(Stream: TStream; Name: String): Boolean;
var
iPos: Int64;
F: ZFile;
D: ZDir;
begin
Result := False;
if (Stream = nil)or(Name = '')or(Stream.Position = Stream.Size) then
Exit;
FillChar(F,SizeOf(F),0);
FillChaR(D,SizeOf(D),0);
With F do
begin
Tag := $04034B50;
Crc := CrcStream(Stream);;
CSi := Stream.Size-Stream.Position;
USi := CSi;
Nam := Length(Name);
end;
With D do
begin
Tag := $02014b50;
Crc := F.Crc;
CSi := F.CSi;
USi := F.USi;
Nam := F.Nam;
OffSite := FFile.Position;
end;
With FFile do
begin
Write(F,SizeOf(F));
Write(Name[1],Length(Name));
iPos := Stream.Position;
CopyFrom(Stream,F.CSi);
Stream.Position := iPos;
end;
With FDir Do
begin
Write(D,SizeOf(D));
Write(Name[1],Length(Name));
end;
Inc(FCount);
Result := True;
end;
procedure TSimpleZip.Clear;
begin
FFile.Clear;
FDir.Clear;
FCount := 0;
end;
function TSimpleZip.CrcFile(FileName: String): DWord;
var
MS: TMemoryStream;
begin
MS := TMemoryStream.Create;
MS.LoadFromFile(FileName);
MS.Position := 0;
Result := CrcStream(MS);
MS.Free;
end;
function TSimpleZip.CrcStream(Stream: TStream): DWord;
var
iPos: Int64;
CRC32: DWord;
B: Byte;
begin
iPos := Stream.Position;
CRC32 :=$ffffffff;
While Stream.Position < Stream.Size do
begin
Stream.Read(B,1);
CRC32 := (CRC32 shr 8) xor FTab[B xor (CRC32 and $000000ff)];
end;
Stream.Position := iPos;
Result := not CRC32;
end;
constructor TSimpleZip.Create;
begin
FFile := TMemoryStream.Create;
FDir := TMemoryStream.Create;
FCount := 0;
InitialTab;
end;
destructor TSimpleZip.Destroy;
begin
FFile.Free;
FDir.Free;
inherited;
end;
procedure TSimpleZip.InitialTab;
var
i,j:integer;
Crc: DWord;
begin
for i:=0 to 255 do
begin
Crc:=i;
for j:=0 to 7 do
begin
if (Crc and 1)<>0 then
Crc:=(Crc shr 1) xor $EDB88320
else
Crc:=Crc shr 1;
end;
FTab[i]:=Crc;
end;
end;
procedure TSimpleZip.SaveToFile(FileName: String);
var
E: ZDirEnd;
MS: TMemoryStream;
begin
FillChaR(E,SizeOf(E),0);
With E do
begin
Tag := $06054b50;
Ent := FCount;
Enc := FCount;
Siz := FDir.Size;
Site := FFile.Position;
end;
MS := TMemoryStream.Create;
FFile.Position := 0;
MS.CopyFrom(FFile,FFile.Size);
FFile.Position := FFile.Size;
FDir.Position := 0;
MS.CopyFrom(FDir,FDir.Size);
FDir.Position := FDir.Size;
MS.Write(E,SizeOf(E));
MS.SaveToFile(FileName);
MS.Free;
end;
end.
调用方法如下
View Code
with TSimpleZip.Create do
begin
AddFile('ABC.TXT');
AddFile('DEF.TXT');
AddFile('ZIP.EXE');
SaveToFile('1.zip');
Free;
end;
说明： 支持目录压缩，但没有检查，文件得一个一个添加
