frxpdffile.pas

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

var
  I: Integer;
begin
  Result := '';
  for I := 1 to Length ( TextStr ) do
    case TextStr [ I ] of
      '(': Result := Result + '\(';
      ')': Result := Result + '\)';
      '\': Result := Result + '\\';
      #13: Result := result + '\r';
      #10: Result := result + '\n';
    else
      Result := Result + AnsiChar(chr ( Ord ( textstr [ i ] ) ));
    end;
end;

function CryptStr(Source: AnsiString; Key: AnsiString; Enc: Boolean; id: Integer): AnsiString;
var
{$IFDEF PDF_RC4}
  k: array [ 1..21 ] of Byte;
  rc4: TfrxRC4;
{$ELSE}
  k: array [ 1..25 ] of Byte;
  aes: TfrxAES;
{$ENDIF}
  s, s1, ss: AnsiString;
begin
  if Enc then
  begin
{$IFDEF PDF_RC4}
    rc4 := TfrxRC4.Create;
{$ELSE}
    aes := TfrxAES.Create;
{$ENDIF}
    try
      s := Key;
      FillChar(k, 21, 0);
      Move(s[1], k, 16);
      Move(id, k [17], 3);
{$IFDEF PDF_RC4}
      SetLength(s1, 21);
      MD5Buf(@k, 21, @s1[1]);
{$ELSE}
      k[22] := $73;
      k[23] := $41;
      k[24] := $6c;
      k[25] := $54;
      SetLength(s1, 25);
      MD5Buf(@k, 25, @s1[1]);
{$ENDIF}
      ss := Source;
{$IFDEF PDF_RC4}
      SetLength(Result, Length(ss));
      rc4.Start(@s1[1], 16);
      rc4.Crypt(@ss[1], @Result[1], Length(ss));
      Result := EscapeSpecialChar(Result);
{$ELSE}
      aes.Start(s1);
      Result := EscapeSpecialChar(aes.Crypt(ss));
{$ENDIF}
    finally
{$IFDEF PDF_RC4}
      rc4.Free;
{$ELSE}
      aes.Free;
{$ENDIF}
    end;
  end
  else
    Result := EscapeSpecialChar(Source);
end;

function CryptStream(Source: TStream; Target: TStream; Key: AnsiString; id: Integer): AnsiString;
var
  s: AnsiString;
{$IFDEF PDF_RC4}
  k: array [ 1..21 ] of Byte;
  rc4: TfrxRC4;
  m1, m2: TMemoryStream;
{$ELSE}
  k: array [ 1..25 ] of Byte;
  aes: TfrxAES;
{$ENDIF}
begin
  FillChar(k, 21, 0);
  Move(Key[1], k, 16);
  Move(id, k[17], 3);
{$IFDEF PDF_RC4}
  SetLength(s, 16);
  MD5Buf(@k, 21, @s[1]);
{$ELSE}
  k[22] := $73;
  k[23] := $41;
  k[24] := $6c;
  k[25] := $54;
  SetLength(s, 25);
  MD5Buf(@k, 25, @s[1]);
{$ENDIF}
{$IFDEF PDF_RC4}
  m1 := TMemoryStream.Create;
  m2 := TMemoryStream.Create;
  rc4 := TfrxRC4.Create;
{$ELSE}
  aes := TfrxAES.Create;
{$ENDIF}
  try
{$IFDEF PDF_RC4}
    m1.LoadFromStream(Source);
    m2.SetSize(m1.Size);
    rc4.Start(@s[1], 16);
    rc4.Crypt(m1.Memory, m2.Memory, m1.Size);
    m2.SaveToStream(Target);
{$ELSE}
    aes.Start(s);
    SetLength(s, Source.Size);
    Source.Read(s[1], Source.Size);
    s := aes.Crypt(s);
    Target.Write(Stream, s[1], Length(s));
{$ENDIF}
  finally
{$IFDEF PDF_RC4}
    m1.Free;
    m2.Free;
    rc4.Free;
{$ELSE}
    aes.Free;
{$ENDIF}
  end;
end;

function PrepareString(const Text: WideString; Key: AnsiString; Enc: Boolean; id: Integer): AnsiString;
begin
  if Enc then
  begin
    Result := '(' + CryptStr(AnsiString(Text), Key, Enc, id) + ')'
  end
  else
    Result := '<' + StrToUTF16(AnsiString(Text)) + '>'
end;

function UnicodeToANSI(const Str: WideString; Codepage: Integer): AnsiString;
var
  i: Integer;
