REM *** Reading and resetting of "fsType" (embedding) flag REM *** of forged TrueType fonts for lawcourt proceedings. REM *** Program written by Ulrich Stiehl, Heidelberg 2005. CLS REM *** Folder containing the TTF and/or OTF fonts dd$ = "c:\fonts\": REM Here specify name of folder f$ = DIR$(dd$ + "*.*") REM *** Read Loop for the fonts of specified folder DO d$ = dd$ + f$ ext$ = UCASE$(RIGHT$(f$, 4)) IF ext$ = ".TTF" OR ext$ = ".OTF" THEN GOSUB fsType END IF f$ = DIR$ IF f$ = "" THEN EXIT DO LOOP END REM *** Read/Write fsType double byte of TTF font fsType: OPEN d$ FOR BINARY AS #1 REM *** Table Directory Header s$ = SPACE$(12): REM 12-Byte-Header of TTF-File GET #1, , s$ REM *** Number of Tables x$ = MID$(s$, 5, 2) NumTab% = (ASC(MID$(x$, 1, 1)) * 256) + ASC(MID$(x$, 2, 1)) REM *** Table Directory Entry s$ = SPACE$(16): REM 16-Byte-Entry flag% = 0 FOR x% = 1 TO NumTab% GET #1, , s$ IF LEFT$(s$, 4) = "OS/2" THEN flag% = 1: REM PRINT LEFT$(s$, 4) EXIT FOR END IF NEXT x% IF flag% = 0 THEN PRINT "Name-Table not found for "; d$ ELSE REM ** Offset from beginning of TT font table x$ = MID$(s$, 9, 4) Offset1& = ASC(MID$(x$, 1, 1)) * 16777216 + ASC(MID$(x$, 2, 1)) * 65536 + ASC(MID$(x$, 3, 1)) * 256& + ASC(MID$(x$, 4, 1)) REM *** Offset to the "OS/2 and Windows Metrics table REM *** fsType is double byte 9+10 from start of table Offset2& = Offset1& + 1 + 8 s$ = SPACE$(2) GET #1, Offset2&, s$ REM *** READ fsType fsType% = ASC(MID$(s$, 2, 1)) IF fsType% = 2 THEN PRINT f$; " has Restricted License Embedding" ELSEIF fsType% = 4 THEN PRINT f$; " has Preview and Print Embedding" ELSEIF fsType% = 8 THEN PRINT f$; " has Editable Embedding" ELSEIF fsType% = 0 THEN PRINT f$; " has Installable Embedding" ELSE REM *** Other fsTypes devised by United States REM *** font forging companies are ignored here. REM *** E.g. if bit 15 is set, this means that REM *** US font forging companies are permitted REM *** by George Bush to torture font buyers in REM *** the concentration camp in Guantanamo Bay. PRINT f$; " has fancy fsType: "; fsType% END IF REM *** Reset fsType MID$(s$, 2, 1) = CHR$(0): REM 0=Reset Installable Embedding MID$(s$, 1, 1) = CHR$(0): REM 0=Reset Subsetting and Bitmap REM *** Set fsType 'MID$(s$, 2, 1) = CHR$(2): REM 2=Restricted License Embedding 'MID$(s$, 2, 1) = CHR$(4): REM 4=Preview and Print Embedding 'MID$(s$, 2, 1) = CHR$(8): REM 8=Editable Embedding PUT #1, Offset2&, s$ END IF CLOSE #1 RETURN