illustrator 收集字体插件VBscript

这是早些年从俄罗斯网站上看到的一个收集字体插件，语言是用VBscript写的，能用，但个别字体不能收集完成，现在Adobe也在illustrator中加入了收集字体打包功能，所以这个也很少用啦。

使用方法：

下好插件，或把下面的代码存入到本地侯后缀名改为.vbs，然后把.ai文件往.vbs文件上面拖动即可，运行完后，插件会自动创建一个名为 Fonts_ai的文件夹，文档内使用过的字体会打包进这个文件夹里。

' lsd, 2012 

option explicit
Dim WshShell, objFSO, regg, txtFile, x		
Dim strLine, strLinePfb, objArgs, ext, i 	
Dim reg										
Dim strArr() 								
Dim regEx 									
Dim strRemoveAllPattern     				
Set regEx = New RegExp 
With regEx        
.Global = True	   						
.IgnoreCase = True  					
End With
Set WshShell = WScript.CreateObject("WScript.Shell")
WshShell.run "regedit /a C:\Windows\Temp\ftemp.txt ""HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts""",,true
Set objFSO = Createobject("Scripting.FileSystemObject")
Set regg = CreateObject("WScript.Shell")
Set objArgs = WScript.Arguments				
ext=objFSO.GetExtensionName(objArgs(0)) 	
If  (InStr(LCase(ext), "ai") = 0) AND (InStr(LCase(ext), "eps") = 0) Then Wscript.Quit 
ext=objFSO.GetFile(objArgs(0)) 				
Set txtFile = objFSO.OpenTextFile(ext,1) 	
i=0 
Do While Not txtFile.AtEndOfStream
x=txtFile.Readline						
If InStr(x, "fontFileName") Then
ReDim Preserve strArr(i) 				
strRemoveAllPattern = "<(?:(?:stFnt:fontFileName>)|/(?:stFnt:fontFileName>))"
strLine=Onlyfonts(regEx,x)
strRemoveAllPattern = ";(?:.*)"			
strLine=Onlyfonts(regEx,strLine)
strRemoveAllPattern = "^\s+|\s+$"		
strArr(i)=Onlyfonts(regEx,strLine)		
i=i+1
End If
Loop
txtFile.Close
ext=objFSO.GetParentFolderName(ext)			
If objFSO.FolderExists(ext & "\Fonts_ai")=0 Then 
ext=objFSO.CreateFolder (ext & "\Fonts_ai") 		
Else
Set ext = objFSO.GetFolder(ext & "\Fonts_ai") 	
end if
For i = 0 To UBound(strArr)
On Error Resume Next						
If InStr(LCase(strArr(i)), "pfb") Then		
regEx.Pattern = "(?:pfb)" 
strLine = regEx.Replace(strArr(i),"pfm")	
objFSO.CopyFile "C:\PSFONTS\PFM\"& strLine , ext&"\", true	
End If
objFSO.CopyFile "c:\windows\fonts\"& strArr(i) , ext&"\", true	
If Err.Number<>0 Then
Set txtFile = objFSO.OpenTextFile("C:\Windows\Temp\ftemp.txt",1) 
Do While Not txtFile.AtEndOfStream
x=txtFile.Readline
If InStr(x, strArr(i)) Then
strRemoveAllPattern = "(?:.*)=""|""$"		
strLine=Onlyfonts(regEx,x)
regEx.Pattern = "(\\{2})" 				
strLine = regEx.Replace(strLine,"\")		
End If
Loop
txtFile.Close								
objFSO.CopyFile strLine , ext&"\", true		
Err.Clear
End If
Next
objFSO.DeleteFile("C:\Windows\Temp\ftemp.txt")
Function Onlyfonts(regEx,strInput)
On Error Resume Next    
regEx.Pattern = strRemoveAllPattern 				
Onlyfonts = regEx.Replace(strInput,vbNullString) 	
End Function