frxpdffile.pas

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

  WriteLn(Stream, '/Keywords ' + PrepareString(FKeywords, FEncKey, FProtection, FCounter - 1));
  WriteLn(Stream, '/Creator ' + PrepareString(FCreator, FEncKey, FProtection, FCounter - 1));
  WriteLn(Stream, '/Producer ' + PrepareString(FProducer, FEncKey, FProtection, FCounter - 1));
  s := 'D:' + FormatDateTime('yyyy', Now) + FormatDateTime('mm', Now) +
    FormatDateTime('dd', Now) + FormatDateTime('hh', Now) +
    FormatDateTime('nn', Now) + FormatDateTime('ss', Now);
  if FProtection then
  begin
    WriteLn(Stream, '/CreationDate ' + PrepareString(s, FEncKey, FProtection, FCounter - 1));
    WriteLn(Stream, '/ModDate ' + PrepareString(s, FEncKey, FProtection, FCounter - 1));
  end
  else
  begin
    WriteLn(Stream, '/CreationDate (' + s + ')');
    WriteLn(Stream, '/ModDate (' + s + ')');
  end;
  WriteLn(Stream, '>>');
  WriteLn(Stream, 'endobj');
  if FOutline then
  begin
    Inc(FObjNo);
    XRefAdd(Stream, FObjNo);
    FOutlineN := FCounter;
    WriteLn(Stream, IntToStr(FOutlineN) + ' 0 obj');
    Parent := FCounter;
    Inc(FCounter);
    FPreviewOutline.LevelRoot;
    WriteLn(Stream, '<<');
    WriteLn(Stream, '/Count ' + IntToStr(FPreviewOutline.Count));
    WriteLn(Stream, '/First ' + IntToStr(FCounter) + ' 0 R');
    WriteLn(Stream, '/Last ' + IntToStr(FCounter + OutlineCount - 1) + ' 0 R');
    WriteLn(Stream, '>>');
    WriteLn(Stream, 'endobj');
    try
      DoWriteOutline(OutlineTree, Parent);
    finally
      OutlineTree.Free;
    end;
    pgN.Free;
    FCounter := FCounter + FPreviewOutline.Count;
  end;
  FStartFonts := FObjNo;
  Inc(FObjNo);
  for i := 0 to FFonts.Count - 1 do
    TfrxPDFFont(FFonts[i]).SaveToStream(Stream);

  FStartPages := FObjNo + 1;

  for i := 0 to FPages.Count - 1 do
  begin
    TfrxPDFPage(FPages[FPages.Count - 1]).StreamSize := FStreamObjects.Size - TfrxPDFPage(FPages[FPages.Count - 1]).StreamOffset;
    TfrxPDFPage(FPages[i]).SaveToStream(Stream);
  end;

  XRefAdd(Stream, FPagesRoot);
  WriteLn(Stream, IntToStr(FPagesRoot) + ' 0 obj');
  WriteLn(Stream, '<<');
  WriteLn(Stream, '/Type /Pages');
  Write(Stream, '/Kids [');
  for i := 0 to FPages.Count - 1 do
    Write(Stream, IntToStr(FStartPages + i * 2) + ' 0 R ');
  WriteLn(Stream, ']');
  WriteLn(Stream, '/Count ' + IntToStr(FPages.Count));
  WriteLn(Stream, '>>');
  WriteLn(Stream, 'endobj');
  FStartXRef := Stream.Position;
  WriteLn(Stream, 'xref');
  WriteLn(Stream, '0 ' + IntToStr(FXRef.Count + 1));
  WriteLn(Stream, '0000000000 65535 f');

  for i := 1 to FXRef.Count do
  begin
    j := FXRef.IndexOfObject(TObject(i));
    if j <> -1 then
      WriteLn(Stream, FXRef.Strings[j] + ' 00000 n');
  end;

  WriteLn(Stream, 'trailer');
  WriteLn(Stream, '<<');
  WriteLn(Stream, '/Size ' + IntToStr(FXref.Count + 1));
  WriteLn(Stream, '/Root 1 0 R');
  WriteLn(Stream, '/Info 2 0 R');
  WriteLn(Stream, '/ID [<' + FFileID + '><' + FFileID + '>]');

  if FProtection then
  begin
    WriteLn(Stream, '/Encrypt <<');
    WriteLn(Stream, '/Filter /Standard' );
{$IFDEF PDF_RC4}
    WriteLn(Stream, '/V 2');
    WriteLn(Stream, '/R 3');
{$ELSE}
    WriteLn(Stream, '/V 4');
    WriteLn(Stream, '/R 4');
    WriteLn(Stream, '/CF <<');
    WriteLn(Stream, '/StdCF <<');
    WriteLn(Stream, '/Type /CryptAlgorithm');
    WriteLn(Stream, '/CFM /AESV2');
    WriteLn(Stream, '/AuthEvent /DocOpen');
    WriteLn(Stream, '>>');
    WriteLn(Stream, '>>');
    WriteLn(Stream, '/StrF /StdCF');
    WriteLn(Stream, '/StmF /StdCF');
{$ENDIF}
    WriteLn(Stream, '/Length 128');
    WriteLn(Stream, '/P ' + IntToStr(Integer(FEncBits)));
    WriteLn(Stream, '/O (' + EscapeSpecialChar(GetOwnerPassword) + ')');
    WriteLn(Stream, '/U (' + EscapeSpecialChar(GetUserPassword) + ')');
    WriteLn(Stream, '>>');
  end;

  WriteLn(Stream, '>>');
  WriteLn(Stream, 'startxref');
  WriteLn(Stream, IntToStr(FStartXRef));
  WriteLn(Stream, '%%EOF');
