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;