Copying a font file 1

[Griffyn]

Hi all,

I have two service applications that talk to each other via TCP. (one sends raw data to the other, which opens an Excel template that uses the raw data to populate itself and print).

I want to add font support to this arrangement so that the sending service has a list of required fonts in a table that it can use to interrogate the receiver service to find out if it's missing any of them. If it's missing some, it will send the .TTF file(s) across the TCP session and the receiver service will install them.

The problems:

1. Truetype fonts appear to have a Name, a Typeface Name, and a Filename - all different.

For example, Name=Futura Extra Black Italic BT (TrueType),
TypeFace=Futura XBlkIt BT,
Filename=TT0149M_.TTF.

To be manageable, I need the list that the sending service uses to have the TypeFace names, as these are what appears in Excel. How can I get the Filename from the Typeface name? The registry key HKLM\Software\Microsoft\Windows NT\Current Version\Fonts only lists the Name and Filename relationship.

2. How can the receiver service decide whether or not it has the required fonts installed? Being a service, it doesn't have access to the Screen.Fonts object.

It would seem that both these answers could be solved by extracting the Typeface Name from the actual font file (unless this relationship exists somewhere else). I've found a TrueType specification document - it's quite convoluted. Does anyone have any working code in their libraries that I can use? Or an alternative method to accomplish what I want?

Many thanks.

 

[Griffyn]

Never mind - I figured it out.

[navy][i]// for automatic syntax highlighting see faq102-6487 
[/i][/navy][b]uses[/b]
  Math;

[b]function[/b] GetFontName(AFilename: String): String;
[b]type[/b]
  TBuffer = [b]array[/b][[purple]0..64[/purple]] [b]of[/b] Char;

  [b]function[/b] _BufToInt(ABuffer: TBuffer; AOffset, ALength: Integer): DWord;
  [b]var[/b]
    c : Integer;
  [b]begin[/b]
    Result := [purple]0[/purple];
    [b]for[/b] c := AOffset [b]to[/b] AOffset + ALength - [purple]1[/purple] [b]do[/b]
      Result := Result + Ord(ABuffer[c]) * Trunc(Power([purple]256[/purple], AOffset + ALength - c - [purple]1[/purple]));
  [b]end[/b];

  [b]function[/b] _BufToStr(ABuffer: TBuffer; AOffset, ALength: Integer): String;
  [b]var[/b]
    c : Integer;
  [b]begin[/b]
    Result := [teal]''[/teal];
    [b]for[/b] c := AOffset [b]to[/b] AOffset + ALength - [purple]1[/purple] [b]do[/b]
      Result := Result + ABuffer[c];
  [b]end[/b];

[b]var[/b]
  f : [b]file[/b];
  tblnum: Integer;               [navy][i]// number of tables in TTF
[/i][/navy]  buf : TBuffer;    [navy][i]// read buffer
[/i][/navy]  rr : Integer;                  [navy][i]// read result
[/i][/navy]  c : Integer;                   [navy][i]// counter
[/i][/navy]  Found: Boolean;
  recnum: Integer;               [navy][i]// number of records in name table
[/i][/navy]  tbloff: Integer;               [navy][i]// offset to name table
[/i][/navy]  stroff: Integer;               [navy][i]// offset to string storage
[/i][/navy]  strlen: Integer;               [navy][i]// string length
[/i][/navy][b]begin[/b]
  tbloff := [purple]0[/purple];        [navy][i]// satisfy compiler warning
[/i][/navy]  Assign(f, AFilename);
  Reset(f, [purple]1[/purple]);
  [b]try[/b]
    Seek(f, [purple]4[/purple]);   [navy][i]// jump to Number of Tables
[/i][/navy]    BlockRead(f, buf, [purple]2[/purple], rr);
    tblnum := _BufToInt(buf, [purple]0[/purple], [purple]2[/purple]);
    Seek(f, [purple]12[/purple]);     [navy][i]// jump to Table Directory