end;

procedure TfrxPDFFile.XRefAdd(Stream: TStream; ObjNo: Integer);
begin
  FXRef.AddObject(StringOfChar('0',  10 - Length(IntToStr(Stream.Position))) + IntToStr(Stream.Position), TObject(ObjNo));
end;

function TfrxPDFFile.AddFont(const Font: TFont): Integer;
var
  Font2: TfrxPDFFont;
  i, j: Integer;
begin
  j := -1;
  for i := 0 to FFonts.Count - 1 do
  begin
    Font2 := TfrxPDFFont(FFonts[i]);
    if (Font2.Font.Name = Font.Name) and
       (Font2.Font.Style = Font.Style) and
       (Font2.Font.Charset = Font.Charset) then
    begin
      j := i;
      break;
    end;
  end;
  if j = -1 then
  begin
    Font2 := TfrxPDFFont.Create;
    Font2.Parent := Self;
    Font2.Font.Assign(Font);
    FFonts.Add(Font2);
    j := FFonts.Count - 1;
    Font2.Index := j + 1
  end;
  Result := j;
end;

function TfrxPDFFile.AddPage(const Page: TfrxReportPage): TfrxPDFPage;
var
  PDFPage: TfrxPDFPage;
begin
  PDFPage := TfrxPDFPage.Create;
  PDFPage.Width := Page.Width * PDF_DIVIDER;
  PDFPage.Height := Page.Height * PDF_DIVIDER;
  PDFPage.MarginLeft := Page.LeftMargin * PDF_MARG_DIVIDER;
  PDFPAge.MarginTop := Page.TopMargin * PDF_MARG_DIVIDER;
  PDFPage.Parent := Self;
  PDFPage.OutStream := FStreamObjects;
  PDFPage.StreamOffset := FStreamObjects.Position;
  if FPages.Count > 0 then
    TfrxPDFPage(FPages[FPages.Count - 1]).StreamSize := FStreamObjects.Position -
      TfrxPDFPage(FPages[FPages.Count - 1]).StreamOffset;
  FPages.Add(PDFPage);
  PDFPage.Index := FPages.Count;
  Result := PDFPage;
  FFontDCnt := 2;
end;

function PMD52Str(p: Pointer): AnsiString;
begin
  SetLength(Result, 16);
  Move(p^, Result[1], 16);
end;

function PadPassword(Password: AnsiString): AnsiString;
var
  i: Integer;
begin
  i := Length(Password);
  Result := Copy(Password, 1, i);
  SetLength(Result, 32);
  if i < 32 then
    Move(PDF_PK, Result[i + 1], 32 - i);
end;

procedure TfrxPDFFile.PrepareKeys;
var
  s, s1, p, p1, fid: AnsiString;
  i, j: Integer;
  rc4: TfrxRC4;
  md5: TfrxMD5;
begin
// OWNER KEY
  if FOwnerPassword = '' then
    FOwnerPassword := FUserPassword;
  p := PadPassword(FOwnerPassword);
  md5 := TfrxMD5.Create;
  try
    md5.Init;
    md5.Update(@p[1], 32);
    md5.Finalize;
    s := PMD52Str(md5.Digest);
    for i := 1 to 50 do
    begin
      md5.Init;
      md5.Update(@s[1], 16);
      md5.Finalize;
      s := PMD52Str(md5.Digest);
    end;
  finally
    md5.Free;
  end;

  rc4 := TfrxRC4.Create;
  try
    p := PadPassword(FUserPassword);
    SetLength(s1, 32);
    rc4.Start(@s[1], 16);
    rc4.Crypt(@p[1], @s1[1], 32);
    SetLength(p1, 16);
    for i := 1 to 19 do
    begin
      for j := 1 to 16 do
        p1[j] := AnsiChar(Byte(s[j]) xor i);
      rc4.Start(@p1[1], 16);
      rc4.Crypt(@s1[1], @s1[1], 32);
    end;
    FOPass := s1;
  finally
    rc4.Free;
  end;

// ENCRYPTION KEY
  p := PadPassword(FUserPassword);
  md5 := TfrxMD5.Create;
  try
    md5.Init;
    md5.Update(@p[1], 32);
    md5.Update(@FOPass[1], 32);
    md5.Update(@FEncBits, 4);
    fid := '';
    for i := 1 to 16 do
      fid := fid + AnsiChar(chr(Byte(StrToInt('$' + String(FFileID[i * 2 - 1] + FFileID[i * 2])))));
    md5.Update(@fid[1], 16);
    md5.Finalize;
    s := PMD52Str(md5.Digest);
    for i := 1 to 50 do
    begin
      md5.Init;
      md5.Update(@s[1], 16);
      md5.Finalize;
      s := PMD52Str(md5.Digest);
    end;
  finally
    md5.Free;
  end;
  FEncKey := s;

