盒子论坛 v2.1

WPS自从更新到某个版本后，导出PDF时如发现字体受限（比如FZ）则无法正常导出。墙内墙外查了好几天，总算研究出读写字体文件嵌入性的方法。
以下代码仅限内部交流，修改字体收到律师函概不负责哦~

Function ReadFontFsType(SrcPath: String): Integer;
Var
  i, OffSet: Integer;
  Stream: TFileStream;
  Buffer: TBytes;
Begin
  // -1:不是字体文件或不是0248；0：可安装；2：受限制的许可证；4：打印和预览；8：可编辑
  Result := -1;
  SetLength(Buffer, 4);
  Stream := TFileStream.Create(SrcPath, fmOpenRead);
  Stream.Position := 0;
  For i := 0 To Stream.Size - 5 Do Begin
    Stream.Seek(i, soFromBeginning);
    Stream.ReadBuffer(Buffer, 4);
    If (Buffer[0] = $4F) And (Buffer[1] = $53) And (Buffer[2] = $2F) And (Buffer[3] = $32) Then Begin
      Stream.Seek(4, soFromCurrent);
      Stream.ReadBuffer(Buffer, 4);
      OffSet := Buffer[0] * 16777216 + Buffer[1] * 65536 + Buffer[2] * 256 + Buffer[3] + 9;
      // Read FsType Code
      Stream.Seek(OffSet, soFromBeginning);
      SetLength(Buffer, 1);
      Stream.ReadBuffer(Buffer, 1);
      Result := Buffer[0];
      Break;
    End;
  End;
  Stream.Free;
End;

Function WriteFontFsType(SrcPath: String; FsType: Integer): Integer;
Var
  i, OffSet: Integer;
  Stream: TFileStream;
  Buffer: TBytes;
Begin
  // -1:不是字体文件或不是0248；0：待写入数据与源文件一致；1-写入成功
  //注意：写入成功，系统注销后生效
  Result := -1;
  SetLength(Buffer, 4);
  Stream := TFileStream.Create(SrcPath, fmOpenReadWrite);
  Stream.Position := 0;
  For i := 0 To Stream.Size - 5 Do Begin
    Stream.Seek(i, soFromBeginning);
    Stream.ReadBuffer(Buffer, 4);
    If (Buffer[0] = $4F) And (Buffer[1] = $53) And (Buffer[2] = $2F) And (Buffer[3] = $32) Then Begin
      Stream.Seek(4, soFromCurrent);
      Stream.ReadBuffer(Buffer, 4);
      OffSet := Buffer[0] * 16777216 + Buffer[1] * 65536 + Buffer[2] * 256 + Buffer[3] + 9;
      // Read FsType Code
      Stream.Seek(OffSet, soFromBeginning);
      SetLength(Buffer, 1);
      Stream.ReadBuffer(Buffer, 1);
      // Write FsType Code
      If Buffer[0] In [0, 2, 4, 8] Then Begin
        If Buffer[0] = FsType Then Begin
          Result := 0;
        End Else Begin
          Result := 1;
          Stream.Seek(OffSet, soFromBeginning);
          Stream.WriteBuffer(FsType, 1);
        End;
      End;
      Break;
    End;
  End;
  Stream.Free;
End;
----------------------------------------------
快乐工作，快乐生活

作者：

sail2000 (小帆工作室)	★☆☆☆☆	-
	盒子活跃会员

2023/9/10 21:23:14

1楼：

不明，觉厉
----------------------------------------------
delphi 是兴趣，和工作无关，即使它倒闭。又不靠它 delphi 吃饭，怕甚？

信息

登陆以后才能回复