[/i][/navy]    Found := False;
    [b]for[/b] c := [purple]0[/purple] [b]to[/b] tblnum - [purple]1[/purple] [b]do[/b]
    [b]begin[/b]
      BlockRead(f, buf, [purple]16[/purple], rr);
      [b]if[/b] SameText(_BufToStr(buf, [purple]0[/purple], [purple]4[/purple]), [teal]'name'[/teal]) [b]then[/b]
      [b]begin[/b]
        Found := True;
        tbloff := _BufToInt(buf, [purple]8[/purple], [purple]4[/purple]);   [navy][i]// offset for name table
[/i][/navy]        Break;
      [b]end[/b];
    [b]end[/b];
    [b]if[/b] [b]not[/b] Found [b]then[/b]
    [b]begin[/b]
      [b]raise[/b] Exception.Create([teal]'Cannot find '[/teal][teal]'name'[/teal][teal]' table in font file'[/teal]);
      exit;
    [b]end[/b];
    Seek(f, tbloff);
    [navy][i]// at this point, we've Seek'ed to the beginning of the 'name' table
[/i][/navy]    BlockRead(f, buf, [purple]6[/purple], rr);
    recnum := _BufToInt(buf, [purple]2[/purple], [purple]2[/purple]);    [navy][i]// get number of records
[/i][/navy]    stroff := _BufToInt(buf, [purple]4[/purple], [purple]2[/purple]);    [navy][i]// get offset to string storage
[/i][/navy]    Found := False;
    [b]for[/b] c := [purple]0[/purple] [b]to[/b] recnum - [purple]1[/purple] [b]do[/b]
    [b]begin[/b]
      Seek(f, tbloff + [purple]6[/purple] + c * [purple]12[/purple]);
      BlockRead(f, buf, [purple]12[/purple], rr);               [navy][i]// read entire NameRecord
[/i][/navy]      [b]if[/b] (_BufToInt(buf, [purple]4[/purple], [purple]2[/purple]) = [purple]0[/purple]) [b]and[/b] (_BufToInt(buf, [purple]6[/purple], [purple]2[/purple]) = [purple]1[/purple]) [b]then[/b]
      [b]begin[/b]
        Found := True;
        strlen := _BufToInt(buf, [purple]8[/purple], [purple]2[/purple]);
        Seek(f, tbloff + stroff + _BufToInt(buf, [purple]10[/purple], [purple]2[/purple]));  [navy][i]// go to string
[/i][/navy]        BlockRead(f, buf, strlen, rr);
        Result := _BufToStr(buf, [purple]0[/purple], strlen);
        Break;
      [b]end[/b];
    [b]end[/b];
    [b]if[/b] [b]not[/b] Found [b]then[/b]
      [b]raise[/b] Exception.Create([teal]'Cannot find Typeface name in font file'[/teal]);
  [b]finally[/b]
    CloseFile(f);
  [b]end[/b];
[b]end[/b];

 

[Griffyn]

In case anyone actually wants to make use of the above code, I've rewritten it properly using record structures. Much easier to maintain this way, and add further functionality.

It's currently hardcoded to handle English fonts. The specification document I used is Chapter 2, and located at

http://www.microsoft.com/typography/SpecificationsOverview.mspx

[b]function[/b] GetFontName(AFilename: String): String;
[b]type[/b]
  TOffsetTable = [b]record[/b]
    sfntVersion: FIXED;
    numTables: Word;
    searchRange: Word;
    entrySelector: Word;
    rangeShift: Word;
  [b]end[/b];

  TDirectoryTable = [b]record[/b]
    tag: [b]array[/b][[purple]0..3[/purple]] [b]of[/b] Char;
    checkSum: LongInt;
    offset: LongInt;
    length: LongInt;
  [b]end[/b];

  TNameTable = [b]record[/b]
    FormatSelector: Word;
    NumRecords: Word;
    Offset: Word;
  [b]end[/b];

  TNameRecord = [b]record[/b]
    PlatformID: Word;
    EncodingID: Word;
    LanguageID: Word;
    NameID: Word;
    Length: Word;
    Offset: Word;
  [b]end[/b];

  [b]function[/b] _LSwap(ALongInt: LongInt): LongInt;
  [b]begin[/b]
    Result := Swap(ALongInt [b]shr[/b] [purple]16[/purple]) [b]or[/b] (LongInt(Swap(ALongInt [b]and[/b] [purple]$[/purple]ffff)) [b]shl[/b] [purple]16[/purple]);
  [b]end[/b];