// USER KEY
  md5 := TfrxMD5.Create;
  try
    md5.Update(@PDF_PK, 32);
    md5.Update(@fid[1], 16);
    md5.Finalize;
    s := PMD52Str(md5.Digest);
    s1 := FEncKey;
    rc4 := TfrxRC4.Create;
    try
      rc4.Start(@s1[1], 16 );
      rc4.Crypt(@s[1], @s[1], 16 );
      SetLength(p1, 16);
      for i := 1 to 19 do
      begin
        for j := 1 to 16 do
           p1[j] := AnsiChar(Byte(s1[j]) xor i);
         rc4.Start(@p1[1], 16 );
         rc4.Crypt(@s[1], @s[1], 16 );
      end;
      FUPass := s;
    finally
      rc4.Free;
    end;
    SetLength(FUPass, 32);
    FillChar(FUPass[17], 16, 0);
  finally
    md5.Free;
  end;
end;

function TfrxPDFFile.GetOwnerPassword: AnsiString;
begin
  Result := FOPass;
end;

function TfrxPDFFile.GetUserPassword: AnsiString;
begin
  Result := FUPass;
end;

procedure TfrxPDFFile.SetProtectionFlags(const Value: TfrxPDFEncBits);
begin
  FProtectionFlags := Value;
  FEncBits := $FFFFFFC0;
  FEncBits := FEncBits + (Cardinal(ePrint in Value) shl 2 +
    Cardinal(eModify in Value) shl 3 +
    Cardinal(eCopy in Value) shl 4 +
    Cardinal(eAnnot in Value) shl 5);
end;

procedure TfrxPDFFile.Start;
begin
  FFileID := MD5String(GetID);
  if FProtection then
    PrepareKeys;
end;

{ TfrxPDFPage }

constructor TfrxPDFPage.Create;
begin
  inherited;
  FMarginLeft := 0;
  FMarginTop := 0;
  FDivider := frxDrawText.DefPPI / frxDrawText.ScrPPI;
  FLastColor := clBlack;
  FLastColorResult := '0 0 0';
  FBMP := TBitmap.Create;
  FDefFontCharSet := GetDefFontCharSet;
end;

procedure TfrxPDFPage.SaveToStream(const Stream: TStream);
var
  i, id: Integer;
  s: String;
  TmpPageStream: TMemoryStream;
  TmpPageStream2: TMemoryStream;
begin
  inherited SaveToStream(Stream);
  Inc(Parent.FObjNo);
  Parent.XRefAdd(Stream, Parent.FObjNo);
  id := Parent.FFontDCnt + Parent.FStartFonts + (Index - 1) * 2;
  WriteLn(Stream, IntToStr(id) + ' 0 obj');
  WriteLn(Stream, '<<');
  WriteLn(Stream, '/Type /Page');
  WriteLn(Stream, '/Parent ' + IntToStr(Parent.FPagesRoot) + ' 0 R');
  WriteLn(Stream, '/MediaBox [0 0 ' + frFloat2Str(FWidth) + ' ' + frFloat2Str(FHeight) + ' ]');
  WriteLn(Stream, '/Resources <<');
  WriteLn(Stream, '/Font <<');
  for i := 0 to Parent.FFonts.Count - 1 do
    WriteLn(Stream, '/F' + IntToStr(TfrxPDFFont(Parent.FFonts[i]).Index - 1) + ' ' +
      IntToStr(TfrxPDFFont(Parent.FFonts[i]).FFontDCnt + Parent.FStartFonts) + ' 0 R');
  WriteLn(Stream, '>>');
  WriteLn(Stream, '/XObject <<');
  WriteLn(Stream, '>>');
  WriteLn(Stream, '/ProcSet [/PDF /Text /ImageC ]');
  WriteLn(Stream, '>>');
  WriteLn(Stream, '/Contents ' + IntToStr(id + 1) + ' 0 R');
  WriteLn(Stream, '>>');
  WriteLn(Stream, 'endobj');
  Inc(Parent.FObjNo);
  Parent.XRefAdd(Stream, Parent.FObjNo);
  id := id + 1;
  WriteLn(Stream, IntToStr(id) + ' 0 obj');
  Write(Stream, '<< ');
  TmpPageStream := TMemoryStream.Create;
  TmpPageStream2 := TMemoryStream.Create;
  try
    OutStream.Position := FStreamOffset;

    TmpPageStream2.CopyFrom(OutStream, FStreamSize);
    if Parent.FCompressed then
    begin
      frxDeflateStream(TmpPageStream2, TmpPageStream, gzFastest);
      s := '/Filter /FlateDecode /Length ' + IntToStr(TmpPageStream.Size) +
        ' /Length1 ' + IntToStr(TmpPageStream2.Size);
    end
    else
      s := '/Length ' + IntToStr(TmpPageStream2.Size);
    WriteLn(Stream, s + ' >>');
    WriteLn(Stream, 'stream');