frxzip.pas

这个是功能强大的报表软件

procedure TfrxZipCentralDirectory.SaveToStream(const Stream: TStream);
begin
  Stream.Write(FEndOfChentralDirSignature, 4);
  Stream.Write(FNumberOfTheDisk, 2);
  Stream.Write(FNumberOfTheDiskStartCentralDir, 2);
  Stream.Write(FTotalOfEntriesCentralDirOnDisk, 2);
  Stream.Write(FTotalOfEntriesCentralDir, 2);
  Stream.Write(FSizeOfCentralDir, 4);
  Stream.Write(FOffsetStartingDiskDir, 4);
  Stream.Write(FCommentLength, 2);
  if FCommentLength > 0 then
    Stream.Write(FComment[1], FCommentLength);
end;

procedure TfrxZipCentralDirectory.SetComment(const Value: AnsiString);
begin
  FComment := Value;
  FCommentLength := Length(Value);
end;

{ TfrxZipFileHeader }

constructor TfrxZipFileHeader.Create;
begin
  FCentralFileHeaderSignature := $02014b50;
  FRelativeOffsetLocalHeader := 0;
  FUnCompressedSize := 0;
  FCompressedSize := 0;
  FCrc32 := 0;
  FExternalFileAttribute := 0;
  FExtraField := '';
  FFileComment := '';
  FFileName := '';
  FCompressionMethod := 0;
  FDiskNumberStart := 0;
  FLastModFileDate := 0;
  FLastModFileTime := 0;
  FVersionMadeBy := ZIP_VERSIONMADEBY;
  FGeneralPurpose := 0;
  FFileNameLength := 0;
  FInternalFileAttribute := 0;
  FExtraFieldLength := 0;
  FVersionNeeded := ZIP_VERSIONMADEBY;
  FFileCommentLength := 0;
end;

procedure TfrxZipFileHeader.SaveToStream(const Stream: TStream);
begin
  Stream.Write(FCentralFileHeaderSignature, 4);
  Stream.Write(FVersionMadeBy, 2);
  Stream.Write(FVersionNeeded, 2);
  Stream.Write(FGeneralPurpose, 2);
  Stream.Write(FCompressionMethod, 2);
  Stream.Write(FLastModFileTime, 2);
  Stream.Write(FLastModFileDate, 2);
  Stream.Write(FCrc32, 4);
  Stream.Write(FCompressedSize, 4);
  Stream.Write(FUnCompressedSize, 4);
  Stream.Write(FFileNameLength, 2);
  Stream.Write(FExtraFieldLength, 2);
  Stream.Write(FFileCommentLength, 2);
  Stream.Write(FDiskNumberStart, 2);
  Stream.Write(FInternalFileAttribute, 2);
  Stream.Write(FExternalFileAttribute, 4);
  Stream.Write(FRelativeOffsetLocalHeader, 4);
  Stream.Write(FFilename[1], FFileNameLength);
  Stream.Write(FExtraField[1], FExtraFieldLength);
  Stream.Write(FFileComment[1], FFileCommentLength);
end;

procedure TfrxZipFileHeader.SetExtraField(const Value: AnsiString);
begin
  FExtraField := Value;
  FExtraFieldLength := Length(Value);
end;

procedure TfrxZipFileHeader.SetFileComment(const Value: AnsiString);
begin
  FFileComment := Value;
  FFileNameLength := Length(Value);
end;