[b]var[/b]
  f : [b]file[/b];
  rr : Integer;                  [navy][i]// read result
[/i][/navy]  c, d : Integer;                   [navy][i]// counter
[/i][/navy]  Found: Boolean;
  OffsetTable: TOffsetTable;
  DirectoryTable: TDirectoryTable;
  NameTable: TNameTable;
  NameRecord: TNameRecord;
  buf: [b]array[/b][[purple]0..255[/purple]] [b]of[/b] Char;
[b]begin[/b]
  [b]if[/b] ExtractFilePath(AFilename) = [teal]''[/teal] [b]then[/b]
    AFilename := IncludeTrailingPathDelimiter(GetFontFolder) + AFilename;
  Assign(f, AFilename);
  Reset(f, [purple]1[/purple]);
  [b]try[/b]
    BlockRead(f, OffsetTable, SizeOf(OffsetTable), rr);
    Found := False;
    [b]for[/b] c := [purple]0[/purple] [b]to[/b] Swap(OffsetTable.numTables) - [purple]1[/purple] [b]do[/b]
    [b]begin[/b]
      BlockRead(f, DirectoryTable, SizeOf(DirectoryTable), rr);
      [b]if[/b] SameText(DirectoryTable.tag, [teal]'name'[/teal]) [b]then[/b]
      [b]begin[/b]
        Found := True;
        Break;
      [b]end[/b];
    [b]end[/b];
    [b]if[/b] [b]not[/b] Found [b]then[/b]
      [b]raise[/b] Exception.CreateFmt([teal]'Cannot find '[/teal][teal]'name'[/teal][teal]' table in font file (%s)'[/teal],
        [ExtractFilename(AFilename)]);
    Seek(f, _LSwap(DirectoryTable.offset));
    [navy][i]// at this point, we've Seek'ed to the beginning of the 'name' table
[/i][/navy]    BlockRead(f, NameTable, SizeOf(NameTable), rr);
    Found := False;
    [b]for[/b] c := [purple]0[/purple] [b]to[/b] Swap(NameTable.NumRecords) - [purple]1[/purple] [b]do[/b]
    [b]begin[/b]
      BlockRead(f, NameRecord, SizeOf(NameRecord), rr);               [navy][i]// read entire NameRecord
[/i][/navy]      [b]if[/b] ((Swap(NameRecord.LanguageID) = [purple]0[/purple]) [b]or[/b] (Swap(NameRecord.LanguageID) = [purple]1033[/purple]))
        [b]and[/b] (Swap(NameRecord.NameID) = [purple]1[/purple]) [b]then[/b]
      [b]begin[/b]
        Found := True;
        Seek(f, _LSwap(DirectoryTable.offset) + Swap(NameTable.Offset) + Swap(NameRecord.Offset));
        BlockRead(f, buf, Swap(NameRecord.Length), rr);
        Result := Copy(buf, [purple]0[/purple], Swap(NameRecord.Length));
        [b]if[/b] buf[[purple]0[/purple]] = [teal]#0[/teal] [b]then[/b]               [navy][i]// double-byte string
[/i][/navy]        [b]begin[/b]
          Result := [teal]''[/teal];
          d := [purple]1[/purple];
          [b]while[/b] d <= Swap(NameRecord.Length) [b]do[/b]
          [b]begin[/b]
            Result := Result + buf[d];
            Inc(d, [purple]2[/purple]);
          [b]end[/b];
        [b]end[/b]
        [b]else[/b]
          Result := Copy(buf, [purple]0[/purple], Swap(NameRecord.Length));
        Break;
      [b]end[/b];
    [b]end[/b];
    [b]if[/b] [b]not[/b] Found [b]then[/b]
      [b]raise[/b] Exception.CreateFmt([teal]'Cannot find Typeface name in font file (%s)'[/teal],
        [ExtractFilename(AFilename)]);
  [b]finally[/b]
    CloseFile(f);
  [b]end[/b];
[b]end[/b];

 

[roo0047]

Nice work Griffyn.

Roo
Delphi Rules!