begin
  Result := '';
  i := WideCharToMultiByte(CodePage, 0, @Str[1], Length(Str), nil, 0, nil, nil);
  if i <> 0 then
  begin
    SetLength(Result, i);
    WideCharToMultiByte(CodePage, 0, @Str[1], Length(Str), @Result[1], i, nil, nil)
  end;
end;

{ TfrxPDFFile }

constructor TfrxPDFFile.Create(const UseFileCache: Boolean; const TempDir: String);
begin
  inherited Create;
  FPages := TList.Create;
  FFonts := TList.Create;
  FXRef := TStringList.Create;
  FCounter := 4;
  FStartPages := 0;
  FStartXRef := 0;
  FStartFonts := 0;
  FCompressed := True;
  FPrintOpt := False;
  FOutline := False;
  FPreviewOutline := nil;
  FHTMLTags := False;
  FFontDCnt := 0;
  FObjNo := 0;
  if UseFileCache then
  begin
    FTempStreamFile := frxCreateTempFile(TempDir);
    FStreamObjects := TFileStream.Create(FTempStreamFile, fmCreate);
  end else
    FStreamObjects := TMemoryStream.Create;
  ProtectionFlags := [ePrint, eModify, eCopy, eAnnot];
end;

destructor TfrxPDFFile.Destroy;
begin
  Clear;
  FXRef.Free;
  FPages.Free;
  FFonts.Free;
  FStreamObjects.Free;
  try
    DeleteFile(FTempStreamFile);
  except
  end;
  inherited;
end;

procedure TfrxPDFFile.Clear;
var
  i: Integer;
begin
  for i := 0 to FPages.Count - 1 do
    TfrxPDFPage(FPages[i]).Free;
  FPages.Clear;
  for i := 0 to FFonts.Count - 1 do
    TfrxPDFFont(FFonts[i]).Free;
  FFonts.Clear;
  FXRef.Clear;
  ProtectionFlags := [ePrint, eModify, eCopy, eAnnot];
end;

procedure TfrxPDFFile.SaveToStream(const Stream: TStream);
var
  i, j: Integer;
  s, s1: {Ansi}String;
  Page, Top: Integer;
  Text: String;
  Parent: Integer;
  OutlineCount: Integer;
  NodeNumber: Integer;
  OutlineTree: TfrxPDFOutlineNode;
  pgN: TStringList;
  FOutlineN: Integer;

  function CheckPageInRange(const PageN: Integer): Boolean;
  begin
    Result := True;
    if (pgN.Count <> 0) and (pgN.IndexOf(IntToStr(PageN + 1)) = -1) then
      Result := False;
  end;

  procedure DoPrepareOutline(Node: TfrxPDFOutlineNode);
  var
    i: Integer;
    p: TfrxPDFOutlineNode;
    prev: TfrxPDFOutlineNode;
  begin
    Inc(NodeNumber);
    prev := nil;
    p := nil;
    for i := 0 to FPreviewOutline.Count - 1 do
    begin
      FPreviewOutline.GetItem(i, Text, Page, Top);
      if CheckPageInRange(Page) then
      begin
        p := TfrxPDFOutlineNode.Create;
        p.Title := Text;
        p.Dest := Page;
        p.Top := Top;
        p.Prev := prev;
        if prev <> nil then
          prev.Next := p
        else
          Node.First := p;
        prev := p;
        p.Parent := Node;
        FPreviewOutline.LevelDown(i);
        DoPrepareOutline(p);
        Node.Count := Node.Count + 1;
        Node.CountTree := Node.CountTree + p.CountTree + 1;
        FPreviewOutline.LevelUp;
      end;
    end;
    Node.Last := p;
  end;

  procedure DoWriteOutline(Node: TfrxPDFOutlineNode; Parent: Integer);
  var
    p: TfrxPDFOutlineNode;
    i: Integer;
  begin
    p := Node;
    if p.Dest = -1 then
      p.Number := Parent
    else
    begin
      p.Number := FCounter;
      Inc(FObjNo);
      XRefAdd(Stream, FObjNo);
      WriteLn(Stream, IntToStr(FCounter) + ' 0 obj');
      Inc(FCounter);
      WriteLn(Stream, '<<');
      WriteLn(Stream, '/Title ' + PrepareString(p.Title, FEncKey, FProtection, FCounter - 1));
      WriteLn(Stream, '/Parent ' + IntToStr(Parent) + ' 0 R');
      if p.Prev <> nil then
        WriteLn(Stream, '/Prev ' + IntToStr(p.Prev.Number) + ' 0 R');
      if p.First <> nil then
      begin
        WriteLn(Stream, '/First ' + IntToStr(p.Number + 1) + ' 0 R');
        WriteLn(Stream, '/Last ' + IntToStr(p.Number + p.CountTree - p.Last.CountTree ) + ' 0 R');
        WriteLn(Stream, '/Count ' + IntToStr(p.Count));
      end;
      if p.Next <> nil then
        WriteLn(Stream, '/Next ' + IntToStr(p.Number + p.CountTree + 1) + ' 0 R');
      if CheckPageInRange(p.Dest) then
      begin
        if FEmbedded then
          i := FFontDCnt + 1
        else
          i := FFontDCnt;
        if pgN.Count > 0 then
          s := '/Dest [' + IntToStr(FpagesRoot + FFonts.Count * i + pgN.IndexOf(IntToStr(p.Dest + 1)) * 2 + 1) + ' 0 R /XYZ 0 ' + IntToStr(Round(TfrxPDFPage(FPages[pgN.IndexOf(IntToStr(p.Dest + 1))]).Height - p.Top * PDF_DIVIDER)) + ' 0]'
        else
          s := '/Dest [' + IntToStr(FpagesRoot + FFonts.Count * i + p.Dest * 2 + 1) + ' 0 R /XYZ 0 ' + IntToStr(Round(TfrxPDFPage(FPages[p.Dest]).Height - p.Top * PDF_DIVIDER)) + ' 0]';
        WriteLn(Stream, s);
      end;
      WriteLn(Stream, '>>');
      WriteLn(Stream, 'endobj');
    end;
    if p.First <> nil then
      DoWriteOutline(p.First, p.Number);
    if p.Next <> nil then
      DoWriteOutline(p.Next, Parent);
  end;