procedure TfrxZipFileHeader.SetFileName(const Value: AnsiString);
begin
  FFileName := StringReplace(Value, AnsiString('\'), AnsiString('/'), [rfReplaceAll]);
  FFileNameLength := Length(Value);
end;

{ TfrxZipArchive }

procedure TfrxZipArchive.AddDir(const DirName: AnsiString);
var
  SRec: TSearchRec;
  i: Integer;
  s: AnsiString;
begin
  if DirectoryExists(String(DirName)) then
  begin
    s := DirName;
    if s[Length(s)] <> '\' then
      s := s + '\';
    i := FindFirst(String(s) + '*.*', faDirectory + faArchive, SRec);
    try
      while i = 0 do
      begin
        if (SRec.Name <> '.') and (SRec.Name <> '..') then
        begin
          if (SRec.Attr and faDirectory) = faDirectory then
            AddDir(s + AnsiString(SRec.Name))
          else
            AddFile(s + AnsiString(SRec.Name));
        end;
        i := FindNext(SRec);
      end;
    finally
      FindClose(SRec);
    end;
  end;
end;

procedure TfrxZipArchive.AddFile(const FileName: AnsiString);
begin
  if FileExists(String(FileName)) then
  begin
    FFileList.Add(String(FileName));
    if FRootFolder = '' then
      FRootFolder := ExtractFilePath(FileName);
  end
  else
    FErrors.Add('File ' + String(FileName) + ' not found!');
end;

procedure TfrxZipArchive.Clear;
begin
  FErrors.Clear;
  FFileList.Clear;
  FRootFolder := '';
  FComment := '';
end;

constructor TfrxZipArchive.Create;
begin
  FProgress := nil;
  FErrors := TStringList.Create;
  FFileList := TStringList.Create;
  Clear;
end;

destructor TfrxZipArchive.Destroy;
begin
  FErrors.Free;
  FFileList.Free;
  inherited;
end;

function TfrxZipArchive.GetCount: Integer;
begin
  Result := FFileList.Count;
end;

procedure TfrxZipArchive.SaveToFile(const FileName: AnsiString);
var
  f: TFileStream;
begin
  f := TFileStream.Create(String(FileName), fmCreate);
  try
    SaveToStream(f);
  finally
    f.Free;
  end;
end;

procedure TfrxZipArchive.SaveToStream(const Stream: TStream);
var
  i: Integer;
  ZipFile: TfrxZipLocalFile;
  ZipFileHeader: TfrxZipFileHeader;
  ZipDir: TfrxZipCentralDirectory;
  FileStream: TFileStream;
  TempStream: TMemoryStream;
  FileName: AnsiString;
  CentralStartPos, CentralEndPos: Longword;
  LFT, LFT2: TFileTime;
  FDate, FTime: WORD;
begin
  for i := 0 to FFileList.Count - 1 do
  begin
    ZipFile := TfrxZipLocalFile.Create;
    ZipFile.FileData := TMemoryStream.Create;
    try
      FileName := StringReplace(AnsiString(FFileList[i]), FRootFolder, AnsiString(''), []);
      ZipFile.LocalFileHeader.FileName := FileName;
      FileStream := TFileStream.Create(FFileList[i], fmOpenRead + fmShareDenyWrite);
      try
        if FileStream.Size > ZIP_MINSIZE then
        begin
          FileStream.Position := 0;
          TempStream := TMemoryStream.Create;
          try
            frxDeflateStream(FileStream, TempStream);
            TempStream.Position := 2;
            ZipFile.FileData.CopyFrom(TempStream, TempStream.Size - 6);
          finally
            TempStream.Free;
          end;
          ZipFile.LocalFileHeader.CompressionMethod := ZIP_DEFLATED;
        end
        else
        begin
          ZipFile.FileData.CopyFrom(FileStream, 0);
          ZipFile.LocalFileHeader.CompressionMethod := ZIP_NONE;
        end;
        ZipFile.LocalFileHeader.CompressedSize := ZipFile.FileData.Size;
        ZipFile.LocalFileHeader.UnCompressedSize := FileStream.Size;
        TempStream := TMemoryStream.Create;
        try
          TempStream.CopyFrom(FileStream, 0);
          ZipFile.LocalFileHeader.Crc32 := frxStreamCRC32(TempStream);
        finally
          TempStream.Free;
        end;
        ZipFile.Offset := Stream.Position;
        GetFileTime(FileStream.Handle, @LFT, nil, nil);
        FileTimeToLocalFileTime(LFT, LFT2);
        FileTimeToDosDateTime(LFT2, FDate, FTime);
        ZipFile.LocalFileHeader.LastModFileDate := FDate;
        ZipFile.LocalFileHeader.LastModFileTime := FTime;
      finally
        FileStream.Free;
      end;
      ZipFile.SaveToStream(Stream);
      if Assigned(FProgress) then
        FProgress(Self);
    finally
      ZipFile.FileData.Free;
      ZipFile.FileData := nil;
    end;
    FFileList.Objects[i] := ZipFile;
  end;
  CentralStartPos := Stream.Position;
  for i := 0 to FFileList.Count - 1 do
  begin
    ZipFile := TfrxZipLocalFile(FFileList.Objects[i]);
    ZipFileHeader := TfrxZipFileHeader.Create;
    try
      ZipFileHeader.CompressionMethod := ZipFile.LocalFileHeader.CompressionMethod;
      ZipFileHeader.LastModFileTime := ZipFile.LocalFileHeader.LastModFileTime;
      ZipFileHeader.LastModFileDate := ZipFile.LocalFileHeader.LastModFileDate;
      ZipFileHeader.GeneralPurpose := ZipFile.LocalFileHeader.GeneralPurpose;
      ZipFileHeader.Crc32 := ZipFile.LocalFileHeader.Crc32;
      ZipFileHeader.CompressedSize := ZipFile.LocalFileHeader.CompressedSize;
      ZipFileHeader.UnCompressedSize := ZipFile.LocalFileHeader.UnCompressedSize;
      ZipFileHeader.RelativeOffsetLocalHeader := ZipFile.Offset;
      ZipFileHeader.FileName := ZipFile.LocalFileHeader.FileName;
      ZipFileHeader.SaveToStream(Stream);
    finally
      ZipFileHeader.Free;
    end;
    ZipFile.Free;
  end;
  CentralEndPos := Stream.Position;
  ZipDir := TfrxZipCentralDirectory.Create;
  try
    ZipDir.TotalOfEntriesCentralDirOnDisk := FFileList.Count;
    ZipDir.TotalOfEntriesCentralDir := FFileList.Count;
    ZipDir.SizeOfCentralDir := CentralEndPos - CentralStartPos;
    ZipDir.OffsetStartingDiskDir := CentralStartPos;
    ZipDir.SaveToStream(Stream);
  finally
    ZipDir.Free;
  end;
end;

end.