DONE: 'Used fonts' tool

[Target]

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.donationcoder.com/forum/index.php?topic=11730.0

TIA

Target

[skrommel]

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

Code

;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 
}

[Target]

Cool!!  I had pretty much given this up as an impossibility, but I should have known better

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

Many thanks Skrommel!!