begin
  inherited SaveToStream(Stream);
  OutlineCount := 0;
  OutlineTree := nil;
  if FOutline then
    if not Assigned(FPreviewOutline) then
      FOutline := False
    else
      FPreviewOutline.LevelRoot;
  FCounter := 1;
  WriteLn(Stream, '%PDF-' + PDF_VER);
  WriteLn(Stream, '%'#226#227#207#211);
  Inc(FObjNo);
  XRefAdd(Stream, FObjNo);
  WriteLn(Stream, IntToStr(FCounter) + ' 0 obj');
  Inc(FCounter);
  WriteLn(Stream, '<<');
  WriteLn(Stream, '/Type /Catalog');
  i := 0;

  if FOutline then
  begin
    OutlineTree := TfrxPDFOutlineNode.Create;
    pgN := TStringList.Create;
    NodeNumber := 0;
    frxParsePageNumbers(PageNumbers, pgN, FTotalPages);
    DoPrepareOutline(OutlineTree);
    if OutlineTree.CountTree > 0 then
    begin
      OutlineCount := OutlineTree.CountTree - OutlineTree.Last.CountTree;
      i := OutlineTree.CountTree + 1;
    end else
    begin
      OutlineTree.Free;
      pgN.Free;
      FOutline := False;
    end;
  end;

  FPagesRoot := FObjNo + 2 + i;
  WriteLn(Stream, '/Pages ' + IntToStr(FPagesRoot) + ' 0 R');
  if FOutline then s1 := '/UseOutlines'
  else s1 := '/UseNone';
  WriteLn(Stream, '/PageMode ' + s1);
  if FOutline then
    WriteLn(Stream, '/Outlines ' + IntToStr(FCounter + 1) + ' 0 R');
  WriteLn(Stream, '/ViewerPreferences <<');
  if FTitle <> '' then
    WriteLn(Stream, '/DisplayDocTitle true');
  if FHideToolbar then
    WriteLn(Stream, '/HideToolbar true');
  if FHideMenubar then
    WriteLn(Stream, '/HideMenubar true');
  if FHideWindowUI then
    WriteLn(Stream, '/HideWindowUI true');
  if FFitWindow then
    WriteLn(Stream, '/FitWindow true');
  if FCenterWindow then
    WriteLn(Stream, '/CenterWindow true');
  if not FPrintScaling then
    WriteLn(Stream, '/PrintScaling /None');
  WriteLn(Stream, '>>');
  WriteLn(Stream, '>>');
  WriteLn(Stream, 'endobj');
  Inc(FObjNo);
  XRefAdd(Stream, FObjNo);
  WriteLn(Stream, IntToStr(FCounter) + ' 0 obj');
  Inc(FCounter);
  WriteLn(Stream, '<<');
  WriteLn(Stream, '/Title ' + PrepareString(FTitle, FEncKey, FProtection, FCounter - 1));
  WriteLn(Stream, '/Author ' + PrepareString(FAuthor, FEncKey, FProtection, FCounter - 1));
  WriteLn(Stream, '/Subject ' + PrepareString(FSubject, FEncKey, FProtection, FCounter - 1));