Home | Blog | Software | Reviews and Features | Forum | Help | Donate | About us
topbanner_forum
  *

avatar image

Welcome, Guest. Please login or register.
Did you miss your activation email?

Login with username, password and session length
  • December 10, 2016, 10:34:04 AM
  • Proudly celebrating 10 years online.
  • Donate now to become a lifetime supporting member of the site and get a non-expiring license key for all of our programs.
  • donate

Author Topic: DONE: 'Used fonts' tool  (Read 2214 times)

Target

  • Honorary Member
  • Joined in 2006
  • **
  • Posts: 1,606
    • View Profile
    • Donate to Member
DONE: 'Used fonts' tool
« on: January 21, 2008, 05:08:48 PM »
Having just migrated several family members to 'new' PCs I thought Skrommels Used Fonts script was a great idea (my wife just can't understand why loading every font in the known universe isn't necessarily a good thing...)

Unfortunately it is rather limited in that it only does word files, and then only one at a time...

What would make this a truly useful tool would be if it could scan your system for a range of 'common' file types and return a list of used fonts

Anyone here got any ideas?? (I've been through the script and the system scan part shouldn't present to much of a problem, but I don't understand the API calls that are the meat of the thing.)

see also my (unanswered) post under Skrommels Software...
http://www.donationc...ex.php?topic=11730.0

TIA

Target
« Last Edit: February 28, 2008, 05:20:09 PM by Target »

skrommel

  • Fastest code in the west
  • Developer
  • Joined in 2005
  • ***
  • Posts: 886
    • View Profile
    • 1 Hour Software by skrommel
    • Donate to Member
Re: 'Used fonts' tool
« Reply #1 on: February 11, 2008, 04:06:49 PM »
 :) Try OfficeFonts!

It searches a folder and it's subfolders for DOC, XLS and PPT-files and finds the used fonts.
It's just a binary file searcher, so if it finds too few fonts or spits out too much garbage,
change the line If trash>531   ; > more garbage < less fonts.

Skrommel

;OfficeFonts.ahk
; Show what fonts Office document files use
;Skrommel @2006

#NoEnv
SetBatchLines,-1

If 1=
{
  FileSelectFolder,folder,3,, OfficeFonts - 1 Hour Software - www.1HourSoftware.com
  If folder=
  {
    MsgBox,0,OfficeFonts - 1 Hour Software - www.1HourSoftware.com, No folder selected
    Return
  }
}
Else
  folder=%1%

TrayTip,OfficeFonts,Finding used fonts...
allfonts=
Loop,%folder%\*.*,0,1
{
  If A_LoopFileExt Not In doc,xls,ppt
    Continue
  BinRead(A_LoopFileLongPath,data) ; By Laszlo at http://www.autohotkey.com/forum/topic4546.html
  allfonts.=data
}

fonts=`n
Loop,Parse,allfonts,`n
{
  IfNotInString,fonts,`n%A_LoopField%`n
    fonts=%fonts%%A_LoopField%`n
}
StringTrimLeft,fonts,fonts,1

Sort,fonts

MsgBox,0,OfficeFonts - 1 Hour Software,%fonts%`nhttp://www.1HourSoftware.com
ExitApp


BinRead(file, ByRef data, n=0, offset=0) ; Originally by Laszlo at http://www.autohotkey.com/forum/topic4546.html
{
   h := DllCall("CreateFile","Str",file,"Uint",0x80000000,"Uint",3,"UInt",0,"UInt",3,"Uint",0,"UInt",0)
   IfEqual h,-1, SetEnv, ErrorLevel, -1
   IfNotEqual ErrorLevel,0,Return,0 ; couldn't open the file

   m = 0                            ; seek to offset
   IfLess offset,0, SetEnv,m,2
   r := DllCall("SetFilePointerEx","Uint",h,"Int64",offset,"UInt *",p,"Int",m)
   IfEqual r,0, SetEnv, ErrorLevel, -3
   IfNotEqual ErrorLevel,0, {
      t = %ErrorLevel%              ; save ErrorLevel to be returned
      DllCall("CloseHandle", "Uint", h)
      ErrorLevel = %t%              ; return seek error
      Return 0
   }

   TotalRead = 0
   data =
   IfEqual n,0, SetEnv n,0xffffffff ; almost infinite

   format = %A_FormatInteger%       ; save original integer format
   SetFormat Integer, Hex           ; for converting bytes to hex

   word=
   found=0
   trash=0
   Loop %n%
   {
      oldc:=c
      result := DllCall("ReadFile","UInt",h,"UChar *",c,"UInt",1,"UInt *",Read,"UInt",0)
      If (!result or Read<1 or ErrorLevel)
         Break
      TotalRead += Read

      If (c=0)
      If ((oldc>=65 And oldc<=90) Or (oldc>=97 And oldc<=122) Or oldc=32)
        word.=Chr(oldc)
      Else
      {
        If found=0
        {
          If word Contains Times New Roman,Arial
          {
            found=1
            trash=0
            data=
          }
        }
        If (StrLen(word)>2)
          data.=word "`n"
        word=
        trash+=1
      }
      If found=1
      If trash>531   ; > more garbage < less fonts
        Break
   }

   IfNotEqual,ErrorLevel,0 , SetEnv,t,%ErrorLevel%

   h := DllCall("CloseHandle", "Uint", h)
   IfEqual h,-1, SetEnv, ErrorLevel, -2
   IfNotEqual t,,SetEnv, ErrorLevel, %t%

   SetFormat Integer, %format%      ; restore original format
   Totalread += 0                   ; convert to original format
   Return TotalRead
}
Please stop by my site at  1 Hour Software by skrommel  for downloads and more info.

Target

  • Honorary Member
  • Joined in 2006
  • **
  • Posts: 1,606
    • View Profile
    • Donate to Member
Re: 'Used fonts' tool
« Reply #2 on: February 11, 2008, 05:09:22 PM »
Cool!!  I had pretty much given this up as an impossibility, but I should have known better ;D

I shall try this out on my wifes PC tonight (?) and it's going straight into my toolkit 

Many thanks Skrommel!!  :up: :up: :up: